Frequenzen bei wav/mp3-dateien

[Gandalfus]

der Fehler ist da:

BitBlt(Form1.Handle, 0, 0, backbild.width, backbild.height, backbild.Handle , 0, 0 , SRCCOPY);
richtig ist:

BitBlt(Form1.canvas.handle, 0, 0, backbild.Width, backbild.Height, backbild.canvas.handle, 0, 0, srccopy); Hmm sowas passiert wenn man nicht testet sorry.

ich hab nochmal ein beispiel Programm geschrieben.

Für das Beispiel brachst man die neurer Version meiner Unit:

Delphi-Quellcode:

unit U_BassPlayer; 

interface 

uses bass, Windows, Messages; 


type 
TFFTData = array[0..256] of float; 

TBassPlayer = class 
private 
{ Private declarations } 
channel: HCHANNEL; 
status: byte; 
FFilename: string; 

public 
  constructor create(mainwindowhandle: HWND); 
  destructor destroy; override; 
  function play(filename: string): boolean; 
  procedure setvolume(volume: byte); {0 bis 100} 
  function getvolume: byte; 
  property volume: byte read getvolume write setvolume ; 
  procedure setposition(position: integer); 
  function getposition: integer; {in sekunden} 
  property position: integer read getposition write setposition; 
  function getlength: integer; 
  property length: integer read getlength; 
  function getRightPeak: dword; 
  property RightPeak: dword read getRightPeak; {von 0 bis 128} 
  function getLeftPeak: dword; 
  property LeftPeak: dword read getLeftPeak; {von 0 bis 128} 
  function getfftdata: TFFTData; 
  property filename: string read FFilename; 

{ Public declarations } 
end; 

implementation 

function TBassPlayer.getfftdata: TFFTData; 
begin 
  if (BASS_ChannelGetData(Channel, @Result, BASS_DATA_FFT512) = 2048) =   false then 
  begin 
    ZeroMemory(@Result, SizeOf(Result)); 
  end; 
end; 


function TBassPlayer.getRightPeak: dword; 
begin 
  result := HIWORD(BASS_ChannelGetLevel(channel)); 

end; 

function TBassPlayer.getLeftPeak: dword; 
begin 
  result := LOWORD(BASS_ChannelGetLevel(channel)); 
end; 


function TBassPlayer.getvolume: byte; 
begin 
  result := BASS_GetVolume; 
end; 

procedure TBassPlayer.setvolume(volume: byte); 
begin 
  BASS_SetGlobalVolumes(-1,-1,volume); 
end; 


function TBassPlayer.getposition: integer; 
begin 
  result := round(BASS_ChannelBytes2Seconds(channel,BASS_ChannelGetPosition(channel))); 
end; 

procedure TBassPlayer.setposition(position: integer); 
begin 
  BASS_ChannelSetPosition(Channel,BASS_ChannelSeconds2Bytes(Channel, position)); 
end; 

function TBassPlayer.getlength: integer; 
begin 
  result := round(BASS_ChannelBytes2Seconds(channel,BASS_StreamGetLength(channel))); 
end; 


function TBassPlayer.play(filename: string): boolean; 
begin 
  If BASS_ChannelIsActive(channel)=1 then 
  begin 
    BASS_StreamFree(channel); 
  end; 
  FFilename := filename; 

  channel:=BASS_StreamCreateFile(False,PChar(filename),0,0,BASS_STREAM_AUTOFREE or BASS_SAMPLE_FX); 
  result := BASS_StreamPlay(channel,false,0); 
end; 

constructor TBassPlayer.create(mainwindowhandle: HWND); 
begin 
  inherited create;; 
  if BASS_GetVersion() <> MAKELONG(1, then Halt; 
  BASS_Init(-1, 44100, BASS_DEVICE_LEAVEVOL, mainwindowhandle); 
  BASS_Start; 
end; 


destructor TBassPlayer.destroy; 
begin 
  Bass_streamFree(channel); 
  BASS_Stop; 
  BASS_Free; 
  inherited destroy; 
end; 

end.

Neue Anwendung--> Button, Timer und Opendialog auf das Formular und dann so weiter:

Delphi-Quellcode:

uses 
.....,U_bassplayer,...... 


var 
  Form1: TForm1; 
  BassPlayer: TBassPlayer; 
  backbild: TBitmap; 

implementation 

{$R *.dfm} 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  IF Opendialog1.Execute then 
  bassplayer.play(Opendialog1.FileName); 
  Timer1.Enabled := true; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bassplayer.free; 
  backbild.Free; 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  i: integer; 
  data: TFFTdata; 
begin 
  Data:= BassPlayer.GetFFTData; 
  for i := 1 to 256 do 
  begin 
    data[i] := (Data[i] * (backbild.Height)*(i * 0.25)); //Werte anpassen 
  end; 

  backbild.Canvas.pen.Color := clBlack; 
  backbild.Canvas.Brush.Color := clBlack; //Bild "löschen" 
  backbild.Canvas.Rectangle(0,0,backbild.Width,backbild.Height); 

   backbild.Canvas.Brush.Color := clred;//Farbe der Balken 
   backbild.Canvas.pen.Color := clred; 

  for i:=1 to 256 do 
  begin //DAs zeichnen der Balken 
    backbild.canvas.moveto(i*2,backbild.Height); 
    backbild.canvas.lineto(i*2,backbild.Height-(round(Data[i]))); 
  end; 

  BitBlt(Form1.canvas.handle, 0, 0, backbild.Width, backbild.Height,      backbild.canvas.handle, 0, 0, srccopy); 
  //der Backpuffer wird aufs Formular kopiert 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.Enabled := false; 
  Timer1.Interval := 55; 

  bassplayer := TBassplayer.create(Form1.handle); 

  backbild := TBitmap.create; 
  backbild.width := 600; 
  backbild.height:= 200; 
end;