hi!
have a problem =\ i'm trying to get bpm from souncard output(from "what i hear") :) here goes my unit(delphi) there are no error, but it doesn't returns bpm :))
maybe there are other way to detect bpm from "what i hear" ? i know,that it's buggy way but....
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ComCtrls, ExtCtrls,BASS, BASS_FX, BassEnc;
type
TForm1 = class(TForm)
bRecord: TButton;
procedure FormCreate(Sender: TObject);
procedure bRecordClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function GetNewBPM(hBPM: DWORD): FLOAT;
implementation
{$R *.dfm}
//uses Bass, BassEnc,BASS_FX;
var
win:HWND=0;
inst:Longword;
input:integer; // current input source
encoder:integer; // current encoder
reclen:DWORD; // recording length
encstream:HSTREAM=0; // encoding channel
chan:HSTREAM=0; // playback channel
(* encoder command-lines and output files *)
commands:array [0..1] of pChar=(
'oggenc.exe -o bass.ogg -', // oggenc (OGG)
'lame.exe --alt-preset standard - bass.mp3' // lame (MP3)
);
files:array [0..1] of pChar=('dbass.ogg', 'dbass.mp3');
// display error messages
procedure Error(es:String);
var mes:String;
begin
mes:=format('%s'+#10+'(error code: %d)',[es,BASS_ErrorGetCode()]);
MessageBox(win, PChar(mes),'Error', MB_OK);
end;//Error
function GetNewBPM(hBPM: DWORD): FLOAT;
begin
Result := BASS_FX_BPM_Percents2BPM(hBPM, BASS_FX_TempoGetApproxPercents(encstream));
end;
// get the bpm after period of time
procedure GetBPM_Callback(handle: DWORD; bpm: FLOAT); stdcall;
var tmp: DWORD;
begin
tmp := handle;
form1.Caption := 'BPM: ' + FormatFloat('###.##', GetNewBPM(tmp));
end;
// dummy stream function (data is already in "buffer" so just return)
function EncStreamProc(handle:HSTREAM; buffer:Pointer; length, user:DWORD):DWORD;stdcall;
begin
Result:=Length;
end;
// send the recorded data to the encoder
function RecordingCallback(buffer:Pointer; length, user:DWORD):Boolean;stdcall;
begin
BASS_ChannelGetData(encstream,buffer,length); // pass data through stream to encode it
reclen:=reclen+length;
Result:=BASS_Encode_IsActive(encstream); // continue recording if encoder is alive
end;
procedure StartRecording();
begin
if (chan<>0) then // free old recording
begin
BASS_Stop();
BASS_StreamFree(chan);
chan:=0;
end;
// start encoding (same format as the recording)
encstream:=BASS_StreamCreate(44100,BASS_STREAM_DECODE,@EncStreamProc,0);
encoder:=1;//ord(Form1.rbMP3.Checked);// get selected encoder (0=OGG, 1=MP3)
if (not BASS_Encode_Start(encstream,commands[encoder],0)) then
begin
BASS_StreamFree(encstream);
encstream:=0;
Error('Couldn''t start encoding...'+#10
+'Make sure OGGENC.EXE (if encoding to OGG) is in the same'+#10
+'direcory as this RECTEST, or LAME.EXE (if encoding to MP3).');
Exit;
end;
// start recording @ 44100hz 16-bit stereo
reclen:=0;
if (not BASS_RecordStart(44100,0,@RecordingCallback,0)) then
begin
BASS_Encode_Stop(encstream);
BASS_StreamFree(encstream);
encstream:=0;
Error('Couldn''t start recording');
Exit;
end;
Form1.bRecord.Caption:='Stop';
//------------------------------------------
BASS_FX_BPM_CallbackSet(encstream, @GetBPM_Callback, StrToFloat('3'), 0, BASS_FX_BPM_MULT2);
end;//StartRecording
procedure StopRecording();
begin
// stop recording & encoding
BASS_ChannelStop(RECORDCHAN);
BASS_Encode_Stop(encstream);
BASS_StreamFree(encstream);
encstream:=0;
// create a stream from the recording
chan:=BASS_StreamCreateFile(FALSE,files[encoder],0,0,0);
if (chan<>0) then
begin
BASS_Start();
end;
Form1.bRecord.Caption:='Record';
end;//StopRecording
procedure TForm1.FormCreate(Sender: TObject);
var
c,ii:integer;
i:PChar;
begin
if (BASS_GetVersion()<>MAKELONG(1,8)) then
begin
MessageBox(0,'BASS version 1.8 was not loaded','Incorrect BASS.DLL', MB_OK);
Application.Terminate;
end;
win:=Handle;
if (not BASS_RecordInit(-1)) or (not BASS_Init(-1,44100,0, win)) then
begin
Error('Can''t initialize device');
Close();
end else // get list of inputs
begin
BASS_RecordSetInput(input,BASS_INPUT_LEVEL or 100);
c:=0; i:=BASS_RecordGetInputName(c);
while i<>Nil do
begin
if pos('hear',ansilowercase(strpas(i)))>0 then
begin
input:=c; ii:=0;
while BASS_RecordSetInput(ii,BASS_INPUT_OFF) do inc(ii);// 1st disable all inputs, then...
BASS_RecordSetInput(input,BASS_INPUT_ON); // enable the selected
end;
inc(c);
i:=BASS_RecordGetInputName(c);
end;
end;
end;//FormCreate
procedure TForm1.bRecordClick(Sender: TObject);
begin
if (encstream=0) then StartRecording() else StopRecording();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if (encstream<>0) then BASS_Encode_Stop(encstream);
BASS_RecordFree();
BASS_Free();
end;
END.
