end;

procedure bytetostring(b:array of integer;var s:string);

begin

s:='';

for x:=0 to 127 do

s:=s+chr(b[x]+1);

end;

procedure stringtobyte(s:string;var b:array of integer);

begin

for x:=0 to 127 do b[x]:=ord(s[x+1]);

end;

procedure glResizeWnd(Width, Height : Integer);

begin

if (Height = 0) then // prevent divide by zero exception

Height := 1;

glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window

glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection

glLoadIdentity(); // Reset View

gluPerspective(45.0, Width/Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth

glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix

glLoadIdentity(); // Reset View

end;

Procedure SetDCPixelFormat;

var

nPixelFormat: Integer;

pfd: TPixelFormatDescriptor;

begin

FillChar(pfd, SizeOf(pfd),0);

with pfd do begin

nSize := sizeof(pfd); // Size of this structure

nVersion := 1; // Version number

dwFlags := PFD_DRAW_TO_WINDOW or

PFD_SUPPORT_OPENGL or

PFD_DOUBLEBUFFER; // Flags

iPixelType:= PFD_TYPE_RGBA; // RGBA pixel values

cColorBits:= 24; // 24-bit color

cDepthBits:= 32; // 32-bit depth buffer

iLayerType:= PFD_MAIN_PLANE; // Layer type

end;

nPixelFormat := ChoosePixelFormat(DC, @pfd);

SetPixelFormat(DC, nPixelFormat, @pfd);

DescribePixelFormat(DC, nPixelFormat, sizeof(TPixelFormatDescriptor), pfd);

end;

procedure TfoInMain.FormCreate(Sender: TObject);

var Reg: TRegistry;

s:string;

us_id:string;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CURRENT_USER;

if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer', false)

then s:=Reg.REadString('Logon User Name');

finally

Reg.CloseKey;

Reg.Free;

inherited;

end;

edit2.Text:=s;

edit1.Text:=s;

left:=0;

top:=0;

height:=screen.height;

width:=screen.width;

speedbutton7.left:=width-speedbutton7.Width-5;

Image1.Canvas.Brush.Color:=clwhite;

Image1.Canvas.Rectangle(0,0,Image1.width,Image1.Height);

GetSpectrPicture('test1.wav',image1,3);

ADOquery1.Active:=false;

ADOquery1.SQL.Clear;

ADOquery1.SQL.add('select * from userinfo where (deleted=0) and (login='+chr(39)+edit2.Text+chr(39)+')');

RunSQL(ADOquery1,false);

us_id:=ADOquery1.FieldByName('user_id').asstring;

ADOquery1.Active:=false;

ADOquery1.SQL.Clear;

ADOquery1.SQL.add('select * from reg where (deleted=0) and (user_id='+us_id+')');

RunSQL(ADOquery1,false);

ADOquery1.First;

while not ADOquery1.eof do

with ADOquery1 do

begin

if ADOquery1.FieldByName('number').asinteger=1 then

begin

s:=ADOquery1.FieldByName('spectr').AsString;

stringtobyte(s,energ1);

end;

if ADOquery1.FieldByName('number').asinteger=2 then

begin

s:=ADOquery1.FieldByName('spectr').AsString;

stringtobyte(s,energ2);

end;

if ADOquery1.FieldByName('number').asinteger=3 then

begin

s:=ADOquery1.FieldByName('spectr').AsString;

stringtobyte(s,energ3);

end;

ADOquery1.Next;

end;

h_wnd:=panel1.Handle;

DC := GetDC(h_wnd);

SetDCPixelFormat;

H_RC := wglCreateContext(DC);

wglMakeCurrent(DC, H_RC);

// gluPerspective(45.0, panel1.Width/panel1.Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth

// glViewport(0, 0, panel1.Width, panel1.Height); // Set the viewport for the OpenGL window

glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection

glLoadIdentity(); // Reset View

glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix

glLoadIdentity(); // Reset View

glResizeWnd(panel1.Width, panel1.Height);

glinit;

end;

procedure TfoInMain.Image5MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if sender = image5 then cursampl:=1;

if cursampl<>0 then begin

deletefile('test.wav');

//--------

FCapture.Free;

FCapture := TSoundCaptureStream.Create(nil);

FWaveStream := TWaveFileStream.Create('test.wav', fmCreate);

with FCapture.SupportedFormats[8] do

FWaveStream.SetPCMFormat(22050, 8, 1);

FWaveStream.Open(True);

FCapture.OnFilledBuffer := CaptureFilledBuffer;

FCapture.CaptureFormat := 8;

FCapture.Start;

end;

end;

procedure TfoInMain.Image5MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var spectr:array[1..128]of integer;

i1,i2,i3,max:real;

i:integer;

image:timage;

f:file;

begin

if FCapture<>nil then

FCapture.Stop;

FWaveStream.Free; FWaveStream := nil;

if cursampl=1 then begin image:=image2;end;

getspectr('test.wav',spectr);

Image.Canvas.Brush.Color:=clwhite;

Image.Canvas.Rectangle(0,0,Image.width,Image.Height);

Image.Canvas.MoveTo(0,128);

for i:=1 to 128 do

begin

Image.Canvas.LineTo(i,128-spectr[i]);

energ[i]:=spectr[i];

end;

cursampl:=0;

Image1.Canvas.Brush.Color:=clwhite;

Image1.Canvas.Rectangle(0,0,Image1.width,Image1.Height);

GetSpectrPicture('test.wav',image1,6);

max:=0;

i1:=calc_fxy(energ1,energ);

if i1>max then max:=i1;

i2:=calc_fxy(energ2,energ);

if i2>max then max:=i2;

i3:=calc_fxy(energ3,energ);

if i3>max then max:=i3;

label4.caption:=inttostr(round(i1*100));

label5.caption:=inttostr(round(i2*100));

label6.caption:=inttostr(round(i3*100));

end;

procedure TfoInMain.SpeedButton7MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

close;

end;

procedure TfoInMain.Timer1Timer(Sender: TObject);

begin

// Velocity[random(GridSize-3)+2, random(GridSize-3)+2] :=1060;

yAngle :=yangle+0.5;

glDraw();

end;

end.

Модуль FFTC.CPP

//---------------------------------------------------------------------------

// VoiceSec module. FFT transform.

// 10.2002

//

// author email viman@pisem.net

//

//---------------------------------------------------------------------------

#include <vcl.h>

#include "fft.h"

#pragma hdrstop

#define WINDOW_RECTANGLE 0

#define WINDOW_HAMMING 1

#define WINDOW_BLACKMAN 2

#define WINDOW_BARTLETT 3

#define WINDOW_TRIANGLE 3

#define WINDOW_HANNING 4

#define MATH_PI 3.141592653589793

inline int Round(double x) { return (int)(x+0.5); }

inline long double sqr(long double x) { return x*x; }

int FFTSize;

#ifdef __cplusplus

extern "C" {

#endif

__declspec( dllexport )

void FFTC(Cmplx *X,int FFTSize)

{

int N, M, i, j, L, LE, LE2, ip, k, s;

Cmplx t,z;

RealData UR, UI, SR, SI, TR, TI;

N = FFTSize;

M = Round(log(N)/log(2));

// Bit-reverse

i = 0;

for (s=0;s<N-1;s++) {

if (s<i) {

t = *(X+i); *(X+i) = *(X+s); *(X+s) = t;

}

k = N >> 1;

while (i&k) k >>= 1;

i += k;

k <<= 1;

while (k<N) {

i -= k;

k <<= 1;

}

}

// First pass

for (i=0;i<N;i+=2) {

t = *(X+i);

(X+i)->Re = t.Re + (X+i+1)->Re;

(X+i)->Im = t.Im + (X+i+1)->Im;

(X+i+1)->Re = t.Re - (X+i+1)->Re;

(X+i+1)->Im = t.Im - (X+i+1)->Im;

}

// Second pass

for (i=0;i<N;i+=4) {

t = *(X+i);

(X+i)->Re = t.Re + (X+i+2)->Re;

(X+i)->Im = t.Im + (X+i+2)->Im;

(X+i+2)->Re = t.Re - (X+i+2)->Re;

(X+i+2)->Im = t.Im - (X+i+2)->Im;

t = *(X+i+1);

z = *(X+i+3);

(X+i+1)->Re = t.Re + z.Im;

(X+i+1)->Im = t.Im - z.Re;

(X+i+3)->Re = t.Re - z.Im;

(X+i+3)->Im = t.Im + z.Re;

}

// Last passes

for (L=3;L<=M;L++) {

LE = 1 << L;

LE2 = LE >> 1;

UR = 1; UI = 0;

SR = cos(MATH_PI/LE2);

SI = -sin(MATH_PI/LE2);

for (j=0;j<LE2;j++) {

for (i=j;i<N;i+=LE) {

ip = i + LE2;

TR = (X+ip)->Re*UR - (X+ip)->Im*UI;

TI = (X+ip)->Re*UI + (X+ip)->Im*UR;

(X+ip)->Re = (X+i)->Re - TR;

(X+ip)->Im = (X+i)->Im - TI;

(X+i)->Re = (X+i)->Re + TR;

(X+i)->Im = (X+i)->Im + TI;

}

TR = UR;

UR = TR*SR - UI*SI;

UI = TR*SI + UI*SR;

}

}

}

}

#ifdef __cplusplus

#endif

#ifdef __cplusplus

extern "C" {

#endif

__declspec( dllexport )void

FFTR(Cmplx *X) {

int N, ND2, ND4;

int i, im, ip2, ipm, ip;

RealData UR, UI, SR, SI, TR, TI;

FFTSize=256;

// Separate even and odd points

N = FFTSize;

ND2 = N>>1;

ND4 = ND2>>1;

for (i=0;i<ND2;i++) {

(X+i)->Re = (X+(i<<1))->Re;

(X+i)->Im = (X+(i<<1)+1)->Re;

}

// Calculate N/2 point FFT

FFTSize = ND2;

FFTC(X,FFTSize);

FFTSize = N;

// Even/odd frequency domain decomposition

for (i=1;i<ND4;i++) {

im = ND2 - i;

ip2 = i + ND2;

ipm = im + ND2;

(X+ipm)->Re = (X+ip2)->Re = ((X+i)->Im + (X+im)->Im)*0.5;

(X+ip2)->Im = ((X+i)->Re - (X+im)->Re)*(-0.5);

(X+ipm)->Im = - (X+ip2)->Im;

(X+im)->Re = (X+i)->Re = ((X+i)->Re + (X+im)->Re)*0.5;

(X+i)->Im = ((X+i)->Im - (X+im)->Im)*0.5;

(X+im)->Im = - (X+i)->Im;

}

(X+N*3/4)->Re = (X+ND4)->Im;

(X+ND2)->Re = X->Im;

(X+ND2+ND4)->Im = (X+ND2)->Im = (X+ND4)->Im = X->Im = 0;

// Complete the last FFT stage

// First step: calculate X[0] and X[N/2]

TR = (X+ND2)->Re;

TI = (X+ND2)->Im;

(X+ND2)->Re = X->Re - TR;

(X+ND2)->Im = X->Im - TI;

X->Re = X->Re + TR;

X->Im = X->Im + TI;

// Other steps

UR = SR = cos(MATH_PI/ND2);

UI = SI = -sin(MATH_PI/ND2);

ip = ND2+1;

for (i=1;i<ND2;i++,ip++) {

TR = (X+ip)->Re*UR - (X+ip)->Im*UI;

TI = (X+ip)->Re*UI + (X+ip)->Im*UR;

(X+ip)->Re = (X+i)->Re - TR;

(X+ip)->Im = (X+i)->Im - TI;

(X+i)->Re = (X+i)->Re + TR;

(X+i)->Im = (X+i)->Im + TI;

(X+i)->Re = (X+i)->Re + (X+ip)->Re*UR - (X+ip)->Im*UI;

(X+i)->Im = (X+i)->Im + (X+ip)->Re*UI + (X+ip)->Im*UR;

TR = UR;

UR = TR*SR - UI*SI;

UI = TR*SI + UI*SR;

}

}}

#ifdef __cplusplus

#endif

int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)

{

return 1;

}

Размещено на Allbest.ru