home *** CD-ROM | disk | FTP | other *** search
/ PC Format (South-Africa) 2001 June / PCFJune.iso / Xenon / ModBass / Delphi / DspTest / DTMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-02-19  |  6.2 KB  |  247 lines
  1. unit DTMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, BASS;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     CheckBox1: TCheckBox;
  13.     CheckBox2: TCheckBox;
  14.     CheckBox3: TCheckBox;
  15.     OpenDialog1: TOpenDialog;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure FormDestroy(Sender: TObject);
  19.     procedure CheckBox1Click(Sender: TObject);
  20.     procedure CheckBox2Click(Sender: TObject);
  21.     procedure CheckBox3Click(Sender: TObject);
  22.   private
  23.     { Private-Deklarationen }
  24.     chan: DWORD;
  25.     procedure Error(msg: string);
  26.   public
  27.     { Public-Deklarationen }
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. const
  38.   ECHBUFLEN = 1200;        // buffer length
  39.   FLABUFLEN = 350;         // buffer length
  40.  
  41. var
  42.   d: ^DWORD;
  43.   rotdsp: HDSP;            // DSP handle
  44.   rotpos: FLOAT;           // cur.pos
  45.   echdsp: HDSP;            // DSP handle
  46.   echbuf: array[0..ECHBUFLEN-1, 0..1] of SmallInt;  // buffer
  47.   echpos: Integer;         // cur.pos
  48.   fladsp: HDSP;            // DSP handle
  49.   flabuf: array[0..FLABUFLEN-1, 0..2] of SmallInt;  // buffer
  50.   flapos: Integer;         // cur.pos
  51.   flas, flasinc: FLOAT;  // sweep pos/min/max/inc
  52.  
  53. function fmod(a, b: FLOAT): FLOAT;
  54. begin
  55.   Result := a - (b * Trunc(a / b));
  56. end;
  57.  
  58. function Clip(a: Integer): Integer;
  59. begin
  60.   if a <= -32768 then a := -32768
  61.   else if a >= 32767 then a := 32767;
  62.   Result := a;
  63. end;
  64.  
  65. procedure Rotate(handle: HSYNC; channel: DWORD; buffer: Pointer; length, user: DWORD); stdcall;
  66. var
  67.   lc, rc: SmallInt;
  68. begin
  69.   d := buffer;
  70.   while (length > 0) do
  71.   begin
  72.     lc := LOWORD(d^); rc := HIWORD(d^);
  73.     lc := SmallInt(Trunc(sin(rotpos) * lc));
  74.     rc := SmallInt(Trunc(cos(rotpos) * rc));
  75.     d^ := MakeLong(lc, rc);
  76.     Inc(d);
  77.     rotpos := rotpos + fmod(0.00003, PI);
  78.     length := length - 4;
  79.   end;
  80. end;
  81.  
  82. procedure Echo(handle: HSYNC; channel: DWORD; buffer: Pointer; length, user: DWORD); stdcall;
  83. var
  84.   lc, rc: SmallInt;
  85.   l, r: Integer;
  86. begin
  87.   d := buffer;
  88.   while (length > 0) do
  89.   begin
  90.     lc := LOWORD(d^); rc := HIWORD(d^);
  91.     l := lc + (echbuf[echpos, 1] div 2);
  92.     r := rc + (echbuf[echpos, 0] div 2);
  93.     echbuf[echpos, 0] := lc;
  94.     echbuf[echpos, 1] := rc;
  95.     lc := Clip(l);
  96.     rc := Clip(r);
  97.     d^ := MakeLong(lc, rc);
  98.     Inc(d);
  99.     Inc(echpos);
  100.     if (echpos = ECHBUFLEN) then echpos := 0;
  101.     length := length - 4;
  102.   end;
  103. end;
  104.  
  105. procedure Flange(handle: HSYNC; channel: DWORD; buffer: Pointer; length, user: DWORD); stdcall;
  106. var
  107.   lc, rc: SmallInt;
  108.   p1, p2, s: Integer;
  109.   f: FLOAT;
  110. begin
  111.   d := buffer;
  112.   while (length > 0) do
  113.   begin
  114.     lc := LOWORD(d^); rc := HIWORD(d^);
  115.     p1 := (flapos + Trunc(flas)) mod FLABUFLEN;
  116.     p2 := (p1 + 1) mod FLABUFLEN;
  117.     f := fmod(flas, 1.0);
  118.     s := lc + Trunc(((1.0-f) * flabuf[p1, 0]) + (f * flabuf[p2, 0]));
  119.     flabuf[flapos, 0] := lc;
  120.     lc := Clip(s);
  121.     s := rc + Trunc(((1.0-f) * flabuf[p1, 1]) + (f * flabuf[p2, 1]));
  122.     flabuf[flapos, 1] := rc;
  123.     rc := Clip(s);
  124.     d^ := MakeLong(lc, rc);
  125.     Inc(d);
  126.     Inc(flapos);
  127.     if (flapos = FLABUFLEN) then flapos := 0;
  128.     flas := flas + flasinc;
  129.     if (flas < 0) or (flas > FLABUFLEN) then
  130.       flasinc := -flasinc;
  131.     length := length - 4;
  132.   end;
  133. end;
  134.  
  135. procedure TForm1.Error(msg: string);
  136. var
  137.   s: string;
  138. begin
  139.   s := msg + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) + ')';
  140.   MessageBox(handle, PChar(s), 'Error', MB_ICONERROR or MB_OK);
  141. end;
  142.  
  143. procedure TForm1.FormCreate(Sender: TObject);
  144. begin
  145.   rotdsp := 0;
  146.   echdsp := 0;
  147.   fladsp := 0;
  148.   if (BASS_GetVersion <> MAKELONG(0,8)) then
  149.   begin
  150.     Error('BASS version 0.8 was not loaded');
  151.     Halt;
  152.   end;
  153.   // setup output - default device, 44100hz, stereo, 16 bits, no syncs (not used)
  154.   if not BASS_Init(-1, 44100, BASS_DEVICE_NOSYNC, handle) then
  155.   begin
  156.     Error('Can''t initialize device');
  157.     Halt;
  158.   end
  159.   else
  160.     BASS_Start;
  161. end;
  162.  
  163. procedure TForm1.Button1Click(Sender: TObject);
  164. var
  165.   chattr: Integer;
  166. begin
  167.   if OpenDialog1.Execute then
  168.   begin
  169.     // free both MOD and stream, it must be one of them! :)
  170.     BASS_MusicFree(chan);
  171.     BASS_StreamFree(chan);
  172.     chan := BASS_StreamCreateFile(FALSE, PChar(OpenDialog1.FileName), 0, 0, 0);
  173.     if (chan = 0) then
  174.       chan := BASS_MusicLoad(FALSE, PChar(OpenDialog1.FileName), 0, 0, BASS_MUSIC_LOOP or BASS_MUSIC_RAMP);
  175.     if (chan = 0) then
  176.     begin
  177.       // not a WAV/MP3 or MOD
  178.       Button1.Caption := 'click here to open a file...';
  179.       Error('Can''t play the file');
  180.       Exit;
  181.     end;
  182.     chattr := BASS_ChannelGetFlags(chan) and (BASS_SAMPLE_MONO or BASS_SAMPLE_8BITS);
  183.     if chattr > 0 then
  184.     begin
  185.       // not 16-bit stereo
  186.       Button1.Caption := 'click here to open a file...';
  187.       BASS_MusicFree(chan);
  188.       BASS_StreamFree(chan);
  189.       Error('16-bit stereo sources only');
  190.       Exit;
  191.     end;
  192.     Button1.Caption := OpenDialog1.FileName;
  193.     // setup DSPs on new channel
  194.     CheckBox1Click(Sender);
  195.     CheckBox2Click(Sender);
  196.     CheckBox3Click(Sender);
  197.     // play both MOD and stream, it must be one of them! :)
  198.     BASS_MusicPlay(chan);
  199.     BASS_StreamPlay(chan, FALSE, BASS_SAMPLE_LOOP);
  200.   end;
  201. end;
  202.  
  203. procedure TForm1.FormDestroy(Sender: TObject);
  204. begin
  205.   BASS_Free();
  206. end;
  207.  
  208. procedure TForm1.CheckBox1Click(Sender: TObject);
  209. begin
  210.   if CheckBox1.Checked then
  211.   begin
  212.     rotpos := 0.7853981;
  213.     rotdsp := BASS_ChannelSetDSP(chan, Rotate, 0);
  214.   end
  215.   else
  216.     BASS_ChannelRemoveDSP(chan, rotdsp);
  217. end;
  218.  
  219. procedure TForm1.CheckBox2Click(Sender: TObject);
  220. begin
  221.   if CheckBox2.Checked then
  222.   begin
  223.     FillChar(echbuf, SizeOf(echbuf), 0);
  224.     echpos := 0;
  225.     echdsp := BASS_ChannelSetDSP(chan, Echo, 0);
  226.   end
  227.   else
  228.     BASS_ChannelRemoveDSP(chan, echdsp);
  229. end;
  230.  
  231. procedure TForm1.CheckBox3Click(Sender: TObject);
  232. begin
  233.   if CheckBox3.Checked then
  234.   begin
  235.     FillChar(flabuf, SizeOf(flabuf), 0);
  236.     flapos := 0;
  237.     flas := FLABUFLEN / 2;
  238.     flasinc := 0.002;
  239.     fladsp := BASS_ChannelSetDSP(chan, Flange, 0);
  240.   end
  241.   else
  242.     BASS_ChannelRemoveDSP(chan, fladsp);
  243. end;
  244.  
  245. end.
  246.  
  247.