读书人
栏目▼

小弟对API不太熟麻烦帮改写下小弟

发布时间： 2013-07-01 12:33:04 作者： rapoo

小弟对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;



小弟可用真金来换取各位高手的帮助。 API win32


[解决办法]
http://www.cnblogs.com/del/archive/2008/08/22/1273865.html

读书人网 >.NET

热点推荐

触屏版 | 电脑版

读书人网 m.reader8.net