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