B I t I r u V m a L a k a V i y I sh I

ILOVALAR

unit MainForm; interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin, Grids, ExtCtrls, XPMan;
type
TForm1 = class(TForm) sg: TStringGrid;
sg2: TStringGrid; Panel1: TPanel; SpinEdit1: TSpinEdit; Button1: TButton; Button2: TButton; sgful: TStringGrid;
CheckBox1: TCheckBox; RadioGroup1: TRadioGroup; XPManifest1: TXPManifest;
procedure SpinEdit1Change(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject);
procedure sgfulDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end;
type
TArrayValues = array of Double; var
Form1: TForm1; implementation
{$R *.dfm} const
TwoPi = 6.283185307179586;
procedure FFTAnalysis(var AVal, FTvl: TArrayValues; Nvl, Nft: Integer); var
i, j, n, m, Mmax, Istp: Integer; Tmpr, Tmpi, Wtmp, Theta: Double; Wpr, Wpi, Wr, Wi: Double;
Tmvl: TArrayValues; begin
n:= Nvl * 2; SetLength(Tmvl, n); for i:= 0 to Nvl-1 do begin
j:= i * 2; Tmvl[j]:= 0; Tmvl[j+1]:= AVal[i]; end;
i:= 1; j:= 1;
while i < n do begin if j > i then begin
Tmpr:= Tmvl[i]; Tmvl[i]:= Tmvl[j]; Tmvl[j]:= Tmpr;
Tmpr:= Tmvl[i+1]; Tmvl[i+1]:= Tmvl[j+1]; Tmvl[j+1]:= Tmpr; end;
i:= i + 2; m:= Nvl;
while (m >= 2) and (j > m) do begin j:= j - m; m:= m div 2;
end;
j:= j + m; end;
Mmax:= 2;
while n > Mmax do begin
Theta:= -TwoPi / Mmax; Wpi:= Sin(Theta); Wtmp:= Sin(Theta / 2); Wpr:= Wtmp * Wtmp * 2; Istp:= Mmax * 2; Wr:= 1; Wi:= 0; m:= 1;
while m < Mmax do begin
i:= m; m:= m + 2; Tmpr:= Wr; Tmpi:= Wi; Wr:= Wr - Tmpr * Wpr - Tmpi * Wpi; Wi:= Wi + Tmpr * Wpi - Tmpi * Wpr; while i < n do begin
j:= i + Mmax;
Tmpr:= Wr * Tmvl[j] - Wi * Tmvl[j-1]; Tmpi:= Wi * Tmvl[j] + Wr * Tmvl[j-1];
Tmvl[j]:= Tmvl[i] - Tmpr; Tmvl[j-1]:= Tmvl[i-1] - Tmpi; Tmvl[i]:= Tmvl[i] + Tmpr; Tmvl[i-1]:= Tmvl[i-1] + Tmpi; i:= i + Istp;
end; end;
Mmax:= Istp; end;
for i:= 1 to Nft-1 do begin
j:= i * 2; FTvl[Nft - i - 1]:= Sqrt(Sqr(Tmvl[j]) + Sqr(Tmvl[j+1])); end;
SetLength(Tmvl, 0); end;
procedure TForm1.SpinEdit1Change(Sender: TObject); var
i,j:integer; begin
sg.ColCount:=round(exp(SpinEdit1.Value*ln(2))) +1;
sgful.rowCount:=round(exp(SpinEdit1.Value*ln(2))) +1; sgful.ColCount:=SpinEdit1.Value+1;
for i:=1 to sg.ColCount-1 do sg.Cells[i,0]:=inttostr(random(10)); end;
procedure TForm1.Button1Click(Sender: TObject); var
AVal, FTvl: TArrayValues; Nvl, Nft,i,j,k,m: Integer; begin
nvl:=sg.ColCount-1; SetLength(aval,nvl+1);
//nft:=strtoint(edit1.Text); nft:=nvl; SetLength(ftvl,nft+1);
// aval[3]:=4;
for i:=1 to nvl do aval[i-1]:=strtofloat(sg.Cells[i,0]); FFTAnalysis(AVal, FTvl, Nvl, Nft); sg2.ColCount:=nft+1;
for i:=1 to nft do sg2.Cells[i,0]:=floattostr(ftvl[i-1]); end;
procedure TForm1.Button2Click(Sender: TObject); var
AVal, FTvl: TArrayValues;
Nvl, Nft,i,j,k,m,ms,mf,t,l: Integer; begin
//Fure
if RadioGroup1.ItemIndex=3 then begin
button1.Click;
exit; end;
nvl:=sg.ColCount-1; SetLength(aval,nvl+1); SetLength(ftvl,nvl+1);
for i:=1 to nvl do sgful.Cells[0,i]:=sg.Cells[i,0]; t:=nvl div 2;
//ShowMessage(inttostr(t));
if RadioGroup1.ItemIndex=1 then for j:=0 to nvl div 4-1 do
begin i:=2*j+1;
sgful.Cells[0,i]:=sg.Cells[i,0]; sgful.Cells[0,i+1]:=sg.Cells[t+i,0]; sgful.Cells[0,t+i]:=sg.Cells[i+1,0]; sgful.Cells[0,t+i+1]:=sg.Cells[t+i+1,0]; end;
for k:=1 to SpinEdit1.Value do begin
sgful.Cells[k,0]:='Qadam: '+inttostr(k);
for i:=1 to nvl do aval[i-1]:=strtofloat(sgful.Cells[k-1,i]); m:= round(exp((k-1)*ln(2)));
for j:=1 to m do begin
//showmessage(inttostr(m)); t:=(nvl div m) ;
ms:=(j-1)*t; mf:=j*t-1;
//ShowMessage('m='+inttostr(t)+' ms='+inttostr(ms)+' mf='+inttostr(mf)); for i:=ms to (ms+mf) div 2 do
begin
//ShowMessage('k='+inttostr(k)+' j='+inttostr(j)+' i='+inttostr(i)); FTvl[i]:=aval[i]+aval[i+t div 2];
FTvl[i+(t div 2)]:=aval[i]-aval[i+(t div 2)];
if (k=SpinEdit1.Value) and CheckBox1.Checked then begin
FTvl[i]:=FTvl[i]/nvl;
FTvl[i+(t div 2)]:=FTvl[i+(t div 2)]/nvl; end;
sgful.Cells[k,i+(t div 2)+1]:=floattostr(FTvl[i+(t div 2)]); sgful.Cells[k,i+1]:=floattostr(FTvl[i]);
//ShowMessage('a['+inttostr(i)+']='+floattostr(aval[i])+' : a['+inttostr(i+(t div 2))+']='+floattostr(aval[i+(t div 2)]));
end; end; end;

// for i:=1 to nvl do sgful.Cells[0,i]:='Vd['+inttostr(i)+']='+sg.Cells[i,0]; end;

procedure TForm1.sgfulDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
AVal, FTvl: TArrayValues;
Nvl, Nft,i,j,k,m,ms,mf,t,l: Integer; begin
if (acol=sgful.ColCount-1)and(arow=sgful.RowCount-1) then begin
nvl:=sg.ColCount-1;
//k:=2;
//i:=4;
// sgful.Canvas.Pen.Width:=2; sgful.Canvas.Pen.Color:=clGreen; for k:=1 to SpinEdit1.Value do begin
m:= round(exp((k-1)*ln(2))); for j:=1 to m do
begin
t:=(nvl div m) ;
ms:=(j-1)*t; mf:=j*t-1;
for i:=ms to (ms+mf) div 2 do begin
// sgful.Canvas.MoveTo((k)*50+20,(i)*24+12);
// sgful.Canvas.LineTo((k+1)*50,(i)*24+12);
// sgful.Canvas.LineTo((k)*50+20,(i+(t div 2))*24+12);
// sgful.Canvas.MoveTo((k)*50+20,(i+(t div 2))*24+12);
//sgful.Canvas.LIneTo((k+1)*50+20,(i+(t div 2))*24+12);
//ShowMessage('a['+inttostr(i)+']='+floattostr(aval[i])+' : a['+inttostr(i+(t div 2))+']='+floattostr(aval[i+(t div 2)]));
end; end; end; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin
sg.Cells[0,0]:='Входные данные (Vd[ ]): '; sg.ColWidths[0]:=150; sg2.Cells[0,0]:='Преобразование Фурье: '; sg2.ColWidths[0]:=150;
end; end.