Hallo liebe Delphi-Freunde,
ich hab ganz vergessen, ein Demo zu posten.. Tut mir leid.
hier also gleich im Anschluss etwas Democode..
Nun.. der Code ist schon aus 1986 und nur letztens etwas an DELPHI V6 angepasst worden.
Sicher könnte man das auch eleganter gestalten. Wenn man die Rechenroutinen noch als DLL
in C++ schreibt, ist auch hier noch etwas an Geschwindigkeit rauszuholen..
Bitte beim Abtippen beachten!!!
1. Ihr braucht zum Demo 3 Images, um die Werte anzeigen zu können:
Width=513; Height =121 Position egal
2. Auskommentierung beachten, um die Demos abzuspielen
3. FFT-Algorithmus ist von Cooley und Tukey entwickelt worden
(Ich habe ihn damals(1986) aus einem Fachartikel von C nach TurboPascal V6
implementiert und mehrfach in Messsystemen benutzt (JDK TurboPac 86/87)
Bitte auch beachten, das hier mit komplexen Berechnungen gearbeitet wird
i := SQRT(-1) !!!! komplexe Zahl j = Wurzel aus -1
Real und Imaginär-Teil beachten!!
4. In diesem Demo wird eine 512-Punkte FFT durchgeführt(Default-Einstellung)
5. Bitte "Faltung beachten, deshalb nur 256 Cpx-Werte darstellen
FFT ist vielseitig. Das Demo filtert z.B. Störimpulse aus einer Schwingung raus.
Man kann Texturen beschreiben oder, was ganz wichtig ist...
Heutzutage forscht man auch hinsichtlich Datenreduktionsmöglichkeiten bei Übertragung
Zur FFT werde ich nichts beschreiben.. Das gibt's in einschlägiger Fachliteratur
Ist eh' hochmathematisch.. Na, die Informatiker werden es ja verstehen..
Ich könnte das ganze Testprogramm als RAR-Datei reinstellen, wenn Interesse besteht.
.. und hier etwas Source ..
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191:
| unit FFTtest;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MATH32Ext, ExtCtrls;
type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Label2: TLabel; Image1: TImage; Image2: TImage; Image3: TImage; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel;
procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Demo1; procedure Demo2; private fx : mixd; mySpectrum : TSpectrum; public end;
var Form1: TForm1; myFourier : TFourier; implementation
{$R *.dfm}
PROCEDURE FillBlock_fx(var fx:Mixd); VAR i :INTEGER; BEGIN FOR i := 0 TO 511 DO BEGIN fx.Cbuf[i].im := 0.0; fx.Cbuf[i].re := SIN((400*i/511)/5*PI) + COS((30*i/511)/5*PI) + SIN(I/RAD); END; fx.Cbuf[50].re := -2.0 ; fx.Cbuf[100].re := 3.0; fx.Cbuf[350].re := -3.0; END;
procedure TForm1.Button1Click(Sender: TObject); begin Application.Terminate; end;
procedure TForm1.Demo1; var i : integer; BEGIN
label1.Caption := 'Frequenzabstand: '+floattostr(myFourier.Get_FrequenceAxis)+' Hz'; label2.Caption := 'Fourierbuffer: '+inttostr(sizeof(fx));
FillBlock_fx(fx); image1.Canvas.moveTo(0,50+round(15*fx.Cbuf[0].re) ); For i := 1 to 511 do BEGIN image1.Canvas.LineTo(i,50+round(15*fx.Cbuf[i].re) ); END; image1.Show;
myFourier.FFT(fx,512); myFourier.BetragsSpektrum(fx, mySpectrum); For i := 0 to 255 do BEGIN image2.Canvas.moveTo(i*2,100); image2.Canvas.LineTo(i*2,100-round(150*mySpectrum[i]) ); END;
image2.Show;
myFourier.IFT(fx,512); image3.Canvas.moveTo(0,50+round(15*fx.Cbuf[0].re) ); For i := 1 to 511 do BEGIN image3.Canvas.LineTo(i,50+round(15*fx.Cbuf[i].re) ); END; image3.Show; END;
procedure TForm1.Demo2; var i,w,h,b,l : integer; BEGIN label1.Caption := 'Frequenzabstand: '+floattostr(myFourier.Get_FrequenceAxis)+' Hz'; label2.Caption := 'Fourierbuffer: '+inttostr(sizeof(fx)); label3.Caption := ''; label4.Caption := ''; label5.Caption := ''; FillBlock_fx(fx); image1.Canvas.moveTo(0,50+round(15*fx.Cbuf[0].re) ); For i := 1 to 511 do BEGIN image1.Canvas.LineTo(i,50+round(15*fx.Cbuf[i].re) ); END; image1.Show; w := image1.Width; label6.Caption := 'w: '+inttostr(w); h := image1.Height;label7.Caption := 'h: '+inttostr(h); b := image1.Top; label8.Caption := 't: '+inttostr(b); l := image1.Left; label9.Caption := 'l: '+inttostr(l); image1.Canvas.moveTo(0,0); image1.Canvas.LineTo(w-1,0); image1.Canvas.LineTo(w-1,h-1); image1.Canvas.LineTo(0,h-1); image1.Canvas.LineTo(0,0);
END;
procedure TForm1.FormCreate(Sender: TObject); begin myFourier:= TFourier.Create; end;
procedure TForm1.FormDestroy(Sender: TObject); begin myFourier.Destroy; end;
end. |
so.. und nun viel Spass
Gruss
JDKDelphi
Wo andere aufhören, fange ich erst an..