![]() |
Prozedur: Sound zu Array of Float mittels BASS
Hallo DPler,
ich weiß, dass es mittlerweile einige Themen zu Bass gibt, aber mein Anliegen ist eigentlich viel zu simpel, um jetzt den Code aus anderen Themen auseinanderzufrickeln. Nicht zuletzt auch deshalb, weil ich mich nicht so gut den Basics wie Speicherfreigabe etc. auskenne. Aber vielleicht habt ihr ja trotzdem Lust mir zu helfen. Die gesucht Prozedur soll über die Angabe eines Dateinamens und einer Abtastrate (bspw. 40ms = 25fps) ein Array of Float (0 bis 1) ausgeben. Dabei ist im ersten Schritt nur die Lautstärke-Amplitude beider Kanäle zum gefragten Zeitpunkt (0, 40, 80 ms ...) wichtig. Um das RAM nicht vollzumüllen, langt es prinzipiell ja die Sounddatei zu laden/analysieren/freizugeben. Da mir jedoch, wie oben beschrieben, die Basics zur sauberen Programmierung fehlen, soll die Prozedur/Funktion ihre Aufgabe möglichst elegant und ohne viel Schnickschnack verrichten. Diese Prozedur brauche ich für mein Programm "Animus", dass verschiedene Parameterwerte animieren kann. Wer Interesse hat kann sich hier einen ![]() (Mein Programm ist eine GUI für einen ![]() Vielen Dank schonmal! :cheers: EDIT: okay, so ganz ohne Eigeninitiative solls natürlich nicht sein ;)
Delphi-Quellcode:
Ich habe (chaotischerweise) versucht aus dem BASS-Beispiel custloop die relevanten Befehle zu extrahieren.
procedure Sound2FloatArray(filename: String; MS: Byte; var Left, Right: array of Float);
var //Dateiname; Abtastrate; Ausgabe-Arrays wavebufL, wavebufR: Array of smallInt; Laenge, i: Integer; begin //init BASS if not BASS_Init(-1,44100,0,Application.Handle,nil) then ErrorPop('Can''t initialize device'); //creating stream chan := BASS_StreamCreateFile(FALSE,pchar(filename),0,0,0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}); if chan = 0 then begin chan := BASS_MusicLoad(False, pchar(filename), 0, 0, BASS_MUSIC_RAMPS or BASS_MUSIC_POSRESET or BASS_MUSIC_PRESCAN {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}, 0); if (chan = 0) then begin ErrorPop('Can''t play file'); Exit; end; end; //jetzt nochmal das ganze für den zweiten Kanal? //getting peak levels in seperate thread, stream handle as parameter chan2 := BASS_StreamCreateFile(FALSE,pchar(filename),0,0,BASS_STREAM_DECODE {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}); if (chan2 = 0) then chan2 := BASS_MusicLoad(FALSE,pchar(filename),0,0,BASS_MUSIC_DECODE {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF},0); TScanThread.Create(chan2); // start scanning peaks in a new thread //Wieviel Einträge im Array brauche ich? Laenge := ???; //set array size setlength(wavebufL,Laenge); setlength(wavebufR,Laenge); setlength(Left,Laenge); setlength(Right,Laenge); //Die smallints zu Float 0 bis 1 wandeln for i := 0 to Laenge-1 do begin Left[i] := wavebufL[i]/High(smallInt); Right[i] := wavebufR[i]/High(smallInt); end; //BASS-Speicher freigeben BASS_Free(); end; {Sound2FloatArray} // aus dem Beispiel custloop procedure TForm1.ScanPeaks2(decoder : HSTREAM); var cpos,level : DWord; peak : array[0..1] of DWORD; position : DWORD; counter : integer; begin cpos := 0; peak[0] := 0; peak[1] := 0; counter := 0; while not killscan do begin level := BASS_ChannelGetLevel(decoder); // scan peaks if (peak[0]<LOWORD(level)) then peak[0]:=LOWORD(level); // set left peak if (peak[1]<HIWORD(level)) then peak[1]:=HIWORD(level); // set right peak if BASS_ChannelIsActive(decoder) <> BASS_ACTIVE_PLAYING then begin position := cardinal(-1); // reached the end end else position := BASS_ChannelGetPosition(decoder,BASS_POS_BYTE) div bpp; if position > cpos then begin inc(counter); if counter <= length(wavebufL)-1 then begin wavebufL[counter] := peak[0]; wavebufR[counter] := peak[1]; end; if (position >= dword(ClientWidth)) then break; cpos := position; end; peak[0] := 0; peak[1] := 0; end; BASS_StreamFree(decoder); // free the decoder end; Ist das alles, was ich brauche? Was ist zu viel, was fehlt unter Umständen? Warum wird der zweite Channel anders als der erste Channel geholt? Wie gesagt, ich möchte nichts abspielen, sondern nur ein bis zwei Arrays vom Typ Float füllen. |
Re: Prozedur: Sound zu Array of Float mittels BASS
Ich bin nach wie vor am grübeln, wie man am Besten an die Sache herangeht.
Vielleicht ist das obige Beispiel aus 'custloop' auch nicht das non plus ultra.. Wenn es eine Möglichkeit ohne die BASS.dll gibt, dann bin ich natürlich auch dafür zu haben, aber mir erscheint das als 'billigste' Lösung. Kennt ihr vielleicht noch einen anderen Ansatz oder ein anderes Beispiel-Projekt, das mich zum Ziel bringen könnte? Ich wär' euch sehr verbunden. |
Re: Prozedur: Sound zu Array of Float mittels BASS
mmh, ich wollte gerade editieren, hat aber leider nicht geklappt :/
Nach langem Hin und Her habe ich mit Hilfe der Dokumentation einen guten Schritt nach vorn gemacht. Ich verstehe noch nicht so ganz, warum es verschiedene Ergebnisse zwischen wav und mp3 gibt (die wav, die benutzt hab wurde ursprünglich mal vom mp3 transcodiert). Zudem kommt noch, dass die Ergebnisse für fft[0] ungewöhnlich niedrig erscheinen, ist aber evtl. nur Einbildung. Naja, das ist auf jeden Fall mein Zwischenergebnis (wenn auch mit 'play'): EDIT:
Delphi-Quellcode:
Über Korrekturen/Hilfestellungen freue ich mich nach wie vor.
unit main;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Bass, Buttons, StdCtrls; type TForm1 = class(TForm) OD: TOpenDialog; Button1: TButton; Label1: TLabel; Button2: TButton; Memo1: TMemo; Label2: TLabel; Edit1: TEdit; Memo2: TMemo; procedure FormCreate(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Laenge; procedure FormDestroy(Sender: TObject); private { Private-Deklarationen } public procedure SetPosition(Value: Longword); procedure SetProgress(Value: Double); end; TWaveData = array [ 0..2048] of DWORD; TFFTData = array [0..512] of Single; var Form1: TForm1; Channel: DWORD; len: QWord; time, timeMS, MS:Double; timeByte: QWord; schritte: Integer; implementation {$R *.dfm} procedure TForm1.Laenge; begin len := BASS_ChannelGetLength(channel, BASS_POS_BYTE); // the length in bytes time:= BASS_ChannelBytes2Seconds(channel, len); // the length in seconds timeMS := time*1000; MS := 1000/StrToFloat(Edit1.Text); schritte := Round(timeMS/MS); timeByte := len div schritte; end; procedure TForm1.SetPosition(Value: Longword); begin BASS_ChannelSetPosition(channel, Value, BASS_POS_BYTE); end; procedure TForm1.SetProgress(Value: Double); begin if Value < 0 then Value := 0; if Value > 1 then Value := 1; SetPosition(Round(BASS_ChannelGetLength(channel, BASS_POS_BYTE) * Value)); end; procedure TForm1.Button1Click(Sender: TObject); var i, j, t, level: Integer; levelF, C, temp: Extended; L, R: QWord; WaveData: TWaveData; FFT: TFFTData; begin Memo1.Clear; Memo2.Clear; BASS_ChannelSetPosition(channel, 0, BASS_POS_BYTE); BASS_ChannelSetAttribute(channel, BASS_ATTRIB_VOL, 0); BASS_ChannelPlay(channel, false); temp := 0; for i := 0 to Schritte - 1 do begin BASS_ChannelSetPosition(channel, i*timeByte, BASS_POS_BYTE); Level := BASS_ChannelGetLevel(channel); L := LOWORD(level); // the left level R := HIWORD(level); // the right level C := (R + L) / (2*65535); if temp < c then temp := c; //Memo1.Lines.Add(FloatToStr(c)); end; BASS_ChannelStop(channel); ShowMessage('Highest peak was: ' + FloatToStr(temp)); end; procedure TForm1.FormCreate(Sender: TObject); begin BASS_Init(-1, 44100, 0, Application.Handle, nil); end; procedure TForm1.FormDestroy(Sender: TObject); begin Bass_Free; end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin if not OD.Execute then exit; Channel := BASS_StreamCreateFile(FALSE, PChar(OD.FileName), 0, 0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}); Laenge; Label1.Caption := 'Length: ' + FloatTOStr(timeMS) + ' MS' +#13 + 'in Bytes: ' + IntToStr(len); end; end. EDIT: Ich hab grad festgestellt, dass meine grundlegende Berechnung der Schritte Firlefanz war. Daher gibt es eine neue Variable "Schritte". Diese wird nun auch in einer normalen Schleife verwendet (siehe Source oben); Jetzt bleibt eigentlich nur noch die Unterscheidung von Sounddateien mit einem oder mehreren Channels, damit die Berechnung C := (R + L) / (2 * 65535); auf diese speziellen Fälle reagiert, also bei Mono-Dateien das "2*" raus. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:36 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz