home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / matemat / Vyssi / FOURIER.ZIP / exmpl-1 / pas / frmfft.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-11  |  4.0 KB  |  160 lines
  1. unit frmfft;
  2.  
  3. {===========================================================
  4.  Please note, that the program FFT uses the unit RChart,
  5.  which is not supplied with the FOURIER package. If you
  6.  don't have it, you can download the shareware version from
  7.  one of the following WWW sites:
  8.      http://qspr03.tuwien.ac.at/lo/
  9.      http://www.lohninger.com/
  10.  ===========================================================}
  11.  
  12. interface
  13.  
  14. uses
  15.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
  16.   Forms, Dialogs, StdCtrls, RChart, Fourier, Buttons;
  17.  
  18. type
  19.   TForm1 = class(TForm)
  20.     RChart1: TRChart;
  21.     RChart2: TRChart;
  22.     ScrollBar1: TScrollBar;
  23.     SBFreq1: TScrollBar;
  24.     Label1: TLabel;
  25.     FFT1: TFastFourier;
  26.     BButExit: TBitBtn;
  27.     Label2: TLabel;
  28.     CBLogY: TCheckBox;
  29.     CBoxWind: TComboBox;
  30.     Label3: TLabel;
  31.     procedure ScrollBar1Change(Sender: TObject);
  32.     procedure SBFreq1Change(Sender: TObject);
  33.     procedure BButExitClick(Sender: TObject);
  34.     procedure FormActivate(Sender: TObject);
  35.     procedure CBLogYClick(Sender: TObject);
  36.     procedure CBoxWindChange(Sender: TObject);
  37.   private
  38.     procedure StartFFT;
  39.   public
  40.     { Public declarations }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50.  
  51. (**************************************************************)
  52. procedure TForm1.StartFFT;
  53. (**************************************************************)
  54.  
  55. var
  56.   i      : integer;
  57.   y      : double;
  58.   pmax   : double;
  59.  
  60. begin
  61. RChart1.ClearGraf;
  62. RChart1.DataColor := clBlue;
  63. RChart1.MoveTo (0,0);
  64. FFT1.ClearImag;
  65. for i:=1 to FFT1.SpectrumSize do
  66.   begin
  67.   y := 10*(sin(i*(100-SbFreq1.Position)/100)+sin(i/13)+cos(i/2)+
  68.        0.06*(random(100-ScrollBar1.Position)-0.5*(100-ScrollBar1.Position)));
  69.   FFT1.RealSpec[i] := y;           { real value }
  70.   RChart1.DrawTo (i,y);
  71.   end;
  72. RChart1.ShowGraf;
  73.  
  74. FFT1.Transform;
  75.  
  76. RChart2.ClearGraf;
  77. RChart2.DataColor := clRed;
  78. pmax := FFT1.PowerMax;
  79. if pmax > 0 then
  80.   begin
  81.   RChart2.MoveTo (2,FFT1.powerSpec[2]/pmax);
  82.   for i:=2 to FFT1.SpectrumSize do
  83.     begin
  84.     y := FFT1.powerSpec[i]/pmax;
  85.     RChart2.DrawTo (i,y);
  86.     end;
  87.   end;
  88. RChart2.ShowGraf;
  89. end;
  90.  
  91. (**************************************************************)
  92. procedure TForm1.ScrollBar1Change(Sender: TObject);
  93. (**************************************************************)
  94.  
  95. begin
  96. STartFFT;
  97. end;
  98.  
  99. (**************************************************************)
  100. procedure TForm1.SBFreq1Change(Sender: TObject);
  101. (**************************************************************)
  102.  
  103. begin
  104. StartFFT;
  105. end;
  106.  
  107. (**************************************************************)
  108. procedure TForm1.BButExitClick(Sender: TObject);
  109. (**************************************************************)
  110.  
  111. begin
  112. close;
  113. end;
  114.  
  115. (**************************************************************)
  116. procedure TForm1.FormActivate(Sender: TObject);
  117. (**************************************************************)
  118.  
  119. begin
  120. CBoxWind.Text := 'None';
  121. StartFFT;
  122. end;
  123.  
  124. (**************************************************************)
  125. procedure TForm1.CBLogYClick(Sender: TObject);
  126. (**************************************************************)
  127.  
  128. begin
  129. RChart2.LogScaleY := CBLogY.Checked;
  130. if RChart2.LogScaleY
  131.   then RChart2.DecPlaceY := -1
  132.   else RChart2.DecPlaceY := 2;
  133. end;
  134.  
  135. (**************************************************************)
  136. procedure TForm1.CBoxWindChange(Sender: TObject);
  137. (**************************************************************)
  138.  
  139. begin
  140. if CBoxWind.Text = 'Rectangle' then
  141.   FFT1.WeightingWindow := fwRectangle;
  142. if CBoxWind.Text = 'Triangle' then
  143.   FFT1.WeightingWindow := fwTriangle;
  144. if CBoxWind.Text = 'Gaussian' then
  145.   FFT1.WeightingWindow := fwGauss;
  146. if CBoxWind.Text = 'Hamming' then
  147.   FFT1.WeightingWindow := fwHamming;
  148. if CBoxWind.Text = 'Blackman' then
  149.   FFT1.WeightingWindow := fwBlackman;
  150. if CBoxWind.Text = 'cos2' then
  151.   FFT1.WeightingWindow := fwCos2;
  152. StartFFT;  
  153. end;
  154.  
  155. end.
  156.  
  157.  
  158.  
  159.  
  160.