Komponent do obslugi mikrofonu

Czy ktoś może mi powiedziec jak przechwytywac sygnal z mikrofonu a potem sprawdzac czestotliwosc przechwyconego dzwieku (albo robic to w czasie rzeczywistym).
Przydałby sie tez jakis komponent do obslugi mikrofonu ale nie wiem gdzie go szukać.

nie chcę strzelić głupa, ale z tego co pamiętam, to TMediaPlayer ma funkcję także rejestrowania dźwięku ;)

bass.dll

Wiem ze tmediaplayer odpowiada za rejestrowanie dzwieku tylko jak sprawdzac czestotliwosc

robilem taki programik co rejetrowal sygnal z wejscia liniowego do ktorego podlaczony bym mikrofon. Sporo sie nakombinowalem ale... moge ci dac kod zrodlowy jesli go zakumasz i jeszcze jedno... nie korzystaj z TMediaPlayer!! Ja korzystalem z DirectX bezposrednio - latwiej dokladniej i wiecej mozliwosci doboru interesujacych cie parametrow sygnalu.
oto przyklad kodu do ustawiania czestotliwosci sygnalu przez DirecX..
jojoo...

{
unit STRCathc;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, ExtCtrls,
DXSounds, StdCtrls, StrUtils;

type
PFastBuff=^TMeFastBuff;
TMeFastBuff=array [0..48000] of SmallInt;

type
TForm1 = class(TForm)
Timer1: TTimer;
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
est1: TMenuItem;
File1: TMenuItem;
Exit1: TMenuItem;
Memo1: TMemo;
Stop1: TMenuItem;
ListBox1: TListBox;
Splitter1: TSplitter;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure est1Click(Sender: TObject);
procedure Stop1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
LICap:TSoundCaptureStream;
procedure MakeItClap(Sender: TObject);
procedure add(const text:string; const Z:array of const);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
TimesInSecFilled,old2:longword;
GoCountDown:boolean;
old:integer;

procedure TForm1.add(const text:string; const Z:array of const);
begin
Memo1.lines.Add(Format(text,Z))
end;

procedure TForm1.MakeItClap(Sender: TObject);
begin
inc(TimesInSecFilled,1);
old:=LICap.FilledSize-old;
case old of
-maxint..0:add('wypelenienie',[]);
end;
old:=LICap.FilledSize;
add('%d. >>%d',[TimesInSecFilled,LICap.FilledSize]);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
id:longword;
SconifgS:string;
begin
StatusBar1.Canvas.Brush.Color:=color;
TimesInSecFilled:=0;
LICap:=TSoundCaptureStream.Create(nil);
LICap.OnFilledBuffer:=MakeItClap;
LICap.SetPCMFormat(48000,16,1);
LICap.BufferLength:=1000;
old2:=0;
old:=0;
for id:=0 to LICap.SupportedFormats.Count-1 do
with LICap.SupportedFormats.Items[id] do
begin
SconifgS:=format('ID: %d BitsPerSample: %d Channels: %d SamplesPerSec: %d',[ID,BitsPerSample,Channels,SamplesPerSec]);
listbox1.Items.Add(SconifgS);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
textout:string;
diff:longword;
begin
if GoCountDown then
begin
StatusBar1.Repaint;
diff:=LICap.FilledSize - old;
if diff<=0 then diff:=LICap.FilledSize;
old:=LICap.FilledSize;
textOut:='%d [Fills/sec] >> FilledSize: %d >> Diff: %d';
StatusBar1.Canvas.TextOut(2,3,Format(textout,[TimesInSecFilled,LICap.FilledSize,diff]));
add(textout,[TimesInSecFilled,LICap.FilledSize,Diff]);
end;
end;

procedure TForm1.est1Click(Sender: TObject);
begin
memo1.hide;
GoCountDown:=true;
LICap.Start;
TimesInSecFilled:=0;
end;

procedure TForm1.Stop1Click(Sender: TObject);
begin
GoCountDown:=false;
LICap.Stop;
memo1.Show;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
NewBufferSize:Longword;
begin
if listbox1.Count-1>0 then
begin
LICAp.CaptureFormat:=listbox1.ItemIndex;
NewBufferSize:=strtoint(inputBox('Acquire new Buffer Size for stream Catching','Enter Value',inttostr(LICap.BufferLength)));
LICap.BufferLength:=NewBufferSize;
with licap.SupportedFormats[LICAp.CaptureFormat] do
add('Configuration Update>> ID: %d BitsPerSample: %d Channels: %d SamplesPerSec: %d BufferLength: %d',[ID,BitsPerSample,Channels,SamplesPerSec,LICap.BufferLength]);
end;
end;

end.

• ten kod odczytuje mozliwosci systemu jesli chodzi o ustawienia czestotliwosci probkowania, bits per samle i ilosci kanalow - to tylko przedsmak... cale "lapanie sygnalu to troche bardziej ciekawe i skomplikowane jest hehehe"
  }

  jak chcesz kod to daj znac. YO!!

aha - zapomnialem sie zalogowac.. wiec ..
moj mail: [email protected]
sorki [rotfl]