Author Topic: external bpm detection  (Read 5351 times)

donatas

  • Posts: 2
external bpm detection
« on: 12 Aug '03 - 10:43 »
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....
Code: [Select]

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.