Форум на Исходниках.RU

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem, TeeProcs, TeEngine, Chart, Series, ap, fft;

const

freq=44100;

BufSize=2048;

Xgraph=512;

Ygraph=100;

type

TData16 = array [0..BufSize-1] of smallint;

PData16 = ^TData16;

TPointArr = array [0..BufSize-1] of TPoint;

PPointArr = ^TPointArr;

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

PaintBox1: TPaintBox;

Chart1: TChart;

Chart2: TChart;

Series2: TBarSeries;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;

end;

var

Form1: TForm1;

series1, series2 : tlineSeries;

coef: array of integer;

a,b: TReal1DArray;

implementation

{$R *.DFM}

var

WaveIn: hWaveIn;

hBuf: THandle;

BufHead: TWaveHdr;

p: PPointArr;

stop: boolean = false;

comp:complex;

function modul(const comp:complex):double;

begin

result:=sqrt(sqr(comp.x)+sqr(comp.y));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

header: TWaveFormatEx;

BufLen: word;

buf: pointer;

begin

with header do

begin

wFormatTag := WAVE_FORMAT_PCM;

nChannels := 2; { количество каналов }

nSamplesPerSec := freq; { частота }

wBitsPerSample := 16; { 8 / 16 бит }

nBlockAlign := nChannels * (wBitsPerSample div 8);

nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;

cbSize := 0;

end;

WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),

Form1.Handle, 0, CALLBACK_WINDOW);

BufLen := header.nBlockAlign * BufSize;

hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);

Buf := GlobalLock(hBuf);

with BufHead do

begin

lpData := Buf;

dwBufferLength := BufLen;

dwFlags := WHDR_BEGINLOOP;

end;

WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));

WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));

GetMem(p, BufSize * sizeof(TPoint));

stop := true;

WaveInStart(WaveIn);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if stop = false then

Exit;

stop := false;

while not stop do

Application.ProcessMessages;

stop := false;

WaveInReset(WaveIn);

WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));

WaveInClose(WaveIn);

GlobalUnlock(hBuf);

GlobalFree(hBuf);

FreeMem(p, BufSize * sizeof(TPoint));

end;

procedure TForm1.OnWaveIn;

var

i,j: integer;

data16: PData16;

XScale, YScale: single;

begin

XScale := Xgraph / BufSize;

data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);

YScale := Ygraph / (1 shl 16);

series1.Clear;

for i := 0 to BufSize-1 do begin

p^[i] := Point(round(i * XScale), round(Ygraph / 2 - data16^[i] * YScale));

series1.AddXY(round(i * XScale), round(Ygraph / 2 - data16^[i] * YScale));

a[2*i]:=round(Ygraph / 2 - data16^[i] * YScale);

a[2*i+1]:=0;

end;

FastFourierTransform(a, BufSize, false);

series2.clear;

for j :=1 to BufSize-1 do

begin

// comp.X:= a[2*j];

// comp.Y:=a[2*j+1];

b[j]:=sqrt(a[2*j]*a[2*j]+a[2*j+1]*a[2*j+1]);

series2.AddXY(coef[j],b[j]);

end;

with PaintBox1.Canvas do

begin

Brush.Color := clWhite;

FillRect(ClipRect);

Polyline(Slice(p^, BufSize));

end;

if stop then

WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))

else

stop := true;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Button2.Click;

Finalize(a);

Finalize(b);

Finalize(coef);

end;

procedure TForm1.FormCreate(Sender: TObject);

var i: integer;

XScale: single;

begin

series1 := tlineSeries.Create(nil);

series1.ParentChart := Chart1;

series1.Clear;

setlength(a,2*BufSize);

setlength(b,BufSize);

setlength(coef,BufSize);

XScale := Xgraph / BufSize;

for I := 0 to BufSize-1 do

coef[i]:=round(i * XScale);

Button1.Caption := 'Start';

Button2.Caption := 'Stop';

end;

end.