小弟对API不太熟，麻烦各位高手帮改写下，小弟可用真金来换取各位高手的帮助！
程序原来是在Form窗口中画图，现在我想改为在PaintBox1中画图，源程序使用API的，有高手帮小弟改下，在PaintBox1中画出同样的效果。源代码（1）：
uses
Windows, Messages, CommDlg, MMSystem, Bass;
const
SPECWIDTH= 1368;// display width
SPECHEIGHT= 327;// height (changing requires palette adjustments too)
BANDS= 428;
szAppName= 'BASS-Spectrum';
BASSErCodes: array[-1..44] of String = (
'Some other mystery error',
'All is OK',
'Memory error',
'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 }
FLDX
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:= '选择播放的音频文件';
ofn.lpstrFile:= FileName;
ofn.lpstrFilter:= '音频文件'#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}, 0);
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;
[解决办法]
http://www.cnblogs.com/del/archive/2008/08/22/1273865.html
