471 lines
13 KiB
ObjectPascal
471 lines
13 KiB
ObjectPascal
|
{
|
||
|
|
BASS "live" spectrum analyser example
|
||
|
|
Copyright (c) 2002-2008 Un4seen Developments Ltd.
|
||
|
|
|
||
|
|
C++ to Delphi with use API adapted by Evgeny Melnikov
|
||
|
|
Required Delphi 5 or above
|
||
|
|
|
||
|
|
http://dsoft1961.narod.ru
|
||
|
|
mail angvelem@gmail.com
|
||
|
|
}
|
||
|
|
|
||
|
|
program livespec;
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, Messages, MMSystem, Bass in '..\bass.pas';
|
||
|
|
|
||
|
|
const
|
||
|
|
SPECWIDTH = 368; // display width
|
||
|
|
SPECHEIGHT = 127; // height (changing requires palette adjustments too)
|
||
|
|
BANDS = 28;
|
||
|
|
szAppName = 'BASS-Spectrum';
|
||
|
|
|
||
|
|
var
|
||
|
|
Window : HWND = 0;
|
||
|
|
WndGlobal : HWND = 0;
|
||
|
|
Msg : TMsg;
|
||
|
|
WndClass : TWndClassEX;
|
||
|
|
|
||
|
|
PosX, PosY : Integer;
|
||
|
|
SizeX, SizeY : Integer;
|
||
|
|
|
||
|
|
Timer : DWORD = 0;
|
||
|
|
Channel : HRECORD; // recording channel
|
||
|
|
|
||
|
|
SpecDC : HDC = 0;
|
||
|
|
SpecBmp : HBITMAP = 0;
|
||
|
|
SpecBuf : Pointer;
|
||
|
|
SpecMode : Integer = 0;
|
||
|
|
SpecPos : Integer = 0; // spectrum mode (and marker pos for 2nd mode)
|
||
|
|
quietcount : DWORD = 0;
|
||
|
|
|
||
|
|
BI : PBITMAPINFO;
|
||
|
|
pal : array[Byte] of TRGBQUAD;
|
||
|
|
|
||
|
|
{$DEFINE ScaleSqrt}
|
||
|
|
|
||
|
|
//------------------ Auxiliary functions -------------------
|
||
|
|
|
||
|
|
function Format(const Format : String; const Args : array of const ) : String;
|
||
|
|
var
|
||
|
|
I : Integer;
|
||
|
|
FormatBuffer : array[0..High(Word)] of Char;
|
||
|
|
Arr, Arr1 : PDWORD;
|
||
|
|
PP : PDWORD;
|
||
|
|
begin
|
||
|
|
Arr := NIL;
|
||
|
|
if High(Args) >= 0 then
|
||
|
|
GetMem(Arr, (High(Args) + 1) * SizeOf(Pointer));
|
||
|
|
Arr1 := Arr;
|
||
|
|
for I := 0 to High(Args) do
|
||
|
|
begin
|
||
|
|
PP := @Args[I];
|
||
|
|
PP := Pointer(PP^);
|
||
|
|
Arr1^ := DWORD(PP);
|
||
|
|
inc(Arr1);
|
||
|
|
end;
|
||
|
|
I := wvsprintf(@FormatBuffer[0], PChar(Format), PChar(Arr));
|
||
|
|
SetLength(Result, I);
|
||
|
|
Result := FormatBuffer;
|
||
|
|
if Arr <> NIL then
|
||
|
|
FreeMem(Arr);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
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;
|
||
|
|
|
||
|
|
//==========================================================
|
||
|
|
//==========================================================
|
||
|
|
|
||
|
|
// display error messages
|
||
|
|
procedure Error(const es : String);
|
||
|
|
begin
|
||
|
|
MessageBox(WndGlobal, PChar(Format('%s' + #13#10 + '(error code: %d)', [es, BASS_ErrorGetCode])), 'Error', MB_OK or MB_ICONERROR);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// update the spectrum display - the interesting bit :)
|
||
|
|
|
||
|
|
procedure UpdateSpectrum(uTimerID, uMsg, dwUser, dw1, dw2 : Integer); stdcall;
|
||
|
|
type
|
||
|
|
TSpecBuf = array[0..0] of Byte;
|
||
|
|
TBuf = array of SmallInt;
|
||
|
|
var
|
||
|
|
DC : HDC;
|
||
|
|
X, Y, Y1,
|
||
|
|
V, B0, B1,
|
||
|
|
SC : Integer;
|
||
|
|
Sum : Single;
|
||
|
|
aRect : TRect;
|
||
|
|
fft : array[0..1023] of Single;
|
||
|
|
Buf : TBuf;
|
||
|
|
SBuf : ^TSpecBuf absolute SpecBuf;
|
||
|
|
begin
|
||
|
|
if SpecMode = 3 then // waveform
|
||
|
|
begin
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
SetLength(Buf, SPECWIDTH);
|
||
|
|
BASS_ChannelGetData(Channel, Buf, SizeOf(SmallInt) * SPECWIDTH); // get the sample data
|
||
|
|
|
||
|
|
Y := 0;
|
||
|
|
for X := 0 to SPECWIDTH - 1 do
|
||
|
|
begin
|
||
|
|
V := (32767 - Buf[X]) * SPECHEIGHT div 65536; // invert and scale to fit display
|
||
|
|
if X = 0 then
|
||
|
|
Y := V;
|
||
|
|
repeat // draw line from previous sample...
|
||
|
|
if Y < V then
|
||
|
|
inc(Y)
|
||
|
|
else if Y > V then
|
||
|
|
dec(Y);
|
||
|
|
SBuf[Y * SPECWIDTH + X] := abs(Y - SPECHEIGHT div 2) * 2 + 1;
|
||
|
|
until Y = V;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
BASS_ChannelGetData(Channel, @fft, BASS_DATA_FFT2048); // get the FFT data
|
||
|
|
case SpecMode of
|
||
|
|
0 : // "normal" FFT
|
||
|
|
begin
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
|
||
|
|
Y1 := 0;
|
||
|
|
for X := 0 to (SPECWIDTH div 2) - 1 do
|
||
|
|
begin
|
||
|
|
{$IFDEF ScaleSqrt}
|
||
|
|
Y := Trunc(sqrt(fft[X + 1]) * 3 * SPECHEIGHT - 4); // scale it (sqrt to make low values more visible)
|
||
|
|
{$ELSE}
|
||
|
|
Y := Trunc(fft[x + 1] * 10 * SPECHEIGHT); // scale it (linearly)
|
||
|
|
{$ENDIF}
|
||
|
|
if Y > SPECHEIGHT then
|
||
|
|
Y := SPECHEIGHT; // cap it
|
||
|
|
|
||
|
|
Y1 := (Y + Y1) div 2;
|
||
|
|
if (X > 0) and (Y1 > 0) then // interpolate from previous to make the display smoother
|
||
|
|
while (Y1 >= 0) do
|
||
|
|
begin
|
||
|
|
SBuf[Y1 * SPECWIDTH + X * 2 - 1] := Y1 + 1;
|
||
|
|
dec(Y1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Y1 := Y;
|
||
|
|
while (Y >= 0) do
|
||
|
|
begin
|
||
|
|
SBuf[Y * SPECWIDTH + X * 2] := Y + 1; // draw level
|
||
|
|
dec(Y);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
1 : // logarithmic, acumulate & average bins
|
||
|
|
begin
|
||
|
|
B0 := 0;
|
||
|
|
FillChar(SpecBuf^, SPECWIDTH * SPECHEIGHT, 0);
|
||
|
|
for X := 0 to BANDS - 1 do
|
||
|
|
begin
|
||
|
|
Sum := 0;
|
||
|
|
B1 := Trunc(Power(2, X * 10.0 / (BANDS - 1)));
|
||
|
|
if B1 > 1023 then
|
||
|
|
B1 := 1023;
|
||
|
|
if B1 <= B0 then
|
||
|
|
B1 := B0 + 1; // make sure it uses at least 1 FFT bin
|
||
|
|
SC := 10 + B1 - B0;
|
||
|
|
|
||
|
|
while B0 < B1 do
|
||
|
|
begin
|
||
|
|
Sum := Sum + fft[1 + B0];
|
||
|
|
inc(B0);
|
||
|
|
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(SBuf[Y * SPECWIDTH + X * (SPECWIDTH div BANDS)], Trunc(0.9 * (SPECWIDTH / BANDS)), 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
|
||
|
|
SBuf[X * SPECWIDTH + SpecPos] := 128 + Y; // plot it
|
||
|
|
end;
|
||
|
|
// move marker onto next position
|
||
|
|
SpecPos := (SpecPos + 1) mod SPECWIDTH;
|
||
|
|
for X := 0 to SPECHEIGHT - 1 do
|
||
|
|
SBuf[X * SPECWIDTH + SpecPos] := 255;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// update the display
|
||
|
|
DC := GetDC(WndGlobal);
|
||
|
|
try
|
||
|
|
BitBlt(DC, 0, 0, SPECWIDTH, SPECHEIGHT, SpecDC, 0, 0, SRCCOPY);
|
||
|
|
if LOWORD(BASS_ChannelGetLevel(Channel)) < 500 then
|
||
|
|
begin // check if it's quiet
|
||
|
|
inc(QuietCount);
|
||
|
|
if (QuietCount > 40) and (QuietCount and 16 > 0) then
|
||
|
|
begin // it's been quiet for over a second
|
||
|
|
SetRect(aRect, 0, 0, SPECWIDTH, SPECHEIGHT);
|
||
|
|
SetTextColor(DC, $ffffff);
|
||
|
|
SetBkMode(DC, TRANSPARENT);
|
||
|
|
DrawText(DC, 'make some noise!', -1, aRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
QuietCount := 0; // not quiet
|
||
|
|
finally
|
||
|
|
ReleaseDC(Window, DC);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// Recording callback - not doing anything with the data
|
||
|
|
|
||
|
|
function DuffRecording(handle : HRECORD; const Buffer : Pointer; Length : DWORD; user : Pointer) : Boolean; stdcall;
|
||
|
|
begin
|
||
|
|
Result := True; // continue recording
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
procedure InitApp(Wnd : HWND);
|
||
|
|
var
|
||
|
|
I : Integer;
|
||
|
|
begin
|
||
|
|
WndGlobal := Wnd;
|
||
|
|
|
||
|
|
// initialize BASS recording (default device)
|
||
|
|
if not BASS_RecordInit(-1) then
|
||
|
|
begin
|
||
|
|
Error('Can''t initialize device');
|
||
|
|
Halt;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// start recording (44100hz mono 16-bit)
|
||
|
|
Channel := BASS_RecordStart(44100, 1, 0, @DuffRecording, NIL);
|
||
|
|
if Channel = 0 then
|
||
|
|
begin
|
||
|
|
Error('Can''t start recording');
|
||
|
|
Halt;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// create bitmap to draw spectrum in - 8 bit for easy updating :)
|
||
|
|
GetMem(BI, SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad));
|
||
|
|
try
|
||
|
|
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 := 1 to 127 do
|
||
|
|
begin
|
||
|
|
pal[I].rgbGreen := 256 - 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;
|
||
|
|
|
||
|
|
// Move palette in BI
|
||
|
|
Move(Pal, BI^.bmiColors, 256 * SizeOf(TRGBQuad));
|
||
|
|
|
||
|
|
// create the bitmap
|
||
|
|
SpecBmp := CreateDIBSection(0, BI^, DIB_RGB_COLORS, SpecBuf, 0, 0);
|
||
|
|
SpecDC := CreateCompatibleDC(0);
|
||
|
|
SelectObject(SpecDC, SpecBmp);
|
||
|
|
finally
|
||
|
|
FreeMem(BI);
|
||
|
|
end;
|
||
|
|
|
||
|
|
// setup update timer (40hz)
|
||
|
|
timer := timeSetEvent(25, 25, @UpdateSpectrum, 0, TIME_PERIODIC);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
// window procedure
|
||
|
|
|
||
|
|
function SpectrumWindowProc(Wnd : HWND; Msg : Integer; wParam, lParam : Longint) : Integer; stdcall;
|
||
|
|
var
|
||
|
|
Ps : TPAINTSTRUCT;
|
||
|
|
DC : HDC;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
case Msg of
|
||
|
|
WM_CREATE : InitApp(Wnd);
|
||
|
|
|
||
|
|
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_RecordFree;
|
||
|
|
if SpecDC <> 0 then
|
||
|
|
DeleteDC(SpecDC);
|
||
|
|
if SpecBmp <> 0 then
|
||
|
|
DeleteObject(specbmp);
|
||
|
|
PostQuitMessage(0);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := DefWindowProc(Wnd, Msg, wParam, lParam);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//---------------------------------------------------------
|
||
|
|
|
||
|
|
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 "live" spectrum (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.
|