home *** CD-ROM | disk | FTP | other *** search
/ PC Format (South-Africa) 2001 June / PCFJune.iso / Xenon / ModBass / Delphi / ConTest / ConTest.dpr < prev   
Encoding:
Text File  |  2000-02-19  |  4.4 KB  |  166 lines
  1. {
  2. BASS Simple Console Test, copyright (c) 1999-2000 Ian Luck.
  3. ==============================================================
  4. Delphi version by Titus Miloi (titus.a.m@t-online.de)
  5. }
  6. program ConTest;
  7.  
  8. uses Windows, SysUtils, BASS, MMSystem;
  9.  
  10. {$R *.RES}
  11.  
  12. var
  13.   starttime: DWORD;
  14.  
  15. function IntToFixed(val, digits: Integer): string;
  16. var
  17.   s: string;
  18. begin
  19.   s := IntToStr(val);
  20.   while Length(s) < digits do s := '0' + s;
  21.   Result := s;
  22. end;
  23.  
  24. // display error messages
  25. procedure Error(text: string);
  26. begin
  27.   WriteLn('Error(' + IntToStr(BASS_ErrorGetCode) + '): ' + text);
  28.   BASS_Free;
  29.   Halt(0);
  30. end;
  31.  
  32. // looping synchronizer, resets the clock
  33. procedure LoopSync(handle: HSYNC; channel, data, user: DWORD); stdcall;
  34. begin
  35.   starttime := timeGetTime;
  36. end;
  37.  
  38. var
  39.   mus: HMUSIC;
  40.   str: HSTREAM;
  41.   chn: DWORD;
  42.   time, pos, level: DWORD;
  43.   a: Integer;
  44.   freq, other: DWORD;
  45.   mono: Boolean;
  46.  
  47. begin
  48.   mono := FALSE;
  49.   WriteLn('Simple console mode BASS example : MOD/MP3/WAV player');
  50.   Writeln('-----------------------------------------------------');
  51.  
  52.   // check that BASS 0.8 was loaded
  53.   if (BASS_GetVersion <> MAKELONG(0, 8)) then
  54.   begin
  55.     Writeln('BASS version 0.8 was not loaded');
  56.     Exit;
  57.   end;
  58.   if (ParamCount <> 1) then
  59.   begin
  60.     WriteLn(#9 + 'usage: contest <file>');
  61.     Exit;
  62.   end;
  63.  
  64.   // setup output - default device, 44100hz, stereo, 16 bits
  65.   if not BASS_Init(-1, 44100, 0, GetForegroundWindow) then
  66.     Error('Can''t initialize device');
  67.  
  68.   // try streaming the file
  69.   mus := 0;
  70.   str := BASS_StreamCreateFile(FALSE, PChar(ParamStr(1)), 0, 0, 0);
  71.   if (str <> 0) then
  72.   begin
  73.     // check if the stream is mono (for the level indicator)
  74.     mono := (BASS_ChannelGetFlags(str) and BASS_SAMPLE_MONO) <> 0;
  75.     // set a synchronizer for when the stream reaches the end
  76.     BASS_ChannelSetSync(str, BASS_SYNC_END, 0, LoopSync, 0);
  77.     WriteLn('streaming file [' + IntToStr(BASS_StreamGetLength(str)) + ' bytes]');
  78.   end
  79.   else
  80.   begin
  81.     // load the MOD (with looping and normal ramping)
  82.     mus := BASS_MusicLoad(FALSE, PChar(ParamStr(1)), 0, 0, BASS_MUSIC_LOOP or BASS_MUSIC_RAMP);
  83.     if (mus = 0) then
  84.       // not a MOD either
  85.       Error('Can''t play the file');
  86.     // set a synchronizer for when the MOD reaches the end
  87.     BASS_ChannelSetSync(mus, BASS_SYNC_END, 0, LoopSync, 0);
  88.     WriteLn('playing MOD music "' + BASS_MusicGetName(mus) + '" [' + IntToStr(BASS_MusicGetLength(mus)) + ' orders]');
  89.   end;
  90.  
  91.   BASS_Start;
  92.   if (str <> 0) then
  93.     BASS_StreamPlay(str, FALSE, BASS_SAMPLE_LOOP)
  94.   else
  95.     BASS_MusicPlayEx(mus, 0, -1, TRUE);
  96.   starttime := timeGetTime;
  97.  
  98.   chn := str;
  99.   if chn = 0 then chn := mus;
  100.   while (*not KeyPressed and*) BASS_ChannelIsActive(chn) do
  101.   begin
  102.     // display some stuff and wait a bit
  103.     time := timeGetTime() - starttime;
  104.     level := BASS_ChannelGetLevel(chn);
  105.     pos := BASS_ChannelGetPosition(chn);
  106.     if (str <> 0) then
  107.       Write('pos ' + IntToFixed(pos, 9) + ' - time ' + IntToStr(time div 60000) + ':' + IntToFixed((time div 1000) mod 60, 2) + ' - L ')
  108.     else
  109.       Write('pos ' + IntToFixed(LOWORD(pos), 3) + ':' + IntToFixed(HIWORD(pos), 3) + ' - time ' + IntToStr(time div 60000) + ':' + IntToFixed((time div 1000) mod 60, 2) + ' - L ');
  110.     a := 93;
  111.     while (a > 0) do
  112.     begin
  113.       if LOWORD(level) >= a then
  114.         Write('*')
  115.       else
  116.         Write('-');
  117.       a := a * 2 div 3;
  118.     end;
  119.     Write(' ');
  120.     if mono then
  121.     begin
  122.       a := 1;
  123.       while (a < 128) do
  124.       begin
  125.         if LOWORD(level) >= a then
  126.           Write('*')
  127.         else
  128.           Write('-');
  129.         a := 2 * a - a div 2;
  130.       end;
  131.     end
  132.     else
  133.     begin
  134.       a := 1;
  135.       while (a < 128) do
  136.       begin
  137.         if HIWORD(level) >= a then
  138.           Write('*')
  139.         else
  140.           Write('-');
  141.         a := 2 * a - a div 2;
  142.       end;
  143.     end;
  144.     Write(' R - cpu ' + FloatToStrF(BASS_GetCPU(), ffFixed, 0, 1) + '%  ' + #13);
  145.     Sleep(50);
  146.   end;
  147.   Writeln('                                                                   ');
  148.  
  149.   // get the frequency... and wind it down
  150.   BASS_ChannelGetAttributes(chn, freq, other, a);
  151.   level := freq div 40;
  152.   while (freq >= 2000) do
  153.   begin
  154.     BASS_ChannelSetAttributes(chn, freq, -1, -101);
  155.     Sleep(5);
  156.     freq := freq - level;
  157.   end;
  158.   // fade-out to avoid a "click"
  159.   for a := 20 downto 0 do
  160.   begin
  161.     BASS_SetVolume(a * 5);
  162.     Sleep(1);
  163.   end;
  164.   BASS_Free();
  165. end.
  166.