556 lines
15 KiB
ObjectPascal
556 lines
15 KiB
ObjectPascal
|
// BASS spectrum analyser example, copyright (c) 2002-2006 Ian Luck.
|
||
|
|
//
|
||
|
|
// C++ to Delphi adapted by Evgeny Melnikov
|
||
|
|
//
|
||
|
|
// http://dsoft1961.narod.ru
|
||
|
|
// mail angvelem@gmail.com
|
||
|
|
|
||
|
|
unit Unit1;
|
||
|
|
|
||
|
|
{$I Common.inc}
|
||
|
|
|
||
|
|
{$IFDEF D7}
|
||
|
|
{$WARN SYMBOL_PLATFORM OFF}
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, CommDlg, MMSystem, Bass;
|
||
|
|
|
||
|
|
const
|
||
|
|
SPECWIDTH = 368; // display width
|
||
|
|
SPECHEIGHT = 127; // height (changing requires palette adjustments too)
|
||
|
|
BANDS = 28;
|
||
|
|
szAppName = 'BASS-Spectrum';
|
||
|
|
|
||
|
|
BASSErCodes : array[-1..44] of String = (
|
||
|
|
'Some other mystery error',
|
||
|
|
'All is OK',
|
||
|
|
'Memory error',
|
||
|
|
'Can''t open the file',
|
||
|
|
'Can''t find a free sound driver',
|
||
|
|
'The sample buffer was lost',
|
||
|
|
'Invalid handle',
|
||
|
|
'Unsupported sample format',
|
||
|
|
'Invalid playback position',
|
||
|
|
'BASS_Init has not been successfully called',
|
||
|
|
'BASS_Start has not been successfully called',
|
||
|
|
'Unknown error',
|
||
|
|
'Unknown error',
|
||
|
|
'Unknown error',
|
||
|
|
'Unknown error',
|
||
|
|
'Already initialized/paused/whatever',
|
||
|
|
'Unknown error',
|
||
|
|
'Not paused',
|
||
|
|
'Unknown error',
|
||
|
|
'Can''t get a free channel',
|
||
|
|
'An illegal type was specified',
|
||
|
|
'An illegal parameter was specified',
|
||
|
|
'No 3D support',
|
||
|
|
'No EAX support',
|
||
|
|
'Illegal device number',
|
||
|
|
'Not playing',
|
||
|
|
'Illegal sample rate',
|
||
|
|
'Unknown error',
|
||
|
|
'The stream is not a file stream',
|
||
|
|
'Unknown error',
|
||
|
|
'No hardware voices available',
|
||
|
|
'Unknown error',
|
||
|
|
'The MOD music has no sequence data',
|
||
|
|
'No internet connection could be opened',
|
||
|
|
'Couldn''t create the file',
|
||
|
|
'Effects are not enabled',
|
||
|
|
'The channel is playing',
|
||
|
|
'Unknown error',
|
||
|
|
'Requested data is not available',
|
||
|
|
'The channel is a "decoding channel"',
|
||
|
|
'A sufficient DirectX version is not installed',
|
||
|
|
'Connection timedout',
|
||
|
|
'Unsupported file format',
|
||
|
|
'Unavailable speaker',
|
||
|
|
'Invalid BASS version (used by add-ons)',
|
||
|
|
'Codec is not available/supported');
|
||
|
|
|
||
|
|
var
|
||
|
|
Window : HWND = 0;
|
||
|
|
Msg : TMsg;
|
||
|
|
WndClass : TWndClassEX;
|
||
|
|
|
||
|
|
PosX, PosY : Integer;
|
||
|
|
SizeX, SizeY : Integer;
|
||
|
|
|
||
|
|
Timer : DWORD = 0;
|
||
|
|
Chan : DWORD;
|
||
|
|
|
||
|
|
SpecDC : HDC = 0;
|
||
|
|
SpecBmp : HBITMAP = 0;
|
||
|
|
SpecBuf : Pointer;
|
||
|
|
SpecMode : Integer = 0;
|
||
|
|
SpecPos : Integer = 0; // spectrum mode (and marker pos for 2nd mode)
|
||
|
|
|
||
|
|
BI : TBITMAPINFO;
|
||
|
|
pal : array[Byte] of TRGBQUAD;
|
||
|
|
|
||
|
|
procedure WinMain;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
var
|
||
|
|
Win32Platform : Integer = 0;
|
||
|
|
Win32MajorVersion : Integer = 0;
|
||
|
|
Win32MinorVersion : Integer = 0;
|
||
|
|
Win32BuildNumber : Integer = 0;
|
||
|
|
Win32CSDVersion : string = '';
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
function IntPower(const Base: Extended; const Exponent: Integer): Extended;
|
||
|
|
asm
|
||
|
|
mov ecx, eax
|
||
|
|
cdq
|
||
|
|
fld1 { Result := 1 }
|
||
|
|
xor eax, edx
|
||
|
|
sub eax, edx { eax := Abs(Exponent) }
|
||
|
|
jz @@3
|
||
|
|
fld Base
|
||
|
|
jmp @@2
|
||
|
|
@@1: fmul ST, ST { X := Base * Base }
|
||
|
|
@@2: shr eax,1
|
||
|
|
jnc @@1
|
||
|
|
fmul ST(1),ST { Result := Result * X }
|
||
|
|
jnz @@1
|
||
|
|
fstp st { pop X from FPU stack }
|
||
|
|
cmp ecx, 0
|
||
|
|
jge @@3
|
||
|
|
fld1
|
||
|
|
fdivrp { Result := 1 / Result }
|
||
|
|
@@3:
|
||
|
|
fwait
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
function Power(const Base, Exponent: Extended): Extended;
|
||
|
|
begin
|
||
|
|
if Exponent = 0.0 then
|
||
|
|
Result := 1.0 { n**0 = 1 }
|
||
|
|
else if (Base = 0.0) and (Exponent > 0.0) then
|
||
|
|
Result := 0.0 { 0**n = 0, n > 0 }
|
||
|
|
else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then
|
||
|
|
Result := IntPower(Base, Integer(Trunc(Exponent)))
|
||
|
|
else
|
||
|
|
Result := Exp(Exponent * Ln(Base))
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// Log.10(X) := Log.2(X) * Log.10(2)
|
||
|
|
|
||
|
|
function Log10(const X : Extended) : Extended;
|
||
|
|
asm
|
||
|
|
FLDLG2 { Log base ten of 2 }
|
||
|
|
FLD X
|
||
|
|
FYL2X
|
||
|
|
FWAIT
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
function IntToStr(I : Integer) : String;
|
||
|
|
begin
|
||
|
|
Str(I, Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
procedure GetOSInfo;
|
||
|
|
var
|
||
|
|
OSVersionInfo : TOSVersionInfo;
|
||
|
|
begin
|
||
|
|
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
|
||
|
|
if GetVersionEx(OSVersionInfo) then
|
||
|
|
with OSVersionInfo do
|
||
|
|
begin
|
||
|
|
Win32Platform := dwPlatformId;
|
||
|
|
Win32MajorVersion := dwMajorVersion;
|
||
|
|
Win32MinorVersion := dwMinorVersion;
|
||
|
|
Win32BuildNumber := dwBuildNumber;
|
||
|
|
Win32CSDVersion := szCSDVersion;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// display error messages
|
||
|
|
|
||
|
|
procedure Error(St : String);
|
||
|
|
var
|
||
|
|
ErrCode : Integer;
|
||
|
|
Mes : String;
|
||
|
|
begin
|
||
|
|
ErrCode := BASS_ErrorGetCode;
|
||
|
|
if ErrCode > 44 then
|
||
|
|
ErrCode := 10;
|
||
|
|
|
||
|
|
Mes := St + #13#10 + BASSErCodes[ErrCode] + #13#10 + '(Error code: ' + IntToStr(ErrCode) + ')';
|
||
|
|
MessageBox(0, PChar(Mes), '', MB_ICONERROR or MB_OK);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// select a file to play, and play it
|
||
|
|
|
||
|
|
function PlayFile(Wnd : HWND) : Boolean;
|
||
|
|
var
|
||
|
|
FileName : array[0..MAX_PATH - 1] of Char;
|
||
|
|
ofn : TOPENFILENAME;
|
||
|
|
TempFileName : String;
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
FillChar(ofn, SizeOf(ofn), 0);
|
||
|
|
FillChar(FileName, SizeOf(FileName), 0);
|
||
|
|
{$IFDEF D7}
|
||
|
|
if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) or { Win2k }
|
||
|
|
((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (Win32MajorVersion >= 4) and (Win32MinorVersion >= 90)) then { WinME }
|
||
|
|
ofn.lStructSize := SizeOf(TOpenFilename)
|
||
|
|
else
|
||
|
|
ofn.lStructSize := SizeOf(TOpenFilename) - (SizeOf(DWORD) shl 1) - SizeOf(Pointer); { subtract size of added fields }
|
||
|
|
{$ELSE}
|
||
|
|
ofn.lStructSize := SizeOf(TOpenFilename);
|
||
|
|
{$ENDIF}
|
||
|
|
ofn.hwndOwner := Window;
|
||
|
|
ofn.hInstance := hInstance;
|
||
|
|
ofn.lpstrTitle := 'Select a file to play';
|
||
|
|
ofn.lpstrFile := FileName;
|
||
|
|
ofn.lpstrFilter := 'playable files'#0'*.mo3;*.xm;*.mod;*.s3m;*.it;*.mtm;*.umx;*.mp3;*.mp2;*.mp1;*.ogg;*.wav;*.aif'#0'All files'#0'*.*'#0#0;
|
||
|
|
ofn.nMaxFile := MAX_PATH;
|
||
|
|
ofn.Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_EXPLORER;
|
||
|
|
|
||
|
|
if not GetOpenFileName(ofn) then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
TempFileName := FileName;
|
||
|
|
chan := BASS_StreamCreateFile(False, PChar(TempFileName), 0, 0, BASS_SAMPLE_LOOP {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
|
||
|
|
if (chan = 0) then
|
||
|
|
begin
|
||
|
|
chan := BASS_MusicLoad(False, PChar(TempFileName), 0, 0, BASS_MUSIC_RAMP or BASS_SAMPLE_LOOP {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}, 1);
|
||
|
|
if (chan = 0) then
|
||
|
|
begin
|
||
|
|
Error('Can''t play file'); // Can't load the file
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BASS_ChannelPlay(chan, False);
|
||
|
|
Result := True;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// update the spectrum display - the interesting bit :)
|
||
|
|
|
||
|
|
procedure UpdateSpectrum(uTimerID, uMsg, dwUser, dw1, dw2 : Integer); stdcall;
|
||
|
|
type
|
||
|
|
TSingleArray = array of Single;
|
||
|
|
var
|
||
|
|
DC : HDC;
|
||
|
|
X, Y, Z,
|
||
|
|
I, J, sc : Integer;
|
||
|
|
Sum : Single;
|
||
|
|
fft : array[0..1023] of Single; // get the FFT data
|
||
|
|
ci : BASS_CHANNELINFO;
|
||
|
|
Buf : TSingleArray;
|
||
|
|
begin
|
||
|
|
if SpecMode = 3 then // waveform
|
||
|
|
begin
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
BASS_ChannelGetInfo(chan, ci); // get number of channels
|
||
|
|
SetLength(Buf, ci.chans * SPECWIDTH);
|
||
|
|
Y := 0;
|
||
|
|
BASS_ChannelGetData(chan, buf, (ci.chans * SPECWIDTH * SizeOf(Single)) or BASS_DATA_FLOAT); // get the sample data (floating-point to avoid 8 & 16 bit processing)
|
||
|
|
for I := 0 to ci.chans - 1 do
|
||
|
|
begin
|
||
|
|
for X := 0 to SPECWIDTH - 1 do
|
||
|
|
begin
|
||
|
|
Z := Trunc((1 - Buf[X * Integer(ci.chans) + I]) * SPECHEIGHT / 2); // invert and scale to fit display
|
||
|
|
if Z < 0 then
|
||
|
|
Z := 0
|
||
|
|
else if Z >= SPECHEIGHT then
|
||
|
|
Z := SPECHEIGHT - 1;
|
||
|
|
if X = 0 then
|
||
|
|
Y := Z;
|
||
|
|
repeat // draw line from previous sample...
|
||
|
|
if Y < Z then
|
||
|
|
inc(Y)
|
||
|
|
else if Y > Z then
|
||
|
|
dec(Y);
|
||
|
|
if (I and 1) = 1 then
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + Y * SPECWIDTH + X)^) := 127
|
||
|
|
else
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + Y * SPECWIDTH + X)^) := 1;
|
||
|
|
until Y = Z;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
BASS_ChannelGetData(chan, @fft, BASS_DATA_FFT2048);
|
||
|
|
case SpecMode of
|
||
|
|
0 : // "normal" FFT
|
||
|
|
begin
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
Z := 0;
|
||
|
|
for X := 0 to pred(SPECWIDTH) div 2 do
|
||
|
|
begin
|
||
|
|
Y := Trunc(sqrt(fft[X + 1]) * 3 * SPECHEIGHT - 4); // scale it (sqrt to make low values more visible)
|
||
|
|
// Y := Trunc(fft[X + 1] * 10 * SPECHEIGHT); // scale it (linearly)
|
||
|
|
if Y > SPECHEIGHT then
|
||
|
|
Y := SPECHEIGHT; // cap it
|
||
|
|
|
||
|
|
if (X > 0) and (Z = (Y + Z) div 2) then // interpolate from previous to make the display smoother
|
||
|
|
while (Z >= 0) do
|
||
|
|
begin
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + Z * SPECWIDTH + X * 2 - 1)^) := Z + 1;
|
||
|
|
dec(Z);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Z := Y;
|
||
|
|
while (Y >= 0) do
|
||
|
|
begin
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + Y * SPECWIDTH + X * 2)^) := Y + 1; // draw level
|
||
|
|
dec(Y);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
1 : // logarithmic, acumulate & average bins
|
||
|
|
begin
|
||
|
|
I := 0;
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
for X := 0 to BANDS - 1 do
|
||
|
|
begin
|
||
|
|
Sum := 0;
|
||
|
|
J := Trunc(Power(2, X * 10.0 / (BANDS - 1)));
|
||
|
|
if J > 1023 then
|
||
|
|
J := 1023;
|
||
|
|
if J <= I then
|
||
|
|
J := I + 1; // make sure it uses at least 1 FFT bin
|
||
|
|
sc := 10 + J - I;
|
||
|
|
|
||
|
|
while I < J do
|
||
|
|
begin
|
||
|
|
Sum := Sum + fft[1 + I];
|
||
|
|
inc(I);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Y := Trunc((sqrt(Sum / log10(sc)) * 1.7 * SPECHEIGHT) - 4); // scale it
|
||
|
|
if Y > SPECHEIGHT then
|
||
|
|
Y := SPECHEIGHT; // cap it
|
||
|
|
while (Y >= 0) do
|
||
|
|
begin
|
||
|
|
FillChar(Pointer(Longint(SpecBuf) + Y * SPECWIDTH + X * (SPECWIDTH div BANDS))^, SPECWIDTH div BANDS - 2, Y + 1); // draw bar
|
||
|
|
dec(Y);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
2 : // "3D"
|
||
|
|
begin
|
||
|
|
for X := 0 to SPECHEIGHT - 1 do
|
||
|
|
begin
|
||
|
|
Y := Trunc(sqrt(fft[x + 1]) * 3 * 127); // scale it (sqrt to make low values more visible)
|
||
|
|
if Y > 127 then
|
||
|
|
Y := 127; // cap it
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + X * SPECWIDTH + SpecPos)^) := 128 + Y; // plot it
|
||
|
|
end;
|
||
|
|
// move marker onto next position
|
||
|
|
SpecPos := (SpecPos + 1) mod SPECWIDTH;
|
||
|
|
for X := 0 to SPECHEIGHT do
|
||
|
|
Byte(Pointer(Longint(SpecBuf) + X * SPECWIDTH + SpecPos)^) := 255;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// update the display
|
||
|
|
DC := GetDC(Window);
|
||
|
|
try
|
||
|
|
BitBlt(DC, 0, 0, SPECWIDTH, SPECHEIGHT, SpecDC, 0, 0, SRCCOPY);
|
||
|
|
finally
|
||
|
|
ReleaseDC(Window, DC);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// window procedure
|
||
|
|
|
||
|
|
function SpectrumWindowProc(Wnd : HWND; Msg : Integer; wParam, lParam : Longint): Integer; stdcall;
|
||
|
|
var
|
||
|
|
Ps : TPAINTSTRUCT;
|
||
|
|
DC : HDC;
|
||
|
|
I : Integer;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
case Msg of
|
||
|
|
WM_CREATE :
|
||
|
|
begin
|
||
|
|
GetOSInfo;
|
||
|
|
|
||
|
|
// initialize BASS
|
||
|
|
if not BASS_Init(-1, 44100, 0, Wnd, NIL) then
|
||
|
|
begin
|
||
|
|
Error('Can''t initialize device');
|
||
|
|
Result := -1;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if not PlayFile(Wnd) then // start a file playing
|
||
|
|
begin
|
||
|
|
BASS_Free;
|
||
|
|
Result := -1;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// create bitmap to draw spectrum in - 8 bit for easy updating :)
|
||
|
|
FillChar(BI, SizeOf(BI), 0);
|
||
|
|
with BI.bmiHeader do // fill structure with parameter bitmap
|
||
|
|
begin
|
||
|
|
biSize := SizeOf(BI.bmiHeader);
|
||
|
|
biWidth := SPECWIDTH;
|
||
|
|
biHeight := SPECHEIGHT; // upside down (line 0=bottom)
|
||
|
|
biPlanes := 1;
|
||
|
|
biBitCount := 8;
|
||
|
|
biClrImportant := 256;
|
||
|
|
biClrUsed := 256;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// setup palette
|
||
|
|
for I := 0 to 127 do
|
||
|
|
begin
|
||
|
|
pal[I].rgbGreen := 255 - 2 * I;
|
||
|
|
pal[I].rgbRed := 2 * I;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for I := 0 to 31 do
|
||
|
|
begin
|
||
|
|
pal[128 + I].rgbBlue := 8 * I;
|
||
|
|
pal[128 + 32 + I].rgbBlue := 255;
|
||
|
|
pal[128 + 32 + I].rgbRed := 8 * I;
|
||
|
|
pal[128 + 64 + I].rgbRed := 255;
|
||
|
|
pal[128 + 64 + I].rgbBlue := 8 * (31 - I);
|
||
|
|
pal[128 + 64 + I].rgbGreen := 8 * I;
|
||
|
|
pal[128 + 96 + I].rgbRed := 255;
|
||
|
|
pal[128 + 96 + I].rgbGreen := 255;
|
||
|
|
pal[128 + 96 + I].rgbBlue := 8 * I;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// create the bitmap
|
||
|
|
SpecBmp := CreateDIBSection(0, BI, DIB_RGB_COLORS, SpecBuf, 0, 0);
|
||
|
|
SpecDC := CreateCompatibleDC(0);
|
||
|
|
SelectObject(SpecDC, SpecBmp);
|
||
|
|
|
||
|
|
// setup update timer (40hz)
|
||
|
|
timer := timeSetEvent(25, 25, @UpdateSpectrum, 0, TIME_PERIODIC);
|
||
|
|
end;
|
||
|
|
|
||
|
|
WM_PAINT :
|
||
|
|
if GetUpdateRect(Wnd, PRect(NIL)^, False) then
|
||
|
|
begin
|
||
|
|
DC := BeginPaint(Wnd, Ps);
|
||
|
|
if DC = 0 then
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BitBlt(DC, 0, 0, SPECWIDTH, SPECHEIGHT, SpecDC, 0, 0, SRCCOPY);
|
||
|
|
EndPaint(Wnd, Ps);
|
||
|
|
Result := 0;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
WM_LBUTTONUP :
|
||
|
|
begin
|
||
|
|
SpecMode := (SpecMode + 1) mod 4; // swap spectrum mode
|
||
|
|
if SpecMode = 2 then
|
||
|
|
SpecPos := 0;
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0); // clear display
|
||
|
|
Result := 0;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
WM_CLOSE :
|
||
|
|
begin
|
||
|
|
DestroyWindow(Wnd);
|
||
|
|
end;
|
||
|
|
|
||
|
|
WM_DESTROY :
|
||
|
|
begin
|
||
|
|
if timer <> 0 then
|
||
|
|
timeKillEvent(timer);
|
||
|
|
BASS_Free;
|
||
|
|
if SpecDC <> 0 then
|
||
|
|
DeleteDC(SpecDC);
|
||
|
|
if SpecBmp <> 0 then
|
||
|
|
DeleteObject(specbmp);
|
||
|
|
PostQuitMessage(0);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := DefWindowProc(Wnd, Msg, wParam, lParam);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
procedure WinMain;
|
||
|
|
begin
|
||
|
|
Window := FindWindow(szAppName, NIL);
|
||
|
|
if Window <> 0 then
|
||
|
|
begin
|
||
|
|
if IsIconic(Window) then
|
||
|
|
ShowWindow(Window, SW_RESTORE);
|
||
|
|
SetForegroundWindow(Window);
|
||
|
|
Halt(254);
|
||
|
|
end;
|
||
|
|
|
||
|
|
// check the correct BASS was loaded
|
||
|
|
if HIWORD(BASS_GetVersion) <> BASSVERSION then
|
||
|
|
begin
|
||
|
|
MessageBox(0, 'An incorrect version of BASS.DLL was loaded', '', MB_ICONERROR);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// register window class and create the window
|
||
|
|
FillChar(WndClass, SizeOf(TWndClassEx), 0);
|
||
|
|
WndClass.cbSize := SizeOf(TWndClassEx);
|
||
|
|
WndClass.style := CS_HREDRAW or CS_VREDRAW;
|
||
|
|
WndClass.lpfnWndProc := @SpectrumWindowProc;
|
||
|
|
WndClass.cbClsExtra := 0;
|
||
|
|
WndClass.cbWndExtra := 0;
|
||
|
|
WndClass.hInstance := hInstance;
|
||
|
|
WndClass.hCursor := LoadCursor(0, IDC_ARROW);
|
||
|
|
WndClass.hbrBackGround := GetSysColorBrush(COLOR_BTNFACE);
|
||
|
|
WndClass.lpszClassName := szAppName;
|
||
|
|
|
||
|
|
if RegisterClassEx(WndClass) = 0 then
|
||
|
|
Halt(255);
|
||
|
|
|
||
|
|
SizeX := SPECWIDTH + 2 * GetSystemMetrics(SM_CXDLGFRAME);
|
||
|
|
SizeY := SPECHEIGHT + 2 * GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYCAPTION);
|
||
|
|
|
||
|
|
PosX := (GetSystemMetrics(SM_CXSCREEN) - SizeX) div 2;
|
||
|
|
PosY := (GetSystemMetrics(SM_CYSCREEN) - SizeY) div 2;
|
||
|
|
|
||
|
|
Window := CreateWindowEx(0, szAppName, 'BASS spectrum example (click to toggle mode)',
|
||
|
|
WS_POPUPWINDOW or WS_CAPTION,
|
||
|
|
PosX, PosY, SizeX, SizeY, 0, 0, hInstance, NIL);
|
||
|
|
|
||
|
|
ShowWindow(Window, SW_SHOWNORMAL);
|
||
|
|
|
||
|
|
while (GetMessage(Msg, 0, 0, 0)) do
|
||
|
|
begin
|
||
|
|
TranslateMessage(Msg);
|
||
|
|
DispatchMessage(Msg);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Halt(Msg.wParam);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
WinMain;
|
||
|
|
end.
|