Added Delphi/Pascal wrapper for SoundTouch dll library

2024-11-09 20:33:03 +01:00 · 2009-02-24 14:32:44 +00:00 · 2009-02-24 14:32:44 +00:00 · 4b591cdb12
commit 4b591cdb12
parent 56185e3446
2 changed files with 473 additions and 2 deletions
--- a/README.html
+++ b/README.html
@ -686,18 +686,20 @@ and command-line switch &quot;-bpm&quot; </li>
 </ul>
 <hr>
 <h2 >6. Acknowledgements </h2>
-<p >Kudos for these people who have submitted bugfixed since
+<p >Kudos for these people who have contributed to development or submitted
+bugfixes since
 SoundTouch v1.3.1: </p>
 <ul>
  <li>Arthur A</li>
  <li>Richard Ash</li>
  <li>Stanislav Brabec</li>
+  <li>Christian Budde</li>
  <li>Brian Cameron</li>
  <li>Justin Frankel</li>
  <li>Jason Garland</li>
  <li>Takashi Iwai</li>
 </ul>
-<p >Moral greetings to all other contributors as well!</p>
+<p >Moral greetings to all other contributors and users also!</p>
 <hr>
 <h2 >7. LICENSE </h2>
 <p>SoundTouch audio processing library<br>
--- a/source/SoundTouchDLL/SoundTouchDLL.pas
+++ b/source/SoundTouchDLL/SoundTouchDLL.pas
@ -0,0 +1,469 @@
+unit SoundTouchDLL;
+
+//////////////////////////////////////////////////////////////////////////////
+//
+// SoundTouch.dll wrapper for accessing SoundTouch routines from Delphi/Pascal
+//
+//  Module Author : Christian Budde
+//  
+////////////////////////////////////////////////////////////////////////////////
+//
+// $Id$
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+// License :
+//
+//  SoundTouch audio processing library
+//  Copyright (c) Olli Parviainen
+//
+//  This library is free software; you can redistribute it and/or
+//  modify it under the terms of the GNU Lesser General Public
+//  License as published by the Free Software Foundation; either
+//  version 2.1 of the License, or (at your option) any later version.
+//
+//  This library is distributed in the hope that it will be useful,
+//  but WITHOUT ANY WARRANTY; without even the implied warranty of
+//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+//  Lesser General Public License for more details.
+//
+//  You should have received a copy of the GNU Lesser General Public
+//  License along with this library; if not, write to the Free Software
+//  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+//
+////////////////////////////////////////////////////////////////////////////////
+
+interface
+
+uses
+  Windows;
+
+type
+  TSoundTouchHandle = THandle;
+
+  // Create a new instance of SoundTouch processor.
+  TSoundTouchCreateInstance = function : TSoundTouchHandle; stdcall;
+
+  // Destroys a SoundTouch processor instance.
+  TSoundTouchDestroyInstance = procedure (Handle: TSoundTouchHandle); stdcall;
+
+  // Get SoundTouch library version string
+  TSoundTouchGetVersionString = function : PChar; stdcall;
+
+  // Get SoundTouch library version Id
+  TSoundTouchGetVersionId = function : Cardinal; stdcall;
+
+  // Sets new rate control value. Normal rate = 1.0, smaller values
+  // represent slower rate, larger faster rates.
+  TSoundTouchSetRate = procedure (Handle: TSoundTouchHandle; newRate: Single); stdcall;
+
+  // Sets new tempo control value. Normal tempo = 1.0, smaller values
+  // represent slower tempo, larger faster tempo.
+  TSoundTouchSetTempo = procedure (Handle: TSoundTouchHandle; newTempo: Single); stdcall;
+
+  // Sets new rate control value as a difference in percents compared
+  // to the original rate (-50 .. +100 %);
+  TSoundTouchSetRateChange = procedure (Handle: TSoundTouchHandle; newRate: Single); stdcall;
+
+  // Sets new tempo control value as a difference in percents compared
+  // to the original tempo (-50 .. +100 %);
+  TSoundTouchSetTempoChange = procedure (Handle: TSoundTouchHandle; newTempo: Single); stdcall;
+
+  // Sets new pitch control value. Original pitch = 1.0, smaller values
+  // represent lower pitches, larger values higher pitch.
+  TSoundTouchSetPitch = procedure (Handle: TSoundTouchHandle; newPitch: Single); stdcall;
+
+  // Sets pitch change in octaves compared to the original pitch
+  // (-1.00 .. +1.00);
+  TSoundTouchSetPitchOctaves = procedure (Handle: TSoundTouchHandle; newPitch: Single); stdcall;
+
+  // Sets pitch change in semi-tones compared to the original pitch
+  // (-12 .. +12);
+  TSoundTouchSetPitchSemiTones = procedure (Handle: TSoundTouchHandle; newPitch: Single); stdcall;
+
+
+  // Sets the number of channels, 1 = mono, 2 = stereo
+  TSoundTouchSetChannels = procedure (Handle: TSoundTouchHandle; numChannels: Cardinal); stdcall;
+
+  // Sets sample rate.
+  TSoundTouchSetSampleRate = procedure (Handle: TSoundTouchHandle; SampleRate: Cardinal); stdcall;
+
+  // Flushes the last samples from the processing pipeline to the output.
+  // Clears also the internal processing buffers.
+  //
+  // Note: This function is meant for extracting the last samples of a sound
+  // stream. This function may introduce additional blank samples in the end
+  // of the sound stream, and thus it
+  // in the middle of a sound stream.
+  TSoundTouchFlush = procedure (Handle: TSoundTouchHandle); stdcall;
+
+  // Adds 'numSamples' pcs of samples from the 'samples' memory position into
+  // the input of the object. Notice that sample rate _has_to_ be set before
+  // calling this function, otherwise throws a runtime_error exception.
+  TSoundTouchPutSamples = procedure (Handle: TSoundTouchHandle;
+                                     const Samples: PSingle; //< Pointer to sample buffer.
+                                     NumSamples: Cardinal    //< Number of samples in buffer. Notice
+                                                             //< that in case of stereo-sound a single sample
+                                                             //< contains data for both channels.
+                                    ); stdcall;
+
+  // Clears all the samples in the object's output and internal processing
+  // buffers.
+  TSoundTouchClear = procedure (Handle: TSoundTouchHandle); stdcall;
+
+  // Changes a setting controlling the processing system behaviour. See the
+  // 'SETTING_...' defines for available setting ID's.
+  //
+  // \return 'TRUE' if the setting was succesfully changed
+  TSoundTouchSetSetting = function (Handle: TSoundTouchHandle;
+                                 SettingId: Integer;   //< Setting ID number. see SETTING_... defines.
+                                 Value: Integer        //< New setting value.
+                                ): Boolean; stdcall;
+
+  // Reads a setting controlling the processing system behaviour. See the
+  // 'SETTING_...' defines for available setting ID's.
+  //
+  // \return the setting value.
+  TSoundTouchGetSetting = function (Handle: TSoundTouchHandle;
+                                 settingId: Integer     //< Setting ID number, see SETTING_... defines.
+                                ): Integer; stdcall;
+
+
+  // Returns number of samples currently unprocessed.
+  TSoundTouchNumUnprocessedSamples = function (Handle: TSoundTouchHandle): Cardinal; stdcall;
+
+  // Adjusts book-keeping so that given number of samples are removed from beginning of the
+  // sample buffer without copying them anywhere.
+  //
+  // Used to reduce the number of samples in the buffer when accessing the sample buffer directly
+  // with 'ptrBegin' function.
+  TSoundTouchReceiveSamples = function (Handle: TSoundTouchHandle;
+                                     outBuffer: PSingle;           //< Buffer where to copy output samples.
+                                     maxSamples: Integer      //< How many samples to receive at max.
+                                    ): Cardinal; stdcall;
+
+  // Returns number of samples currently available.
+  TSoundTouchNumSamples = function (Handle: TSoundTouchHandle): Cardinal; stdcall;
+
+  // Returns nonzero if there aren't any samples available for outputting.
+  TSoundTouchIsEmpty = function (Handle: TSoundTouchHandle): Integer; stdcall;
+
+var
+  SoundTouchCreateInstance        : TSoundTouchCreateInstance;
+  SoundTouchDestroyInstance       : TSoundTouchDestroyInstance;
+  SoundTouchGetVersionString      : TSoundTouchGetVersionString;
+  SoundTouchGetVersionId          : TSoundTouchGetVersionId;
+  SoundTouchSetRate               : TSoundTouchSetRate;
+  SoundTouchSetTempo              : TSoundTouchSetTempo;
+  SoundTouchSetRateChange         : TSoundTouchSetRateChange;
+  SoundTouchSetTempoChange        : TSoundTouchSetTempoChange;
+  SoundTouchSetPitch              : TSoundTouchSetPitch;
+  SoundTouchSetPitchOctaves       : TSoundTouchSetPitchOctaves;
+  SoundTouchSetPitchSemiTones     : TSoundTouchSetPitchSemiTones;
+  SoundTouchSetChannels           : TSoundTouchSetChannels;
+  SoundTouchSetSampleRate         : TSoundTouchSetSampleRate;
+  SoundTouchFlush                 : TSoundTouchFlush;
+  SoundTouchPutSamples            : TSoundTouchPutSamples;
+  SoundTouchClear                 : TSoundTouchClear;
+  SoundTouchSetSetting            : TSoundTouchSetSetting;
+  SoundTouchGetSetting            : TSoundTouchGetSetting;
+  SoundTouchNumUnprocessedSamples : TSoundTouchNumUnprocessedSamples;
+  SoundTouchReceiveSamples        : TSoundTouchReceiveSamples;
+  SoundTouchNumSamples            : TSoundTouchNumSamples;
+  SoundTouchIsEmpty               : TSoundTouchIsEmpty;
+
+type
+  TSoundTouch = class
+  private
+    FHandle     : TSoundTouchHandle;
+    FRate       : Single;
+    FPitch      : Single;
+    FTempo      : Single;
+    FSampleRate : Single;
+    FChannels   : Cardinal;
+    function GetNumSamples: Cardinal;
+    function GetNumUnprocessedSamples: Cardinal;
+    function GetIsEmpty: Integer;
+    function GetPitchChange: Single;
+    function GetRateChange: Single;
+    function GetTempoChange: Single;
+    procedure SetRate(const Value: Single);
+    procedure SetPitch(const Value: Single);
+    procedure SetTempo(const Value: Single);
+    procedure SetPitchChange(const Value: Single);
+    procedure SetRateChange(const Value: Single);
+    procedure SetTempoChange(const Value: Single);
+    procedure SetChannels(const Value: Cardinal);
+    procedure SetSampleRate(const Value: Single);
+  protected
+    procedure SamplerateChanged; virtual;
+    procedure ChannelsChanged; virtual;
+    procedure PitchChanged; virtual;
+    procedure TempoChanged; virtual;
+    procedure RateChanged; virtual;
+  public
+    class function GetVersionString: string;
+    class function GetVersionId: Cardinal;
+    constructor Create; virtual;
+    destructor Destroy; override;
+    procedure Flush; virtual;
+    procedure Clear; virtual;
+
+    procedure PutSamples(const Samples: PSingle; const NumSamples: Cardinal);
+    function ReceiveSamples(const outBuffer: PSingle; const maxSamples: Integer): Cardinal;
+
+    function SetSetting(const SettingId: Integer; const Value: Integer): Boolean;
+    function GetSetting(const settingId: Integer): Integer;
+
+    property VersionString: string read GetVersionString;
+    property VersionID: Cardinal read GetVersionId;
+    property Channels: Cardinal read FChannels write SetChannels;
+    property Rate: Single read FRate write SetRate;
+    property RateChange: Single read GetRateChange write SetRateChange;
+    property Tempo: Single read FTempo write SetTempo;
+    property TempoChange: Single read GetTempoChange write SetTempoChange;
+    property Pitch: Single read FPitch write SetPitch;
+    property PitchChange: Single read GetPitchChange write SetPitchChange;
+    property SampleRate: Single read FSampleRate write SetSampleRate;
+
+    property NumSamples: Cardinal read GetNumSamples;
+    property NumUnprocessedSamples: Cardinal read GetNumUnprocessedSamples;
+    property IsEmpty: Integer read GetIsEmpty;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TSoundTouch }
+
+constructor TSoundTouch.Create;
+begin
+  inherited;
+  FHandle := SoundTouchCreateInstance;
+  FRate := 1;
+  FTempo := 1;
+  FPitch := 1;
+  FChannels := 1;
+  FSampleRate := 44100;
+  SamplerateChanged;
+  ChannelsChanged;
+end;
+
+destructor TSoundTouch.Destroy;
+begin
+  SoundTouchDestroyInstance(FHandle);
+  inherited;
+end;
+
+procedure TSoundTouch.Flush;
+begin
+  SoundTouchFlush(FHandle);
+end;
+
+procedure TSoundTouch.Clear;
+begin
+  SoundTouchClear(FHandle);
+end;
+
+function TSoundTouch.GetIsEmpty: Integer;
+begin
+  result := SoundTouchIsEmpty(FHandle);
+end;
+
+function TSoundTouch.GetNumSamples: Cardinal;
+begin
+  result := SoundTouchNumSamples(FHandle);
+end;
+
+function TSoundTouch.GetNumUnprocessedSamples: Cardinal;
+begin
+  result := SoundTouchNumUnprocessedSamples(FHandle);
+end;
+
+function TSoundTouch.GetPitchChange: Single;
+begin
+  result := 100 * (FPitch - 1.0);
+end;
+
+function TSoundTouch.GetRateChange: Single;
+begin
+  result := 100 * (FRate - 1.0);
+end;
+
+function TSoundTouch.GetTempoChange: Single;
+begin
+  result := 100 * (FTempo - 1.0);
+end;
+
+class function TSoundTouch.GetVersionId: Cardinal;
+begin
+  result := SoundTouchGetVersionId;
+end;
+
+class function TSoundTouch.GetVersionString: string;
+begin
+  result := StrPas(SoundTouchGetVersionString);
+end;
+
+procedure TSoundTouch.SetChannels(const Value: Cardinal);
+begin
+  if FChannels <> Value then
+  begin
+    FChannels := Value;
+    ChannelsChanged;
+  end;
+end;
+
+procedure TSoundTouch.ChannelsChanged;
+begin
+  assert(FChannels in [1, 2]);
+  SoundTouchSetChannels(FHandle, FChannels);
+end;
+
+procedure TSoundTouch.SetPitch(const Value: Single);
+begin
+  if FPitch <> Value then
+  begin
+    FPitch := Value;
+    PitchChanged;
+  end;
+end;
+
+procedure TSoundTouch.PitchChanged;
+begin
+  SoundTouchSetPitch(FHandle, FPitch);
+end;
+
+procedure TSoundTouch.putSamples(const Samples: PSingle;
+  const NumSamples: Cardinal);
+begin
+  SoundTouchPutSamples(FHandle, Samples, NumSamples);
+end;
+
+procedure TSoundTouch.RateChanged;
+begin
+  SoundTouchSetRate(FHandle, FRate);
+end;
+
+function TSoundTouch.ReceiveSamples(const outBuffer: PSingle;
+  const maxSamples: Integer): Cardinal;
+begin
+  result := SoundTouchReceiveSamples(FHandle, outBuffer, maxSamples);
+end;
+
+procedure TSoundTouch.SetPitchChange(const Value: Single);
+begin
+  Pitch := 1.0 + 0.01 * Value;
+end;
+
+procedure TSoundTouch.SetRate(const Value: Single);
+begin
+  if FRate <> Value then
+  begin
+    FRate := Value;
+    RateChanged;
+  end;
+end;
+
+procedure TSoundTouch.SetRateChange(const Value: Single);
+begin
+  Rate := 1.0 + 0.01 * Value;
+end;
+
+procedure TSoundTouch.SetSampleRate(const Value: Single);
+begin
+  if FSampleRate <> Value then
+  begin
+    FSampleRate := Value;
+    SamplerateChanged;
+  end;
+end;
+
+procedure TSoundTouch.SamplerateChanged;
+begin
+  assert(FSampleRate > 0);
+  SoundTouchsetSampleRate(FHandle, round(FSampleRate));
+end;
+
+procedure TSoundTouch.SetTempo(const Value: Single);
+begin
+ if FTempo <> Value then
+  begin
+    FTempo := Value;
+    TempoChanged;
+  end;
+end;
+
+procedure TSoundTouch.SetTempoChange(const Value: Single);
+begin
+  Tempo := 1.0 + 0.01 * Value;
+end;
+
+function TSoundTouch.GetSetting(const SettingId: Integer): Integer;
+begin
+  result := SoundTouchGetSetting(FHandle, SettingId);
+end;
+
+function TSoundTouch.SetSetting(const SettingId: Integer;
+  const Value: Integer): Boolean;
+begin
+  result := SoundTouchSetSetting(FHandle, SettingId, Value);
+end;
+
+procedure TSoundTouch.TempoChanged;
+begin
+  SoundTouchsetTempo(FHandle, FTempo);
+end;
+
+var
+  SoundTouchLibHandle: HINST;
+  SoundTouchDLL: PAnsiChar = 'SoundTouch.DLL';
+
+procedure InitDLL;
+begin
+  SoundTouchLibHandle := LoadLibrary(SoundTouchDLL);
+  if SoundTouchLibHandle <> 0 then
+  try
+    SoundTouchCreateInstance        := GetProcAddress(SoundTouchLibHandle, PAnsiChar( 2)); //'soundtouch_createInstance');
+    SoundTouchDestroyInstance       := GetProcAddress(SoundTouchLibHandle, PAnsiChar( 3)); //'soundtouch_destroyInstance');
+    SoundTouchGetVersionString      := GetProcAddress(SoundTouchLibHandle, PAnsiChar( 7)); //'soundtouch_getVersionString');
+    SoundTouchGetVersionId          := GetProcAddress(SoundTouchLibHandle, PAnsiChar( 6)); //'soundtouch_getVersionId');
+    SoundTouchSetRate               := GetProcAddress(SoundTouchLibHandle, PAnsiChar(17)); //'soundtouch_setRate');
+    SoundTouchSetTempo              := GetProcAddress(SoundTouchLibHandle, PAnsiChar(21)); //'soundtouch_setTempo');
+    SoundTouchSetRateChange         := GetProcAddress(SoundTouchLibHandle, PAnsiChar(18)); //'soundtouch_setRateChange');
+    SoundTouchSetTempoChange        := GetProcAddress(SoundTouchLibHandle, PAnsiChar(22)); //'soundtouch_setTempoChange');
+    SoundTouchSetPitch              := GetProcAddress(SoundTouchLibHandle, PAnsiChar(14)); //'soundtouch_setPitch');
+    SoundTouchSetPitchOctaves       := GetProcAddress(SoundTouchLibHandle, PAnsiChar(15)); //'soundtouch_setPitchOctaves');
+    SoundTouchSetPitchSemiTones     := GetProcAddress(SoundTouchLibHandle, PAnsiChar(16)); //'soundtouch_setPitchSemiTones');
+    SoundTouchSetChannels           := GetProcAddress(SoundTouchLibHandle, PAnsiChar(13)); //'soundtouch_setChannels');
+    SoundTouchSetSampleRate         := GetProcAddress(SoundTouchLibHandle, PAnsiChar(19)); //'soundtouch_setSampleRate');
+    SoundTouchFlush                 := GetProcAddress(SoundTouchLibHandle, PAnsiChar(4)); //'soundtouch_flush');
+    SoundTouchPutSamples            := GetProcAddress(SoundTouchLibHandle, PAnsiChar(11)); //'soundtouch_putSamples');
+    SoundTouchClear                 := GetProcAddress(SoundTouchLibHandle, PAnsiChar(1)); //'soundtouch_clear');
+    SoundTouchSetSetting            := GetProcAddress(SoundTouchLibHandle, PAnsiChar(20)); //'soundtouch_SetSetting');
+    SoundTouchGetSetting            := GetProcAddress(SoundTouchLibHandle, PAnsiChar(5)); //'soundtouch_setSetting');
+    SoundTouchNumUnprocessedSamples := GetProcAddress(SoundTouchLibHandle, PAnsiChar(10)); //'soundtouch_numUnprocessedSamples');
+    SoundTouchReceiveSamples        := GetProcAddress(SoundTouchLibHandle, PAnsiChar(12)); //'soundtouch_receiveSamples');
+    SoundTouchNumSamples            := GetProcAddress(SoundTouchLibHandle, PAnsiChar(9)); //'soundtouch_numSamples');
+    SoundTouchIsEmpty               := GetProcAddress(SoundTouchLibHandle, PAnsiChar(8)); //'soundtouch_isEmpty');
+
+  except
+    FreeLibrary(SoundTouchLibHandle);
+    SoundTouchLibHandle := 0;
+  end;
+end;
+
+procedure FreeDLL;
+begin
+  if SoundTouchLibHandle <> 0 then FreeLibrary(SoundTouchLibHandle);
+end;
+
+initialization
+  InitDLL;
+
+finalization
+  FreeDLL;
+
+end.