Autor Beitrag
JDKDelphi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 115
Erhaltene Danke: 22

WIN2000, XP, WIN 7 , UNIX, LINUX
Assembler für (Z8x, 68xxx,R6000,Intel), DELPHI 6 Enterprise, MAGIC eDeveloper V9+V10, C++, C#,VB, .NET, zertifizierter iBOLT-Programmierer
BeitragVerfasst: Sa 04.11.06 23:12 
Hallo an alle..

Ich stelle hier mal ne' kleine Unit zur Verfügung...
Vielleicht besteht Interesse....
DELPHI V6

Gruss
Einloggen, um Attachments anzusehen!
JDKDelphi Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 115
Erhaltene Danke: 22

WIN2000, XP, WIN 7 , UNIX, LINUX
Assembler für (Z8x, 68xxx,R6000,Intel), DELPHI 6 Enterprise, MAGIC eDeveloper V9+V10, C++, C#,VB, .NET, zertifizierter iBOLT-Programmierer
BeitragVerfasst: Di 07.11.06 22:23 
Titel: nochmal zur FFT-Unit
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 ..

ausblenden volle Höhe Delphi-Quelltext
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;

// Project: Testen FFT-Unit
// Autor:   JDK 11.2006 V 0.91  j.klapper
// Version: 0.9
// !!!!  Auszüge des Codes nicht zur gewerblichen Benutzung gedacht  !!!!
// Rückfragen email: jdksoft.shg@t-online.de oder joerg.klapper@googlemail.com

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
    { Private-Deklarationen }
          fx   : mixd;            // Block für FFT-Complex-Koeffziente
    mySpectrum : TSpectrum;       // hier kommt das Spektrum rein
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  // ein Objekt brauchen wir nun für's Demo 
  myFourier  : TFourier;   // FFT Hin und Rücktransformations-Unit
 
implementation

{$R *.dfm}

//------------------------------------------------------------------------------
{ Block initialisieren mit f(x)-Dummy-Funktion }

PROCEDURE FillBlock_fx(var fx:Mixd);
VAR i :INTEGER;
BEGIN
  FOR i := 0 TO 511 DO
  BEGIN
    fx.Cbuf[i].im := 0.0;                   { IMAG-Teil = 0 }
    fx.Cbuf[i].re := SIN((400*i/511)/5*PI) + COS((30*i/511)/5*PI) + SIN(I/RAD);
    //fx.Cbuf[i].re := SIN(i*6/RAD) + COS(i/RAD);
    //fx.Cbuf[i].re := -1.0 + 2*(i/512);
  END;
  fx.Cbuf[50].re := -2.0 ;                  { Störimpuls simulieren  }
  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));

 // Kurve erzeugen und anzeigen
 FillBlock_fx(fx);
 // Image malen....
 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;

 // FFTransformation Zeit in Freq-Bereich
 myFourier.FFT(fx,512);
 myFourier.BetragsSpektrum(fx, mySpectrum);
 // Image malen....
 For i := 0 to 255 do
 BEGIN
   image2.Canvas.moveTo(i*2,100);
   image2.Canvas.LineTo(i*2,100-round(150*mySpectrum[i]) );
 END;

 //-----------------------------------------------------------------
 // hier ein bischen manipulieren, wenn man will
 // auskommentieren, wenn Original --> Original transformiert werden soll
 {
 FOR i :=150 TO 511 DO
 BEGIN
   fx.Cbuf[i].re := 0.0;
   fx.Cbuf[i].im := 0.0;
 END;
 fx.Cbuf[50].re := 0.30;
 fx.Cbuf[50].im := -0.1;

 myFourier.BetragsSpektrum(fx, mySpectrum);
 // geändertes Image malen....
 image2.Canvas.Pen.Color := clRed  ;
 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;

 // FFT RückTransformation Freq in Zeit-Bereich
 myFourier.IFT(fx,512);
 // Image malen....
 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 := '';
 // Kurve erzeugen und anzeigen
 FillBlock_fx(fx);
 // Image malen....
 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);
 // Rahmen
 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;
 //Demo1;
 //Demo2;
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..
Studi
Hält's aus hier
Beiträge: 1



BeitragVerfasst: Di 02.06.09 13:32 
Hallo,

nach ein paar Änderungen war es möglich die Oberschwingungen und deren Phasenlage aus einer einfachen Sinusschwingungen zu erhalten.
Es ist zu beachten, dass bei der Fouriertransformation der Cosinus zurückgegeben wird.

Daher danke Dir JDKDelphi für diese nützliche Unit