谁能把以下C++代码转换为DELPHI代码？ ( 积分: 300 )

网络3K · 2007-08-05

注意： BASS_ChannelGetInfo ， BASS_CHANNELINFO， BASS_ChannelGetData，
不需要改。

BASS_CHANNELINFO 是类型
typedef struct {
DWORD freq;
DWORD chans;
DWORD flags;
DWORD ctype;
DWORD origres;
HPLUGIN plugin;
} BASS_CHANNELINFO;

BOOL BASS_ChannelGetInfo(
DWORD handle,
BASS_CHANNELINFO *info
);

DWORD BASS_ChannelGetData(
DWORD handle,
void *buffer,
DWORD length
);

============================

void CALLBACK UpdateSpectrum(UINT uTimerID, UINT uMsg, DWORD dwUser, DWORD dw1, DWORD dw2)
{
HDC dc;
int x,y,y1;

if (specmode==3) { // waveform
int c;
float *buf;
BASS_CHANNELINFO ci;
memset(specbuf,0,SPECWIDTH*SPECHEIGHT);
BASS_ChannelGetInfo(chan,&ci);
// get number of channels
buf=alloca(ci.chans*SPECWIDTH*sizeof(float));
// allocate buffer for data
BASS_ChannelGetData(chan,buf,(ci.chans*SPECWIDTH*sizeof(float))|BASS_DATA_FLOAT);
// get the sample data (floating-point to avoid 8 &
16 bit processing)
for (c=0;c<ci.chans;c++) {
for (x=0;x<SPECWIDTH;x++) {
int v=(1-buf[x*ci.chans+c])*SPECHEIGHT/2;
// invert and scale to fit display
if (v<0) v=0;
else
if (v>=SPECHEIGHT) v=SPECHEIGHT-1;
if (!x) y=v;
do { // draw line from previous sample...
if (y<v) y++;
else
if (y>v) y--;
specbuf[y*SPECWIDTH+x]=c&1?127:1;
// left=green, right=red (could add more colours to palette for more chans)
} while (y!=v);
}
}
} else
{
float fft[1024];
BASS_ChannelGetData(chan,fft,BASS_DATA_FFT2048);
// get the FFT data

if (!specmode) { // "normal"
FFT
memset(specbuf,0,SPECWIDTH*SPECHEIGHT);
for (x=0;x<SPECWIDTH/2;x++) {
#if 1
y=sqrt(fft[x+1])*3*SPECHEIGHT-4;
// scale it (sqrt to make low values more visible)
#else

y=fft[x+1]*10*SPECHEIGHT;
// scale it (linearly)
#endif
if (y>SPECHEIGHT) y=SPECHEIGHT;
// cap it
if (x &&
(y1=(y+y1)/2)) // interpolate from previous to make the display smoother
while (--y1>=0) specbuf[y1*SPECWIDTH+x*2-1]=y1+1;
y1=y;
while (--y>=0) specbuf[y*SPECWIDTH+x*2]=y+1;
// draw level
}
} else
if (specmode==1) { // logarithmic, acumulate &
average bins
int b0=0;
memset(specbuf,0,SPECWIDTH*SPECHEIGHT);
#define BANDS 28
for (x=0;x<BANDS;x++) {
float sum=0;
int sc,b1=pow(2,x*10.0/(BANDS-1));
if (b1>1023) b1=1023;
if (b1<=b0) b1=b0+1;
// make sure it uses at least 1 FFT bin
sc=10+b1-b0;
for (;b0<b1;b0++) sum+=fft[1+b0];
y=(sqrt(sum/log10(sc))*1.7*SPECHEIGHT)-4;
// scale it
if (y>SPECHEIGHT) y=SPECHEIGHT;
// cap it
while (--y>=0)
memset(specbuf+y*SPECWIDTH+x*(SPECWIDTH/BANDS),y+1,SPECWIDTH/BANDS-2);
// draw bar
}
} else
{ // "3D"
for (x=0;x<SPECHEIGHT;x++) {
y=sqrt(fft[x+1])*3*127;
// scale it (sqrt to make low values more visible)
if (y>127) y=127;
// cap it
specbuf[x*SPECWIDTH+specpos]=128+y;
// plot it
}
// move marker onto next position
specpos=(specpos+1)%SPECWIDTH;
for (x=0;x<SPECHEIGHT;x++) specbuf[x*SPECWIDTH+specpos]=255;
}
}

// update the display
dc=GetDC(win);
BitBlt(dc,0,0,SPECWIDTH,SPECHEIGHT,specdc,0,0,SRCCOPY);
ReleaseDC(win,dc);
}

sislcb · 2007-08-07

你那些代码格式乱七八糟的,好难看啊..

翻了一些,看不下去了,你就不能格式化好点....

代码:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  PBASS_CHANNELINFO = ^TBASS_CHANNELINFO;
  TBASS_CHANNELINFO = record
         freq:DWORD;
         chans:DWORD;
         flags:DWORD;
         ctype:DWORD;
         origres:DWORD;
//        plugin:HPLUGIN;
  end;




type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
 function BASS_ChannelGetInfo(handle:DWORD;info:PBASS_CHANNELINFO):BOOL;
 function BASS_ChannelGetData(handle:DWORD;buffer:Pointer;length:DWORD):DWORD;


implementation

{$R *.dfm}

procedure  UpdateSpectrum(uTimerID,uMsg:UINT;dwUser,dw1,dw2:DWORD);stdcall;
var
  hd:HDC;
  x,y,y1,c,v:Integer;
  buf:^real;
  ci:TBASS_CHANNELINFO;
  fft:array [0..1023] of real;
begin

  if (specmode=3) then

  begin

    fillchar(specbuf,SPECWIDTH*SPECHEIGHT,0);
    BASS_ChannelGetInfo(chan,@ci);
// get number of channels
    buf := New(ci.chans*SPECWIDTH*sizeof(real));

    BASS_ChannelGetData(chan,buf,(ci.chans*SPECWIDTH*sizeof(real)) or   BASS_DATA_FLOAT);
    for c:=0 to ci.chans-1do

    begin

      for x:=0 to SPECWIDTH-1do

      begin

      v := (1-buf[x*ci.chans+c])*SPECHEIGHT div 2;
		
      if (v<0)  then

           v := 0
      else
 if (v>=SPECHEIGHT) then

           v := SPECHEIGHT-1;
      if (x=0) then

          y := v;
      repeat
       if (y<v) then

          Inc(y)
       else
 if (y>v) then

            Dec(y);
      if (c and 1)=0 then

         specbuf[y*SPECWIDTH+x] := 127           
      else

        specbuf[y*SPECWIDTH+x] := 1;
     until (y <> v);
     end
  end
end
else

begin

  BASS_ChannelGetData(chan,@fft,BASS_DATA_FFT2048);
  if (specmode=0) then

   begin
 // &quot;normal&quot;
FFT
     fillchar(specbuf,SPECWIDTH*SPECHEIGHT,0);
     for x:=0 to (SPECWIDTH div 2)-1do

      begin

{$ifdef 1}
        y := sqrt(fft[x+1])*3*SPECHEIGHT-4;
{$else
}
       y:=fft[x+1]*10*SPECHEIGHT;
// scale it (linearly)
{$endif}
      if (y>SPECHEIGHT) then
 y=SPECHEIGHT;
      if (x and (y1=(y+y1) div 2))=1 then

      begin

        while (--y1>=0)do

          specbuf[y1*SPECWIDTH+x*2-1]:=y1+1;
        y1:=y;
        while (--y>=0)
          specbuf[y*SPECWIDTH+x*2]:=y+1;
      end;

      end
      else

end;


end.

网络3K · 2007-08-08

不是吧！
代码不能编译啊！
更不能运行了，
有谁会VB的，帮我改成DELPHI的，看代码。
=====================================================================
Option Explicit

Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0&
' color table in RGBs

Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As RGBQUAD
End Type

Declare Sub FillMemory Lib "kernel32.dll"
Alias "RtlFillMemory"
(Destination As Any, ByVal length As Long, ByVal Fill As Byte)
Public Declare Function SetDIBitsToDevice Lib "gdi32"
(ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long

' NOTE: Using an API MM timer (may sometimes Crash your app in an IDE mode)
Public Const TIME_PERIODIC = 1 ' program for continuous periodic event
Public Declare Function timeSetEvent Lib "winmm.dll"
(ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll"
(ByVal uID As Long) As Long
Public timing As Long ' an API timer Handle

Public Const SPECWIDTH As Long = 368 ' display width
Public Const SPECHEIGHT As Long = 127 ' height (changing requires palette adjustments too)

Public chan As Long ' stream/music handle

Public specmode As Long, specpos As Long ' spectrum mode (and marker pos for 2nd mode)
Public specbuf() As Byte ' a pointer

Public bh As BITMAPINFO ' bitmap header

' MATH Functions
Public Function Sqrt(ByVal num Asdo
uble) Asdo
uble
Sqrt = num ^ 0.5
End Function

Function Log10(ByVal X Asdo
uble) Asdo
uble
Log10 = Log(X) / Log(10#)
End Function

' update the spectrum display - the interesting bit

Public Sub UpdateSpectrum(ByVal uTimerID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Dim X As Long, Y As Long, y1 As Long

If (specmode = 3) then
' waveform
Dim c As Long, buf() As Single, ci As BASS_CHANNELINFO
ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte ' clear display

Call BASS_ChannelGetInfo(chan, ci) ' get number of channels
ReDim buf(ci.chans * SPECWIDTH * LenB(buf(0))) As Single ' allocate buffer for data

Call BASS_ChannelGetData(chan, buf(0), (ci.chans * SPECWIDTH * LenB(buf(0))) Or BASS_DATA_FLOAT) ' get the sample data (floating-point to avoid 8 &
16 bit processing)
For c = 0 To ci.chans - 1
For X = 0 To SPECWIDTH - 1
Dim v As Long
v = (1 - buf(X * ci.chans + c)) * SPECHEIGHT / 2 ' invert and scale to fit display
If (v < 0) then

v = 0
else
If (v >= SPECHEIGHT) then

v = SPECHEIGHT - 1
End If
If (X = 0) then
Y = v
do
' draw line from previous sample...
If (Y < v) then

Y = Y + 1
else
If (Y > v) then

Y = Y - 1
End If
specbuf(Y * SPECWIDTH + X) = IIf(c And 1, 127, 1) ' left=green, right=red (could add more colours to palette for more chans)
Loop While (Y <> v)
Next X
Next c
else

Dim fft(1024) As Single ' get the FFT data
Call BASS_ChannelGetData(chan, fft(0), BASS_DATA_FFT2048)

If (specmode = 0) then
' "normal"
FFT
ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte ' clear display
For X = 0 To (SPECWIDTH / 2) - 1
#If 1 then

Y = Sqrt(fft(X + 1)) * 3 * SPECHEIGHT - 4 ' scale it (sqrt to make low values more visible)
#else

Y = fft(X + 1) * 10 * SPECHEIGHT ' scale it (linearly)
#End If
If (Y > SPECHEIGHT) then
Y = SPECHEIGHT ' cap it
If (X) then
' interpolate from previous to make the display smoother
y1 = (Y + y1) / 2
y1 = y1 - 1
While (y1 >= 0)
specbuf(y1 * SPECWIDTH + X * 2 - 1) = y1 + 1
y1 = y1 - 1
Wend
End If
y1 = Y
Y = Y - 1
While (Y >= 0)
specbuf(Y * SPECWIDTH + X * 2) = Y + 1 ' draw level
Y = Y - 1
Wend
Next X
else
If (specmode = 1) then
' logarithmic, acumulate &
average bins
ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte ' clear display
Dim b0 As Long, BANDS As Integer
b0 = 0
BANDS = 28
Dim sc As Long, b1 As Long
Dim sum As Single
For X = 0 To BANDS - 1
sum = 0
b1 = 2 ^ (X * 10# / (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
do

sum = sum + fft(1 + b0)
b0 = b0 + 1
Loop While b0 < b1
Y = (Sqrt(sum / Log10(sc)) * 1.7 * SPECHEIGHT) - 4 ' scale it
If (Y > SPECHEIGHT) then
Y = SPECHEIGHT ' cap it
Y = Y - 1
While (Y >= 0)
Call FillMemory(specbuf(Y * SPECWIDTH + X * Int(SPECWIDTH / BANDS)), SPECWIDTH / BANDS - 2, Y + 1)
Y = Y - 1
Wend
Next X
else
' "3D"
For X = 0 To SPECHEIGHT - 1
Y = Sqrt(fft(X + 1)) * 3 * 127 ' scale it (sqrt to make low values more visible)
If (Y > 127) then
Y = 127 ' cap it
specbuf(X * SPECWIDTH + specpos) = 128 + Y ' plot it
Next X
' move marker onto next position
specpos = (specpos + 1) Mod SPECWIDTH
For X = 0 To SPECHEIGHT - 1
specbuf(X * SPECWIDTH + specpos) = 255
Next X
End If
End If

' update the display
' to display in a PictureBox, simply change the .hDC to Picture1.hDC

Call SetDIBitsToDevice(frmSpectrum.hDC, 0, 0, SPECWIDTH, SPECHEIGHT, 0, 0, 0, SPECHEIGHT, specbuf(0), bh, 0)
End Sub

谁能把以下C++代码转换为DELPHI代码？ ( 积分: 300 )

网络3K

Unregistered / Unconfirmed

sislcb

Unregistered / Unconfirmed

网络3K

Unregistered / Unconfirmed

Similar threads