external bpm detection

[donatas]

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 Expand

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.