⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 VCL component dsplab , STFT and SPECTRUM viewer, real time
💻 PAS
字号:
{
  The Perfomance test of DSPLAB components
  Author:  Eugen Tarasov

  Last modified - January, 2004

  Please send all suggestions to author

  e-mail: dsplab@teworks.com
  http://www.teworks.com
}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, dspIIRFilters, ExtCtrls, Tabs, dspFFT;

type
  TfmMain = class(TForm)
    Panel1: TPanel;
    TabSet1: TTabSet;
    Notebook1: TNotebook;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edtFilterOrder: TSpinEdit;
    cbFilterResponse: TComboBox;
    cbFilterKind: TComboBox;
    dspIIRFilter: TdspIIRFilter;
    dspFFT1: TdspFFT;
    Panel2: TPanel;
    L1: TLabel;
    edtPerfomance: TEdit;
    btnTestIIR: TButton;
    Bevel1: TBevel;
    Label4: TLabel;
    cbFFTSize: TComboBox;
    cbInverse: TCheckBox;
    procedure btnTestIIRClick(Sender: TObject);
    procedure TabSet1Change(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure FormCreate(Sender: TObject);
  public
    function TestIIRFilter: Integer;
    function TestFFT: Integer;
  end;

var
  fmMain: TfmMain;

implementation

uses MMSystem;

{$R *.DFM}

procedure TfmMain.TabSet1Change(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  Notebook1.PageIndex:= NewTab;
  edtPerfomance.Text:= '';
end;

{==============================================================================}
{ IIR Filter Perfomance                                                        }
{==============================================================================}

function TfmMain.TestIIRFilter: Integer;
var StartTime: DWORD;
begin
  Result:= 0;
  dspIIRFilter.Kind:= TdspIIRFilterKind(cbFilterKind.ItemIndex);
  dspIIRFilter.Response:= TdspIIRFilterResponse(cbFilterResponse.ItemIndex);
  dspIIRFilter.Order:= edtFilterOrder.Value;

  StartTime:= TimeGetTime;
  while TimeGetTime - StartTime < 1000 do
  begin
    dspIIRFilter.Filter(1000); // any value
    Inc(Result);
  end;
end;

procedure TfmMain.btnTestIIRClick(Sender: TObject);
var T: Integer;
begin
  Screen.Cursor:= crHourGlass;
  try
    case Notebook1.PageIndex of
      0: T:= TestIIRFilter;
      1: T:= TestFFT;
    else T:= 0;
    end;
    edtPerfomance.Text:= Format('%d per sec', [T]);
  finally
    Screen.Cursor:= crDefault;
  end;
end;


{==============================================================================}
{ FFT Perfomance                                                               }
{==============================================================================}


function TfmMain.TestFFT: Integer;
var
  I: Integer;
  StartTime: DWORD;
begin
  Result:= 0;

  // Setup FFT parameters
  dspFFT1.BufferSize:= StrToInt(cbFFTSize.Text);

  // Fill Buffer with random data
  for I:= 0 to dspFFT1.BufferSize - 1 do
  begin
    dspFFT1.RealIn[I]:= Random(100);
    dspFFT1.ImagIn[I]:= Random(100);
  end;

  // Test them

  StartTime:= TimeGetTime;
  if cbInverse.Checked then
  begin
    while TimeGetTime - StartTime < 1000 do
    begin
      dspFFT1.FFT;
      Inc(Result);
    end;
  end else
  begin
    while TimeGetTime - StartTime < 1000 do
    begin
      dspFFT1.IFFT;
      Inc(Result);
    end;
  end;
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  Application.Title:= 'DSPLab - ' + Caption;
  cbFilterKind.ItemIndex:= 0;
  cbFilterResponse.ItemIndex:= 0;
  cbFFTSize.ItemIndex:= 3;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -