home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / Delphi / BassTest / BTMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2005-09-14  |  7.2 KB  |  336 lines
  1. (*
  2.  *    BassTest - Simple BASS Test for Delphi
  3.  *)
  4.  
  5. unit BTMain;
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  11.   Bass, StdCtrls, ExtCtrls, Buttons;
  12.  
  13. type
  14.   TForm1 = class(TForm)
  15.     GroupBox1: TGroupBox;
  16.     GroupBox2: TGroupBox;
  17.     GroupBox3: TGroupBox;
  18.     Button1: TButton;
  19.     Button2: TButton;
  20.     Label1: TLabel;
  21.     ListBox1: TListBox;
  22.     ListBox2: TListBox;
  23.     Button4: TButton;
  24.     Button5: TButton;
  25.     Button6: TButton;
  26.     Button7: TButton;
  27.     Button8: TButton;
  28.     Button9: TButton;
  29.     Button10: TButton;
  30.     Button11: TButton;
  31.     OpenDialog1: TOpenDialog;
  32.     Timer1: TTimer;
  33.     OpenDialog2: TOpenDialog;
  34.     OpenDialog3: TOpenDialog;
  35.     ListBox3: TListBox;
  36.     Button3: TButton;
  37.     Button12: TButton;
  38.     Button13: TButton;
  39.     Button14: TButton;
  40.     Button15: TButton;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  43.     procedure Button4Click(Sender: TObject);
  44.     procedure Button5Click(Sender: TObject);
  45.     procedure Button6Click(Sender: TObject);
  46.     procedure Button7Click(Sender: TObject);
  47.     procedure Button8Click(Sender: TObject);
  48.     procedure Timer1Timer(Sender: TObject);
  49.     procedure Button1Click(Sender: TObject);
  50.     procedure Button2Click(Sender: TObject);
  51.     procedure Button10Click(Sender: TObject);
  52.     procedure Button11Click(Sender: TObject);
  53.     procedure Button9Click(Sender: TObject);
  54.     procedure Button15Click(Sender: TObject);
  55.     procedure Button14Click(Sender: TObject);
  56.     procedure Button3Click(Sender: TObject);
  57.     procedure Button12Click(Sender: TObject);
  58.     procedure Button13Click(Sender: TObject);
  59.   private
  60.     mods: array[0..128] of HMUSIC;
  61.     modc: Integer;
  62.     sams: array[0..128] of HSAMPLE;
  63.     samc: Integer;
  64.     strs: array[0..128] of HSTREAM;
  65.     strc: Integer;
  66.     procedure Error(msg: string);
  67.   public
  68.   end;
  69.  
  70. var
  71.   Form1: TForm1;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77.  
  78. procedure TForm1.Error(msg: string);
  79. var
  80.     s: string;
  81. begin
  82.     s := msg + #13#10 + '(Error code: ' + IntToStr(BASS_ErrorGetCode) + ')';
  83.     MessageBox(Handle, PChar(s), 'Error', MB_ICONERROR or MB_OK);
  84. end;
  85.  
  86.  
  87. procedure TForm1.FormCreate(Sender: TObject);
  88. begin
  89.     modc := 0;        // music module count
  90.     samc := 0;        // sample count
  91.     strc := 0;        // stream count
  92.  
  93.     // Ensure BASS 2.2 was loaded
  94.     if BASS_GetVersion() <> DWORD(MAKELONG(2,2)) then begin
  95.         Error('BASS version 2.2 was not loaded!');
  96.         Halt;
  97.     end;
  98.  
  99.     // Initialize audio - default device, 44100hz, stereo, 16 bits
  100.     if not BASS_Init(-1, 44100, 0, Handle, nil) then
  101.         Error('Error initializing audio!');
  102. end;
  103.  
  104.  
  105. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  106. var
  107.   a: Integer;
  108. begin
  109.     (*
  110.      (It's not actually necessary to free the streams, musics and
  111.      samples because they are automatically freed by BASS_Free.)
  112.     *)
  113.  
  114.     // Free stream
  115.   if strc > 0 then
  116.     for a := 0 to strc - 1 do
  117.         BASS_StreamFree(strs[a]);
  118.  
  119.     // Free music
  120.     if modc > 0 then
  121.         for a := 0 to modc - 1 do
  122.             BASS_MusicFree(mods[a]);
  123.  
  124.     // Free samples
  125.     if samc > 0 then
  126.         for a := 0 to samc - 1 do
  127.             BASS_SampleFree(sams[a]);
  128.  
  129.     // Close BASS
  130.     BASS_Free();
  131. end;
  132.  
  133.  
  134. procedure TForm1.Button4Click(Sender: TObject);
  135. var
  136.     i: Integer;
  137. begin
  138.     i := ListBox1.ItemIndex;
  139.     // Play the music (continuing from current position)
  140.     if i >= 0 then
  141.         if not BASS_ChannelPlay(mods[i], False) then
  142.             Error('Error playing music!');
  143. end;
  144.  
  145.  
  146. procedure TForm1.Button5Click(Sender: TObject);
  147. var
  148.     i: Integer;
  149. begin
  150.     i := ListBox1.ItemIndex;
  151.     // Stop the music
  152.     if i >= 0 then
  153.         BASS_ChannelStop(mods[i]);
  154. end;
  155.  
  156.  
  157. procedure TForm1.Button6Click(Sender: TObject);
  158. var
  159.     i: Integer;
  160. begin
  161.     i := ListBox1.ItemIndex;
  162.     // Play the music from the beginning
  163.     if i >= 0 then
  164.         BASS_ChannelPlay(mods[i], True);
  165. end;
  166.  
  167.  
  168. procedure TForm1.Button7Click(Sender: TObject);
  169. var
  170.     f: PChar;
  171. begin
  172.     if not OpenDialog1.Execute then Exit;
  173.     f := PChar(OpenDialog1.FileName);
  174.     mods[modc] := BASS_MusicLoad(False, f, 0, 0, BASS_MUSIC_RAMP, 0);
  175.     if mods[modc] <> 0 then
  176.     begin
  177.         ListBox1.Items.Add(OpenDialog1.FileName);
  178.         Inc(modc);
  179.     end
  180.     else
  181.         Error('Error loading music!');
  182. end;
  183.  
  184.  
  185. procedure TForm1.Button8Click(Sender: TObject);
  186. var
  187.     a, i: Integer;
  188. begin
  189.     i := ListBox1.ItemIndex;
  190.     if i >= 0 then
  191.     begin
  192.         BASS_MusicFree(mods[i]);
  193.         if i < modc then
  194.             for a := i to modc - 1 do
  195.                 mods[a] := mods[a + 1];
  196.         Dec(modc);
  197.         ListBox1.Items.Delete(i);
  198.     end;
  199. end;
  200.  
  201.  
  202. procedure TForm1.Timer1Timer(Sender: TObject);
  203. begin
  204.     // update the CPU usage % display
  205.     Label1.Caption := 'CPU%  ' + FloatToStrF(BASS_GetCPU, ffFixed, 4, 2);
  206. end;
  207.  
  208.  
  209. procedure TForm1.Button1Click(Sender: TObject);
  210. begin
  211.     // Pause audio output
  212.     BASS_Pause();
  213. end;
  214.  
  215. procedure TForm1.Button2Click(Sender: TObject);
  216. begin
  217.     // Resume audio output
  218.     BASS_Start();
  219. end;
  220.  
  221.  
  222. procedure TForm1.Button10Click(Sender: TObject);
  223. var
  224.   f: PChar;
  225. begin
  226.     if not OpenDialog3.Execute then Exit;
  227.     f := PChar(OpenDialog3.FileName);
  228.     sams[samc] := BASS_SampleLoad(FALSE, f, 0, 0, 3, BASS_SAMPLE_OVER_POS);
  229.     if sams[samc] <> 0 then
  230.     begin
  231.         ListBox2.Items.Add(OpenDialog3.FileName);
  232.         Inc(samc);
  233.     end
  234.     else
  235.         Error('Error loading sample!');
  236. end;
  237.  
  238.  
  239. procedure TForm1.Button11Click(Sender: TObject);
  240. var
  241.     a, i: Integer;
  242. begin
  243.   i := ListBox2.ItemIndex;
  244.     if i >= 0 then
  245.     begin
  246.         BASS_SampleFree(sams[i]);
  247.         if i < samc then
  248.             for a := i to samc - 1 do
  249.                 sams[a] := sams[a + 1];
  250.         Dec(samc);
  251.         ListBox2.Items.Delete(i);
  252.     end;
  253. end;
  254.  
  255. procedure TForm1.Button9Click(Sender: TObject);
  256. var
  257.     i: Integer;
  258.   ch: HCHANNEL;
  259. begin
  260.     i := ListBox2.ItemIndex;
  261.   // Play the sample at default rate, volume=50, random pan position
  262.     if i >= 0 then
  263.   begin
  264.     ch := BASS_SampleGetChannel(sams[i], False);
  265.     BASS_ChannelSetAttributes(ch, -1, 50, Random(200) - 100);
  266.         if not BASS_ChannelPlay(sams[i], False) then
  267.             Error('Error playing sample!');
  268.   end;
  269. end;
  270.  
  271.  
  272. procedure TForm1.Button15Click(Sender: TObject);
  273. var
  274.     f: PChar;
  275. begin
  276.     if not OpenDialog2.Execute then Exit;
  277.     f := PChar(OpenDialog2.FileName);
  278.     strs[strc] := BASS_StreamCreateFile(False, f, 0, 0, 0);
  279.     if strs[strc] <> 0 then
  280.     begin
  281.         ListBox3.Items.Add(OpenDialog2.FileName);
  282.         Inc(strc);
  283.     end
  284.     else
  285.         Error('Error creating stream!');
  286. end;
  287.  
  288. procedure TForm1.Button14Click(Sender: TObject);
  289. var
  290.     a, i: Integer;
  291. begin
  292.     i := ListBox3.ItemIndex;
  293.     if i >= 0 then
  294.     begin
  295.         BASS_StreamFree(strs[i]);
  296.         if i < strc then
  297.             for a := i to strc - 1 do
  298.                 strs[a] := strs[a + 1];
  299.         Dec(strc);
  300.         ListBox3.Items.Delete(i);
  301.     end;
  302. end;
  303.  
  304. procedure TForm1.Button3Click(Sender: TObject);
  305. var
  306.     i: Integer;
  307. begin
  308.     i := ListBox3.ItemIndex;
  309.     // Play the stream (continuing from current position)
  310.     if i >= 0 then
  311.         if not BASS_ChannelPlay(strs[i], False) then
  312.             Error('Error playing stream!');
  313. end;
  314.  
  315. procedure TForm1.Button12Click(Sender: TObject);
  316. var
  317.     i: Integer;
  318. begin
  319.     i := ListBox3.ItemIndex;
  320.     // Stop the stream
  321.     if i >= 0 then
  322.         BASS_ChannelStop(strs[i]);
  323. end;
  324.  
  325. procedure TForm1.Button13Click(Sender: TObject);
  326. var
  327.     i: Integer;
  328. begin
  329.     i := ListBox3.ItemIndex;
  330.     // Play the stream from the beginning
  331.     if i >= 0 then
  332.         BASS_ChannelPlay(strs[i], True);
  333. end;
  334.  
  335. end.
  336.