开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMFIR.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：53k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMFIR.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 09.09.98 - 12:05:10 $                                        =}
  24. {========================================================================}
  25. unit MMFIR;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.     Windows,
  34. {$ELSE}
  35.     WinTypes,
  36.     WinProcs,
  37. {$ENDIF}
  38.     SysUtils,
  39.     Messages,
  40.     Classes,
  41.     Graphics,
  42.     Controls,
  43.     Forms,
  44.     Dialogs,
  45.     ExtCtrls,
  46.     Menus,
  47.     MMSystem,
  48.     MMObj,
  49.     MMDSPObj,
  50.     MMObjLst,
  51.     MMRegs,
  52.     MMPCMSup,
  53.     MMWaveIO,
  54.     MMUtils,
  55.     MMMuldiv,
  56.     MMMath,
  57.     MMFFT,
  58.     MMSpectr,
  59.     MMFIRFlt;
  61. const
  62.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAXFREQS} {$ENDIF}
  63.     MAXFREQS = 256;
  64.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAXTAPS} {$ENDIF}
  65.     MAXTAPS  = 400;
  67. const
  68.     {$IFDEF CBUILDER3} {$EXTERNALSYM defEnabled} {$ENDIF}
  69.     defEnabled      = True;
  70.     {$IFDEF CBUILDER3} {$EXTERNALSYM defColor} {$ENDIF}
  71.     defColor        = clWhite;
  72.     {$IFDEF CBUILDER3} {$EXTERNALSYM defGridColor} {$ENDIF}
  73.     defGridColor    = clGray;
  74.     {$IFDEF CBUILDER3} {$EXTERNALSYM defAxisColor} {$ENDIF}
  75.     defAxisColor    = clBlack;
  76.     {$IFDEF CBUILDER3} {$EXTERNALSYM defRespColor} {$ENDIF}
  77.     defRespColor    = clRed;
  78.     {$IFDEF CBUILDER3} {$EXTERNALSYM defCoeffColor} {$ENDIF}
  79.     defCoeffColor   = clBlue;
  80.     {$IFDEF CBUILDER3} {$EXTERNALSYM defScaleColor} {$ENDIF}
  81.     defScaleColor   = clBlack;
  82.     {$IFDEF CBUILDER3} {$EXTERNALSYM defDBScale} {$ENDIF}
  83.     defDBScale      = True;
  84.     {$IFDEF CBUILDER3} {$EXTERNALSYM defNormalized} {$ENDIF}
  85.     defNormalized   = False;
  86.     {$IFDEF CBUILDER3} {$EXTERNALSYM defShowCoeffs} {$ENDIF}
  87.     defShowCoeffs   = False;
  88.     {$IFDEF CBUILDER3} {$EXTERNALSYM defChannel} {$ENDIF}
  89.     defChannel      = chBoth;
  90.     {$IFDEF CBUILDER3} {$EXTERNALSYM defOrder} {$ENDIF}
  91.     defOrder        = 21;
  92.     {$IFDEF CBUILDER3} {$EXTERNALSYM defRate} {$ENDIF}
  93.     defRate         = 4000;
  94.     {$IFDEF CBUILDER3} {$EXTERNALSYM defWindow} {$ENDIF}
  95.     defWindow       = fwHamming;
  96.     {$IFDEF CBUILDER3} {$EXTERNALSYM defWidth} {$ENDIF}
  97.     defWidth        = 300;
  98.     {$IFDEF CBUILDER3} {$EXTERNALSYM defHeight} {$ENDIF}
  99.     defHeight       = 300;
  101. type
  102.     TMMFIRFilter    = class;
  103.     TMMFIRResponse  = class;
  104.     EMMFIRError     = class(Exception);
  106.     {-- TMMFIRFilterItem ------------------------------------------------------}
  107.     TMMFIRFilterItem = class(TObject)
  108.     private
  109.        Ff1      : Float;
  110.        FGain    : Float;
  111.        FOnChange: TNotifyEvent;
  113.        procedure SetValue(index: integer; aValue: Float);
  115.        procedure Store(S: TStream); virtual;
  116.        procedure Load(S: TStream); virtual;
  118.     protected
  119.        procedure Changed; virtual;
  121.     public
  122.        constructor Create;
  123.        constructor CreateEx(af1,aGain: Float);
  125.        procedure Assign(Source: TObject);
  127.        procedure SetParams(af1, aGain: Float);
  129.        property OnChange: TNotifyEvent read FOnChange write FOnChange;
  131.        property f1: Float index 0 read Ff1 write SetValue;
  132.        property Gain: Float index 1 read FGain write SetValue;
  133.     end;
  135.     {-- TMMFIRFilterList ------------------------------------------------------}
  136.     TMMFIRFilterList = class(TObjectList)
  137.     private
  138.        FFIRFilter: TMMFIRFilter;
  140.        procedure SetFilter(Index: integer; Filter: TMMFIRFilterItem);
  141.        function  GetFilter(Index: integer): TMMFIRFilterItem;
  143.     protected
  144.        procedure DefineProperties(Filer: TFiler); override;
  145.        procedure ReadData(S: TStream); override;
  146.        procedure WriteData(S: TStream); override;
  148.     public
  149.        function  AddObject(Item: TObject): TOLSize; override;
  150.        procedure Sort;
  152.        procedure Assign(Source: TPersistent); override;
  153.        property  Items[Index: integer]: TMMFIRFilterItem read GetFilter write SetFilter; default;
  154.     end;
  156.     {-- TMMFIRFilter ----------------------------------------------------------}
  157.     TMMFIRFilter    = class(TMMDSPComponent)
  158.     private
  159.        FOpen          : Boolean;
  160.        FEnabled       : Boolean;
  161.        FUpdating      : Boolean;
  162.        FDescription   : String;
  163.        Fncoeffs       : integer;
  164.        Fcoeffs        : array[0..MAXTAPS-1] of Float;
  165.        Ffs            : Longint;
  166.        FFilters       : TMMFIRFilterList;
  167.        FWindow        : TMMFFTWindow;
  168.        FCleanup       : Longint;
  169.        FPFIR          : PFIRFilter;
  170.        FPTempFIR      : PFIRFilter;
  171.        FChannel       : TMMChannel;
  172.        FTempBuffer    : PChar;
  174.        FResponse      : TMMFIRResponse;
  175.        FSpectrum      : TMMSpectrum;
  177.        FOnChange      : TNotifyEvent;
  178.        FOnPcmOverflow : TNotifyEvent;
  180.        procedure SetWindow(aValue: TMMFFTWindow);
  181.        procedure SetChannel(aValue: TMMChannel);
  182.        procedure SetSampleRate(aValue: Longint);
  183.        procedure SetNCoeffs(aValue: integer);
  184.        procedure SetDescription(aValue: String);
  185.        procedure SetFilters(aValue: TMMFIRFilterList);
  186.        procedure SetResponse(aValue: TMMFIRResponse);
  187.        procedure SetSpectrum(aValue: TMMSpectrum);
  188.        procedure NotifyResponse(Operation: TOperation);
  189.        procedure NotifySpectrum;
  190.        procedure SpectrumNeedData(Sender: TObject);
  191.        procedure FiltersChanged(Sender: TObject);
  192.        procedure FilterChanged(Sender: TObject);
  193.        procedure UpdateTempFilter(Init: Boolean);
  195.        procedure CalcFilter;
  196.        procedure UpdateFilter;
  198.     protected
  199.        procedure Change; virtual;
  200.        procedure Loaded; override;
  201.        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  202.        procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
  203.        procedure Assign(Source: TPersistent); override;
  205.        procedure Opened; override;
  206.        procedure Started; override;
  207.        procedure Closed; override;
  209.        procedure PcmOverflow; dynamic;
  210.        procedure BufferReady(lpwh: PWaveHdr); override;
  211.        procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
  213.     public
  214.        constructor Create(aOwner: TComponent); override;
  215.        destructor  Destroy; override;
  217.        procedure  Open;
  218.        procedure  Start;
  219.        procedure  Close;
  220.        procedure  Process(Buffer: PChar; nBytes: Longint);
  221.        function   CleanUp(Buffer: PChar; Length: integer): Longint;
  223.        procedure  SetCoeffs(pCoeffs: PFloatArray; nCoeffs: integer);
  224.        function   GetCoeffs: PFloatArray;
  226.        function   LoadCoeffs(FName: TFileName): Boolean;
  227.        function   SaveCoeffs(FName: TFileName): Boolean;
  229.        procedure  SaveToIniFile(IniFile: TFileName; Section: string);
  230.        procedure  ReadFromIniFile(IniFile: TFileName; Section: string);
  232.     published
  233.        property OnChange: TNotifyEvent read FOnChange write FOnChange;
  234.        property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  236.        property Input;
  237.        property Output;
  238.        property Enabled: Boolean read FEnabled write FEnabled default defEnabled;
  239.        property SampleRate: Longint read Ffs write SetSampleRate default defRate;
  240.        property Order: integer read FnCoeffs write SetNCoeffs default defOrder;
  241.        property Description: String read FDescription write SetDescription stored False;
  242.        property Filters: TMMFIRFilterList read FFilters write SetFilters;
  243.        property Response: TMMFIRResponse read FResponse write SetResponse;
  244.        property Spectrum: TMMSpectrum read FSpectrum write SetSpectrum;
  245.        property Channel: TMMChannel read FChannel write SetChannel default defChannel;
  246.        property Window: TMMFFTWindow read FWindow write SetWindow default defWindow;
  247.     end;
  249.     {-- TMMFIRResponse --------------------------------------------------------}
  250.     TMMFIRResponse = class(TMMGraphicControl)
  251.     private
  252.        FClient    : TRect;
  253.        FDBScale   : Boolean;
  254.        FNormalized: Boolean;
  255.        FShowCoeffs: Boolean;
  256.        FGridColor : TColor;
  257.        FAxisColor : TColor;
  258.        FRespColor : TColor;
  259.        FCoeffColor: TColor;
  260.        FScaleColor: TColor;
  262.        FnCoeffs   : integer;
  263.        FCoeffs    : array[0..MAXTAPS-1] of Float;
  264.        Ffs        : Longint;
  266.        procedure SetColors(index: integer; aValue: TColor);
  267.        procedure SetBoolean(index: integer; aValue: Boolean);
  268.        procedure SetSampleRate(aValue: Longint);
  270.        procedure AdjustClientSize;
  271.        procedure VLineDoted(aCanvas: TCanvas; x, y1, y2: integer; Clr: TColorRef);
  272.        procedure HLineDoted(aCanvas: TCanvas; x1, x2, y: integer; Clr: TColorRef);
  273.        procedure DrawBackground(Canvas: TCanvas; Client: TRect);
  274.        procedure DrawImpulseResponse(Canvas: TCanvas; Client: TRect);
  276.     protected
  277.        procedure   Paint; override;
  278.        procedure   Changed; override;
  279.        procedure   SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  281.     public
  282.        constructor Create(aOwner: TComponent); override;
  283.        destructor  Destroy; override;
  285.        procedure SetCoeffs(pCoeffs: PFloatArray; nCoeffs: integer);
  287.     published
  288.        property Color default defColor;
  289.        property ParentColor;
  290.        property Align;
  291.        property Bevel;
  292.        property Font;
  293.        property ParentFont;
  294.        property Visible;
  296.        property Width default defWidth;
  297.        property Height default defHeight;
  299.        property GridColor: TColor index 0 read FGridColor write SetColors default defGridColor;
  300.        property AxisColor: TColor index 1 read FAxisColor write SetColors default defAxisColor;
  301.        property ResponseColor: TColor index 2 read FRespColor write SetColors default defRespColor;
  302.        property CoeffColor: TColor index 3 read FCoeffColor write SetColors default defCoeffColor;
  303.        property ScaleColor: TColor index 4 read FScaleColor write SetColors default defScaleColor;
  304.        property ShowCoeffs: Boolean index 0 read FShowCoeffs write SetBoolean default defShowCoeffs;
  305.        property DBScale: Boolean index 1 read FDBScale write SetBoolean default defDBScale;
  306.        property Normalized: Boolean index 2 read FNormalized write SetBoolean default defNormalized;
  307.        property SampleRate: Longint read Ffs write SetSampleRate default defRate;
  308.     end;
  310. {-- Coeff generation and response --}
  311. type
  312.     TMMFIRFunction  = (ffLowPass,ffHighPass,ffBandPass,ffBandStop);
  314.     PMMFilterPoint  = ^TMMFilterPoint;
  315.     TMMFilterPoint  = record
  316.        Freq: Float;
  317.        Amp : Float;
  318.     end;
  320.     PMMFilterPoints = ^TMMFilterPoints;
  321.     TMMFilterPoints = array[0..0] of TMMFilterPoint;
  323. procedure FIR_Coeffs(FIRType: TMMFIRFunction; SRate: integer;
  324.                      f1,f2: Float; N: integer; hh: PFloatArray);
  325. procedure FIR_CoeffsEx(Points: PMMFilterPoints; nPoints, SRate, N: integer;
  326.                        hh: PFloatArray);
  327. procedure FIR_Window(Window: TMMFFTWindow; N: integer; hh: PFloatArray);
  328. procedure FIR_Response (FirType,N: integer; hh: PFloatArray; dBScale: Boolean;
  329.        numPoints: integer; points: PFloatArray);
  330. procedure FIR_NormaliseResponse(dbscale: Boolean; NumPoints: integer; points: PFloatArray);
  332. {$O-}
  334. implementation
  336. uses IniFiles;
  338. const
  339.    STREAMKENNUNG : Longint = $00524946; { 'FIR ' }
  341. {==============================================================================}
  342. { note: delay occurs by ~ncoeff/2 samples                                      }
  343. {==============================================================================}
  344. procedure FIR_Filter(pcoeffs: PFloatArray; ncoeffs: integer;
  345.                      DLine: PLongArray; Data: PSmallArray; samples: integer);
  346. var
  347.    i,j,ki: integer;
  348.    y: Float;
  349.    idx: integer;
  350.    mask: integer;
  352. begin
  353.    mask := MAXTAPS-1;
  354.    idx := MAXTAPS-nCoeffs;
  356.    for i := 0 to samples-1 do
  357.    begin
  358.       ki := idx;
  359.       DLine[idx] := Data[i];
  360.       idx := (idx+1) and mask;
  362.       y := 0.0;
  363.       for j := 0 to ncoeffs-1 do
  364.       begin
  365.          ki := (ki-1) and mask;
  366.         y := y + DLine[ki] * pcoeffs[j];
  367.       end;
  368.       Data[i] := MinMax(Trunc(y),-32767,32767);
  369.    end;
  370. end;
  372. {==============================================================================}
  373. { interpolate to a y_value for a x_val using a table of points for x and y     }
  374. { returns the y_val or FALSE if error, extrapolates if x_val is outside data   }
  375. function FIR_Interpolate(ind_x, dep_y: PFloatArray; nPnts: integer;
  376.                          x_val: Float; var y_val: Float): Boolean;
  378. var
  379.    i: integer;
  380.    xrange: Float;
  382. begin
  383.    Result := False;
  385.    if (nPnts <= 0) then exit;
  387.    if (nPnts = 1) then
  388.    begin
  389.       y_val := dep_y[0];
  390.       Result := True;
  391.       exit;
  392.    end;
  394.    i := 0;
  395.    while (i < nPnts) and (x_val > ind_x[i]) do inc(i); // get to pair
  397.    if (i = nPnts) then                                 // extrapolate at end
  398.    begin
  399.       dec(i);
  400.       xrange := ind_x[i] - ind_x[i-1];
  401.       if (xrange = 0) then exit;
  403.       y_val := dep_y[i]+(x_val-ind_x[i])*(dep_y[i]-dep_y[i-1])/xrange;
  404.       Result := True;
  405.       exit;
  406.    end;
  408.    if (x_val = ind_x[i]) then
  409.    begin
  410.       y_val := dep_y[i];
  411.       Result := True;
  412.       exit;
  413.    end;
  415.    if (i = 0) then                                  // extrapolate at begining
  416.    begin
  417.       xrange := ind_x[i+1] - ind_x[i];
  418.       if (xrange = 0) then exit;
  420.       y_val := dep_y[i] - (ind_x[i]-x_val)*(dep_y[i+1]-dep_y[i]) /xrange;
  421.       Result := True;
  422.       exit;
  423.    end;
  425.    xrange := ind_x[i] - ind_x[i-1];
  426.    if (xrange = 0) then exit;
  428.    y_val :=  dep_y[i-1]+(x_val-ind_x[i-1])*(dep_y[i]-dep_y[i-1])/xrange;
  429.    Result := True;
  430. end;
  432. {==============================================================================}
  433. procedure FIR_CoeffsEx(Points: PMMFilterPoints; nPoints, SRate,
  434.                        N: integer; hh: PFloatArray);
  435. var
  436.    xt, q: Float;
  437.    m, i, j: integer;
  438.    freq,amp,dnpi: array [0..MAXFREQS-1] of Float;
  439.    a: array [0..MAXTAPS-1] of Float;
  441. begin
  443.    if (nPoints > MAXFREQS) then nPoints := MAXFREQS;
  445.    for i := 0 to nPoints-1 do
  446.    begin
  447.       freq[i] := Points[i].Freq/SRate;
  448.       amp[i]  := pow(10.0,Points[i].Amp/20.0);
  449.    end;
  451.    m := (N + 1) div 2;
  452.    q := 2 * M_PI / N;
  454.    for i := 0 to nPoints-1 do           // find positions of freqs in window
  455.    begin
  456.       dnpi[i] := N * freq[i] + 1.0;
  457.       if (dnpi[i] < 0) then dnpi[i] := 0;
  458.       if (dnpi[i] > N) then dnpi[i] := N;
  459.    end;
  461.    // set a[] array to the amp[] vals at each npi[] position
  463.    for j := 0 to m do
  464.    begin
  465.       FIR_Interpolate(@dnpi,@amp,nPoints,j,a[j]);
  466.    end;
  468.    for i := 1 to m do  // Calculate the coefficient array
  469.    begin
  470.       xt := a[1] / 2.0;
  471.       for j := 2 to m do
  472.           xt := xt + a[j] * cos(q*((m-i)*(j-1)));
  473.       hh[i-1] := 2.0 * xt / N;
  474.    end;
  476.    for i := m+1 to n do   // copy first n/2 coeff into last n/2 coeff
  477.        hh[i-1] := hh[2*m-i-1];
  478. end;
  480. {==============================================================================}
  481. procedure FIR_Coeffs(FIRType: TMMFIRFunction; SRate: integer; f1,f2: Float;
  482.                      N: integer; hh: PFloatArray);
  483. var
  484.    k: integer;
  485.    mm,a: Float;
  486.    fg,fg2: Float;
  488. begin
  489.    case FIRType of
  490.         ffLowpass:
  491.         begin
  492.            fg := f1/SRate;
  493.            { build lowpass }
  494.            for k := 0 to N-1 do
  495.            begin
  496.               mm := k-(N-1)/2.0;
  497.               if (mm = 0) then
  498.                   hh[k] := (fg*2*M_PI)/M_PI
  499.               else
  500.                   hh[k] := sin(mm*fg*2*M_PI)/(mm*M_PI);
  501.            end;
  502.         end;
  503.         ffHighpass:
  504.         begin
  505.            fg := f1/SRate;
  506.            { subtract a low pass from allpass }
  507.            for k := 0 to N-1 do
  508.            begin
  509.               { simulate a allpass }
  510.               if k = N div 2 then
  511.                  a := 1.0
  512.               else
  513.                  a := 0.0;
  514.               { the lowpass }
  515.               mm := k-(N-1)/2.0;
  516.               if (mm = 0) then
  517.                   hh[k] := a-((fg*2*M_PI)/M_PI)
  518.               else
  519.                   hh[k] := a-(sin(mm*fg*2*M_PI)/(mm*M_PI));
  520.            end;
  521.         end;
  522.         ffBandpass:
  523.         begin
  524.            fg := f1/SRate;
  525.            fg2 := f2/SRate;
  526.            { subtract a low pass from a low pass }
  527.            for k := 0 to N-1 do
  528.            begin
  529.               mm := k-(N-1)/2.0;
  530.               if (mm = 0) then
  531.                   hh[k] := ((fg2*2*M_PI)/M_PI)-((fg*2*M_PI)/M_PI)
  532.               else
  533.                   hh[k] := (sin(mm*fg2*2*M_PI)/(mm*M_PI))-(sin(mm*fg*2*M_PI)/(mm*M_PI));
  534.            end;
  535.         end;
  536.         ffBandstop:
  537.         begin
  538.            fg := f1/SRate;
  539.            fg2:= f2/SRate;
  540.            { build a bandpass and subtract it from a allpass }
  541.            for k := 0 to N-1 do
  542.            begin
  543.               { simulate a allpass }
  544.               if k = N div 2 then
  545.                  a := 1.0
  546.               else
  547.                  a := 0.0;
  549.               mm := k-(N-1)/2.0;
  550.               if (mm = 0) then
  551.                   hh[k] := a-((fg2*2*M_PI)/M_PI)-((fg*2*M_PI)/M_PI)
  552.               else
  553.                   hh[k] := a-(sin(mm*fg2*2*M_PI)/(mm*M_PI))-(sin(mm*fg*2*M_PI)/(mm*M_PI));
  554.            end;
  555.         end;
  556.    end;
  557. end;
  559. {==============================================================================}
  560. procedure FIR_Window(Window: TMMFFTWindow; N: integer; hh: PFloatArray);
  561. const
  562.    alpha = 5.0;   { Gaussian window parameter }
  563. var
  564.    i,N2: integer;
  566.    function CalcWindow(idx: integer): Float;
  567.    begin
  568.       case ord(Window) of
  569.               { Hamming }
  570.    1: Result := 0.54+0.46*cos(2*M_PI*idx/N);
  571.               { Hanning }
  572.            2: Result := 0.5+0.5*cos(2*M_PI*idx/N);
  573.               { Blackman }
  574.            3: Result := 0.42+0.5*cos(2*M_PI*idx/N)+0.08*cos(4*M_PI*idx/N);
  575.       { Gaussian }
  576.            4: Result := exp( -alpha/(N*N) * (2*(N2-idx)-N)*(2*(N2-idx)-N)   );
  577.               { Welch }
  578.            5: Result := ((2*idx-N)/N)*((2*idx-N)/(N+1));
  579.               { Parzen }
  580.            6: Result := abs((2*idx-N)/(N+1));
  581.               { Rectangular }
  582.            else Result := 1;
  583.       end;
  584.    end;
  586. begin
  587.    N2 := N div 2;
  588.    for i := 0 to N2 do
  589.    begin
  590.       hh[N2+i] := hh[N2+i] * CalcWindow(i);
  591.       hh[N2-i] := hh[N2+i];
  592.    end;
  593. end;
  595. {==============================================================================}
  596. procedure FIR_Response(FirType,N:integer; hh: PFloatArray; dBScale: Boolean;
  597.        numPoints: integer; points: PFloatArray);
  598. var
  599.    index, L, i: integer;
  600.    lambda, work: Float;
  602. begin
  603.    for L := 0 to NumPoints-1 do
  604.    begin
  605.       lambda := L*PI/NumPoints;
  606.       case FirType of
  607.    1: begin
  608.              work := hh[(N-1)div 2];
  609.  for i := 1 to ((N-1)div 2) do
  610.  begin
  611.     index := (N-1)div 2-i;
  612.     work := work+2.0*hh[index]*cos(i*lambda);
  613.                  end;
  614.               end;
  615.    2: begin
  616.                  work := 0;
  617.          for i := 1 to (N div 2) do
  618.  begin
  619.     index := N div 2-i;
  620.     work := work+2.0*hh[index]*cos((i-0.05)*lambda);
  621.                  end;
  622.               end;
  623.       end;
  624.       if dbscale then
  625.          points[L] := 20.0*log10(abs(work))
  626.       else
  627.         points[L] := abs(work);
  628.    end;
  629. end;
  631. {==============================================================================}
  632. procedure FIR_NormaliseResponse(dbscale: Boolean; NumPoints: integer; points: PFloatArray);
  633. var
  634.    i: integer;
  635.    biggest: Float;
  637. begin
  638.    if dbscale then
  639.    begin
  640.       biggest := -100.0;
  641.       for i := 0 to NumPoints-1 do
  642.           if (points[i] > biggest) then biggest := points[i];
  644.       for i := 0 to NumPoints-1 do
  645.           points[i] := ((points[i]-biggest)/100)+1;
  646.    end
  647.    else
  648.    begin
  649.       biggest := 0.0;
  650.       for i := 0 to NumPoints-1 do
  651.   if (points[i] > biggest) then biggest := points[i];
  653.       for i := 0 to NumPoints-1 do
  654.   points[i] := points[i]/biggest;
  655.    end;
  656. end;
  658. {== TMMFIRFilterItem ==========================================================}
  659. constructor TMMFIRFilterItem.Create;
  660. begin
  661.    inherited Create;
  663.    Ff1 := 0;
  664.    FGain := 0;
  665.    FOnChange := nil;
  666. end;
  668. {-- TMMFIRFilterItem ----------------------------------------------------------}
  669. constructor TMMFIRFilterItem.CreateEx(af1,aGain: Float);
  670. begin
  671.    inherited Create;
  673.    Ff1       := af1;
  674.    FGain     := aGain;
  675.    FOnChange := nil;
  676. end;
  678. {-- TMMFIRFilterItem ----------------------------------------------------------}
  679. procedure TMMFIRFilterItem.Changed;
  680. begin
  681.    if assigned(FOnChange) then FOnChange(Self);
  682. end;
  684. {-- TMMFIRFilterItem ----------------------------------------------------------}
  685. procedure TMMFIRFilterItem.SetParams(af1, aGain: Float);
  686. begin
  687.    if (af1 <> Ff1) or (aGain <> FGain) then
  688.    begin
  689.       Ff1 := af1;
  690.       FGain := aGain;
  691.       Changed;
  692.    end;
  693. end;
  695. {-- TMMFIRFilterItem ----------------------------------------------------------}
  696. procedure TMMFIRFilterItem.SetValue(index: integer; aValue: Float);
  697. var
  698.    af1,aGain: Float;
  700. begin
  701.    af1 := Ff1;
  702.    aGain := FGain;
  703.    case index of
  704.        0: af1 := aValue;
  705.        1: aGain := aValue;
  706.    end;
  707.    SetParams(af1, aGain);
  708. end;
  710. {-- TMMFIRFilterItem ----------------------------------------------------------}
  711. procedure TMMFIRFilterItem.Store(S: TStream);
  712. begin
  713.    S.WriteBuffer(Ff1,SizeOf(Ff1));
  714.    S.WriteBuffer(FGain,SizeOf(FGain));
  715. end;
  717. {-- TMMFIRFilterItem ----------------------------------------------------------}
  718. procedure TMMFIRFilterItem.Load(S: TStream);
  719. var
  720.    af1,aGain: Float;
  722. begin
  723.    S.ReadBuffer(af1,SizeOf(af1));
  724.    S.ReadBuffer(aGain,SizeOf(aGain));
  725.    SetParams(af1,aGain);
  726. end;
  728. {-- TMMFIRFilterItem ----------------------------------------------------------}
  729. procedure TMMFIRFilterItem.Assign(Source: TObject);
  730. begin
  731.    if Source is TMMFIRFilterItem then
  732.    begin
  733.       SetParams(TMMFIRFilterItem(Source).f1,
  734.                 TMMFIRFilterItem(Source).Gain);
  735.    end;
  736. end;
  738. {-- TMMFIRFilterList ----------------------------------------------------------}
  739. procedure TMMFIRFilterList.Sort;
  740. var
  741.    i,j,h: integer;
  742.    flt: TMMFIRFilterItem;
  744. begin          { Start Shell-Sort }
  745.    h := 1;
  746.    while h <= Count div 9 do h := h*3 + 1;
  747.    while h > 0 do
  748.    begin
  749.       for i := h to Count-1 do
  750.       begin
  751.          flt := Items[i];
  752.          j := i;
  753.          while (j >= h) and (Items[j-h].f1 > flt.f1) do
  754.          begin
  755.             Items[j] := Items[j-h];
  756.             dec(j, h);
  757.          end;
  758.          Items[j] := flt;
  759.       end;
  760.       h := h div 3;
  761.    end;
  762. end;
  764. {-- TMMFIRFilterList ----------------------------------------------------------}
  765. procedure TMMFIRFilterList.SetFilter(Index: integer; Filter: TMMFIRFilterItem);
  766. begin
  767.    Put(Index, Filter);
  768. end;
  770. {-- TMMFIRFilterList ----------------------------------------------------------}
  771. function TMMFIRFilterList.GetFilter(Index: integer): TMMFIRFilterItem;
  772. begin
  773.    Result := TMMFIRFilterItem(Get(Index));
  774. end;
  776. {-- TMMFIRFilterList ----------------------------------------------------------}
  777. function TMMFIRFilterList.AddObject(Item: TObject): TOLSize;
  778. begin
  779.    Result := inherited AddObject(Item);
  780.    (Item as TMMFIRFilterItem).OnChange := FFIRFilter.FilterChanged;
  781. end;
  783. {-- TMMFIRFilterList ----------------------------------------------------------}
  784. procedure TMMFIRFilterList.Assign(Source: TPersistent);
  785. var
  786.    i: integer;
  787.    Filter: TMMFIRFilterItem;
  789. begin
  790.    if (Source is TMMFIRFilterList) or (Source = nil) then
  791.    begin
  792.       BeginUpdate;
  793.       try
  794.          if (FFIRFilter <> nil) then
  795.              FFIRFilter.FUpdating := True;
  797.          FreeAll;
  798.          if (Source <> nil) then
  799.          begin
  800.             for i := 0 to TMMFIRFilterList(Source).Count-1 do
  801.             begin
  802.                Filter := TMMFIRFilterItem.Create;
  803.                Filter.Assign(TMMFIRFilterList(Source)[i]);
  804.                AddObject(Filter);
  805.             end;
  806.          end;
  808.       finally
  809.          if (FFIRFilter <> nil) then
  810.              FFIRFilter.FUpdating := False;
  812.          EndUpdate;
  813.       end;
  814.    end
  815.    else inherited assign(Source);
  816. end;
  818. {-- TMMFIRFilterList ----------------------------------------------------------}
  819. procedure TMMFIRFilterList.DefineProperties(Filer: TFiler);
  820. begin
  821.    Filer.DefineBinaryProperty('ObjectContainer', ReadData, WriteData, True);
  822. end;
  824. {-- TMMFIRFilterList ----------------------------------------------------------}
  825. procedure TMMFIRFilterList.ReadData(S: TStream);
  826. Var
  827.    pBuf: PChar;
  828.    Kennung: Longint;
  829.    ObjCount,
  830.    Index: TOLSize;
  831.    Destroy: Boolean;
  832.    Value: Longint;
  834. begin
  835.    BeginUpdate;
  836.    try
  837.       FFIRFilter.FUpdating := True;
  838.       S.ReadBuffer(Kennung,sizeOf(STREAMKENNUNG));
  839.       if (Kennung <> STREAMKENNUNG) then
  840.          raise EStreamError.Create('Invalid Object stream');
  842.       FreeAll;
  844.       { load stream items }
  845.       S.ReadBuffer(Destroy,SizeOf(Destroy));
  846.       DestroyObjects := Destroy;
  848.       { read string length }
  849.       S.ReadBuffer(Value,SizeOf(Value));
  850.       if Value > 0 then
  851.       begin
  852.          pBuf := StrAlloc(Value+1);
  853.          try
  854.             FillChar(pBuf^, Value+1, 0);
  855.             S.ReadBuffer(pBuf^, Value);
  856.             FFIRFilter.Description := StrPas(pBuf);
  857.          finally
  858.             StrDispose(pBuf);
  859.          end;
  860.       end;
  862.       S.ReadBuffer(ObjCount,SizeOf(Objcount));  { Read in Object count }
  863.       if Capacity-Count < ObjCount then Capacity := Count+ObjCount;
  865.       { Read in Object Count }
  866.       for Index := 0 to ObjCount-1 do
  867.           AddObject(ReadObjectFromStream(S));
  869.    finally
  870.       FFIRFilter.FUpdating := False;
  871.       EndUpdate;
  872.    end;
  873. end;
  875. {-- TMMFIRFilterList ----------------------------------------------------------}
  876. procedure TMMFIRFilterList.WriteData(S: TStream);
  877. var
  878.    Index,ObjCount: TOlSize;
  879.    Destroy: Boolean;
  880.    Value: Longint;
  882. begin
  883.    { Write list to Stream }
  884.    S.WriteBuffer(STREAMKENNUNG,SizeOf(STREAMKENNUNG));
  885.    Destroy := DestroyObjects;
  886.    S.WriteBuffer(Destroy,SizeOf(Destroy));
  888.    { write string length }
  889.    Value := Length(FFIRFilter.FDescription);
  890.    S.WriteBuffer(Value, SizeOf(Value));
  891.    S.WriteBuffer(PChar(FFIRFilter.FDescription)^, Length(FFIRFilter.FDescription));
  893.    ObjCount := Count;
  894.    S.WriteBuffer(ObjCount,SizeOf(ObjCount));
  895.    for Index := 0 to Count-1 do
  896.        WriteObjectToStream(Items[Index],S);
  897. end;
  899. {== TMMFIRFilter ==============================================================}
  900. constructor TMMFIRFilter.Create(aOwner: TComponent);
  901. begin
  902.    inherited Create(aOwner);
  904.    FFilters := TMMFIRFilterList.Create;
  905.    FFilters.OnChange := FiltersChanged;
  906.    FFilters.FFIRFilter := Self;
  908.    FOpen       := False;
  909.    FEnabled    := defEnabled;
  910.    FPFIR       := nil;
  911.    FPTempFIR   := nil;
  913.    FUpdating   := False;
  914.    FDescription:= 'Untitled';
  915.    Ffs         := defRate;
  916.    FWindow     := defWindow;
  917.    fnCoeffs    := defOrder;
  918.    FChannel    := defChannel;
  919.    FUpdating   := False;
  920.    FResponse   := nil;
  921.    FSpectrum   := nil;
  922.    FTempBuffer := nil;
  924.    CalcFilter;
  926.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  927.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  928. end;
  930. {-- TMMFIRFilter --------------------------------------------------------------}
  931. destructor TMMFIRFilter.Destroy;
  932. begin
  933.    Close;
  935.    SetResponse(nil);
  936.    SetSpectrum(nil);
  938.    FFilters.Free;
  940.    inherited
  941. end;
  943. {-- TMMFIRFilter --------------------------------------------------------------}
  944. procedure TMMFIRFilter.Notification(aComponent: TComponent; Operation: TOperation);
  945. begin
  946.    inherited Notification(aComponent, Operation);
  948.    if (Operation = opRemove) then
  949.    begin
  950.       if (aComponent = FResponse) then
  951.           FResponse := nil;
  953.       if (aComponent = FSpectrum) then
  954.           FSpectrum := nil;
  955.    end;
  956. end;
  958. {-- TMMFIRFilter --------------------------------------------------------------}
  959. procedure TMMFIRFilter.PcmOverflow;
  960. begin
  961.    if assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
  962. end;
  964. {-- TMMFIRFilter --------------------------------------------------------------}
  965. procedure TMMFIRFilter.SetCoeffs(pCoeffs: PFloatArray; nCoeffs: integer);
  966. begin
  967.    if (pCoeffs <> nil) then
  968.    begin
  969.       if (nCoeffs > MAXTAPS) then
  970.           raise EMMFIRError.Create('Only '+IntToStr(MAXTAPS)+' are allowed');
  972. //      FFirFunc := ffUser;
  973.       FnCoeffs := nCoeffs;
  975.       GlobalMoveMem(pCoeffs^,FCoeffs,nCoeffs*sizeOf(Float));
  977.       Change;
  978.    end;
  979. end;
  981. {-- TMMFIRFilter --------------------------------------------------------------}
  982. function TMMFIRFilter.GetCoeffs: PFloatArray;
  983. begin
  984.    Result := @FCoeffs;
  985. end;
  987. {-- TMMFIRFilter --------------------------------------------------------------}
  988. function TMMFIRFilter.LoadCoeffs(FName: TFileName): Boolean;
  989. var
  990.    F: TextFile;
  991.    S: string;
  992.    nCoeffs,n: integer;
  993.    Coeffs: array[0..MAXTAPS-1] of Float;
  995. begin
  996.    Result := False;
  997.    if FileExists(FName) then
  998.    try
  999.    {$I-}
  1000.       AssignFile(F, FName);
  1001.       Reset(F);
  1002.       try
  1003.          { read the number of coeffs }
  1004.          ReadLn(F, S);
  1005.          nCoeffs := StrToInt(S);
  1006.          n := 0;
  1007.          while not EOF(F) do
  1008.          begin
  1009.             ReadLn(F,S);
  1010.             Coeffs[n] := StrToFloat(S);
  1011.             inc(n);
  1012.          end;
  1014.          if (n = nCoeffs) then
  1015.          begin
  1016.             SetCoeffs(@Coeffs,nCoeffs);
  1017.             Result := True;
  1018.          end;
  1020.       finally
  1021.          CloseFile(F);
  1022.       end;
  1024.    except
  1025.       ;
  1026.    end;
  1027.    {$I+}
  1028. end;
  1030. {-- TMMFIRFilter --------------------------------------------------------------}
  1031. function TMMFIRFilter.SaveCoeffs(FName: TFileName): Boolean;
  1032. var
  1033.    F: TextFile;
  1034.    n: integer;
  1036. begin
  1037.    Result := False;
  1038.    try
  1039.    {$I-}
  1040.       AssignFile(F, FName);
  1041.       Rewrite(F);
  1042.       try
  1043.          { write the number of coeffs }
  1044.          WriteLn(F, IntToStr(FnCoeffs));
  1045.          for n := 0 to FnCoeffs-1 do
  1046.          begin
  1047.             WriteLn(F,FloatToStr(FCoeffs[n]));
  1048.          end;
  1050.          Result := True;
  1052.       finally
  1053.          CloseFile(F);
  1054.       end;
  1056.    except
  1057.       ;
  1058.    end;
  1059.    {$I+}
  1060. end;
  1062. {-- TMMFIRFilter --------------------------------------------------------------}
  1063. procedure TMMFIRFilter.SaveToIniFile(IniFile: TFileName; Section: string);
  1064. var
  1065.    i: integer;
  1066. begin
  1067.    if (IniFile <> '') then
  1068.    begin
  1069.       with TIniFile.Create(IniFile) do
  1070.       try
  1071.          Section := 'FIR.'+Section;
  1072.          WriteInteger(Section, 'Order', Order);
  1073.          WriteInteger(Section, 'Window', Ord(Window));
  1075.          WriteInteger(Section, 'Filters', Filters.Count);
  1076.          for i := 0 to Filters.Count-1 do
  1077.          with Filters[i] do
  1078.          begin
  1079.             WriteString(Section, 'Filter'+IntToStr(i)+' f1', FloatToStr(f1));
  1080.             WriteString(Section, 'Filter'+IntToStr(i)+' Gain', FloatToStr(Gain));
  1081.          end;
  1083.       finally
  1084.          Free;
  1085.       end;
  1086.    end;
  1087. end;
  1089. {-- TMMFIRFilter --------------------------------------------------------------}
  1090. procedure TMMFIRFilter.ReadFromIniFile(IniFile: TFileName; Section: string);
  1091. var
  1092.    Cnt, i: integer;
  1093.    f1,Gain: Float;
  1095. begin
  1096.    if (IniFile <> '') then
  1097.    begin
  1098.       with TIniFile.Create(IniFile) do
  1099.       try
  1100.          Section := 'FIR.'+Section;
  1101.          i := ReadInteger(Section, 'Order', -1);
  1102.          if (i > 0) then
  1103.          begin
  1104.             Filters.BeginUpdate;
  1105.             try
  1106.                FUpdating := True;
  1108.                Filters.FreeAll;
  1110.                Order       := ReadInteger(Section, 'Order', defOrder);
  1111.                Window      := TMMFFTWindow(ReadInteger(Section, 'Window', Ord(defWindow)));
  1112.                Description := Section;
  1114.                Cnt := ReadInteger(Section, 'Filters', 0);
  1116.                for i := 0 to Cnt-1 do
  1117.                begin
  1118.                   f1   := StrToFloat(ReadString(Section, 'Filter'+IntToStr(i)+' f1', '0'));
  1119.                   Gain := StrToFloat(ReadString(Section, 'Filter'+IntToStr(i)+' Gain', '0'));
  1121.                   Filters.AddObject(TMMFIRFilterItem.CreateEx(f1,Gain));
  1122.                end;
  1124.             finally
  1125.                FUpdating := False;
  1126.                Filters.EndUpdate;
  1127.             end;
  1128.          end;
  1130.       finally
  1131.          Free;
  1132.       end;
  1133.    end;
  1134. end;
  1136. {-- TMMFIRFilter --------------------------------------------------------------}
  1137. procedure TMMFIRFilter.SetFilters(aValue: TMMFIRFilterList);
  1138. begin
  1139.    if (aValue <> FFilters) then FFilters.Assign(aValue);
  1140. end;
  1142. {-- TMMFIRFilter --------------------------------------------------------------}
  1143. procedure TMMFIRFilter.FilterChanged(Sender: TObject);
  1144. begin
  1145.    if not FUpdating then
  1146.    begin
  1147.       CalcFilter;
  1148.    end;
  1149. end;
  1151. {-- TMMFIRFilter --------------------------------------------------------------}
  1152. procedure TMMFIRFilter.FiltersChanged(Sender: TObject);
  1153. begin
  1154.    if not FUpdating then
  1155.    begin
  1156.       CalcFilter;
  1157.    end;
  1158. end;
  1160. {-- TMMFIRFilter --------------------------------------------------------------}
  1161. procedure TMMFIRFilter.SetDescription(aValue: String);
  1162. begin
  1163.    if (aValue <> FDescription) then
  1164.    begin
  1165.       FDescription := aValue;
  1166.    end;
  1167. end;
  1169. {-- TMMFIRFilter --------------------------------------------------------------}
  1170. Procedure TMMFIRFilter.SetChannel(aValue: TMMChannel);
  1171. begin
  1172.    if (aValue <> FChannel) then
  1173.    begin
  1174.       FChannel := aValue;
  1175.       UpdateFilter;
  1176.    end;
  1177. end;
  1179. {-- TMMFIRFilter --------------------------------------------------------------}
  1180. procedure TMMFIRFilter.SetSampleRate(aValue: Longint);
  1181. begin
  1182.    if (aValue <> Ffs) then
  1183.    begin
  1184.       Ffs := MinMax(aValue,4000,100000);
  1185.       UpdateTempFilter(True);
  1186.       CalcFilter;
  1187.    end;
  1188. end;
  1190. {-- TMMFIRFilter --------------------------------------------------------------}
  1191. procedure TMMFIRFilter.SetWindow(aValue: TMMFFTWindow);
  1192. begin
  1193.    if (aValue <> FWindow) then
  1194.    begin
  1195.       FWindow := aValue;
  1196.       CalcFilter;
  1197.    end;
  1198. end;
  1200. {-- TMMFIRFilter --------------------------------------------------------------}
  1201. procedure TMMFIRFilter.SetNCoeffs(aValue: integer);
  1202. begin
  1203.    if (aValue <> FnCoeffs) then
  1204.    begin
  1205.       if (aValue mod 2 = 0) then inc(aValue);
  1206.       FnCoeffs := MinMax(aValue,0,MAXTAPS-1);
  1207.       CalcFilter;
  1208.    end;
  1209. end;
  1211. {-- TMMFIRFilter --------------------------------------------------------------}
  1212. procedure TMMFIRFilter.SetResponse(aValue: TMMFIRResponse);
  1213. begin
  1214.    if Longint(Self) = Longint(aValue) then exit;
  1216.    if (aValue <> FResponse) then
  1217.    begin
  1218.       if (aValue = nil) then NotifyResponse(opRemove);
  1220.       FResponse := aValue;
  1222.       NotifyResponse(opInsert);
  1223.    end;
  1224. end;
  1226. {-- TMMFIRFilter --------------------------------------------------------------}
  1227. procedure TMMFIRFilter.NotifyResponse(Operation: TOperation);
  1228. begin
  1229.    if (FResponse = nil) or
  1230.       (csLoading in ComponentState) or
  1231.       (csReading in ComponentState) then exit;
  1233.    if (Operation = opInsert) then
  1234.    begin
  1235.       FResponse.SetCoeffs(@FCoeffs,FnCoeffs);
  1236.       FResponse.SampleRate := Ffs;
  1237.    end
  1238.    else
  1239.    begin
  1240.       FResponse.SetCoeffs(nil,0);
  1241.       FResponse.SampleRate := 0;
  1242.    end;
  1243. end;
  1245. {-- TMMFIRFilter --------------------------------------------------------------}
  1246. procedure TMMFIRFilter.UpdateTempFilter(Init: Boolean);
  1247. var
  1248.    wfx: TWaveFormatEx;
  1249. begin
  1250.    DoneFIRFilter(FPTempFIR);
  1251.    if Init and (FSpectrum <> nil) then
  1252.    begin
  1253.       pcmBuildWaveHeader(@wfx, 16, 1, Ffs);
  1254.       FPTempFIR := InitFIRFilter(@wfx);
  1255.       FSpectrum.PCMWaveFormat := PPCMWaveFormat(@wfx)^;
  1256.       NotifySpectrum;
  1257.    end;
  1258. end;
  1260. {-- TMMFIRFilter --------------------------------------------------------------}
  1261. procedure TMMFIRFilter.SetSpectrum(aValue: TMMSpectrum);
  1262. begin
  1263.    if Longint(Self) = Longint(aValue) then exit;
  1265.    if (aValue <> FSpectrum) then
  1266.    begin
  1267.       if (aValue = nil) then
  1268.       begin
  1269.          FSpectrum.OnNeedData := nil;
  1270.          NotifySpectrum;
  1271.          UpdateTempFilter(False);
  1272.       end;
  1274.       FSpectrum := aValue;
  1276.       if (FSpectrum <> nil) then
  1277.       begin
  1278.          UpdateTempFilter(True);
  1279.          FSpectrum.Window := fwRectangular;
  1280.          FSpectrum.OnNeedData := SpectrumNeedData;
  1281.          NotifySpectrum;
  1282.       end;
  1283.    end;
  1284. end;
  1286. {-- TMMFIRFilter --------------------------------------------------------------}
  1287. procedure TMMFIRFilter.NotifySpectrum;
  1288. begin
  1289.    if (FSpectrum = nil) or
  1290.       (csLoading in ComponentState) or
  1291.       (csReading in ComponentState) then exit;
  1293.    FSpectrum.ResetData;
  1294. end;
  1296. {-- TMMFIRFilter --------------------------------------------------------------}
  1297. procedure TMMFIRFilter.SpectrumNeedData(Sender: TObject);
  1298. var
  1299.    wfx: TWaveFormatEx;
  1300.    BufI,BufO: array[0..8192] of Smallint;
  1301. begin
  1302.    if (Sender <> nil) then
  1303.    with TMMSpectrum(Sender) do
  1304.    begin
  1305.       pcmBuildWaveHeader(@wfx, 16, 1, Ffs);
  1306.       PCMWaveFormat := PPCMWaveFormat(@wfx)^;
  1308.       ResetFIRFilter(FPTempFIR);
  1309.       SetFIRFilter(FPTempFir, @FCoeffs, FnCoeffs, 0);
  1310.       
  1311.       GlobalFillMem(BufI,sizeOf(BufI),0);
  1312.       BufI[0] := 21500;
  1313.      
  1314.       DoFIRFilterShort(FPTempFir, @BufI, @BufO, BytesPerSpectrum);
  1315.       RefreshPCMData(@BufO);
  1316.    end;
  1317. end;
  1319. {-- TMMFIRFilter --------------------------------------------------------------}
  1320. procedure TMMFIRFilter.CalcFilter;
  1321. var
  1322.    i,Cnt: integer;
  1323.    Pts: array[0..MAXFREQS-1] of TMMFilterPoint;
  1325. begin
  1326.    if not (csLoading in ComponentState) and
  1327.       not (csReading in ComponentState) then
  1328.    begin
  1329.       Filters.Sort;
  1330.       
  1331.       Cnt := Filters.Count;
  1332.       for i := 0 to Cnt-1 do
  1333.       with Filters[i] do
  1334.       begin
  1335.          Pts[i].Freq := Ff1;
  1336.          Pts[i].Amp  := FGain;
  1337.       end;
  1339.       { make sure we have at least two valid points }
  1340.       if (Cnt = 0) then
  1341.       begin
  1342.          Pts[0].Freq := 0;
  1343.          Pts[0].Amp  := 0;
  1344.          inc(Cnt);
  1345.       end;
  1347.       if (Cnt = 1) then
  1348.       begin
  1349.          Pts[1].Freq := Ffs/2;
  1350.          Pts[1].Amp  := 0;
  1351.          inc(Cnt);
  1352.       end;
  1354.       FIR_CoeffsEx(@Pts, Cnt, Ffs, FnCoeffs, @FCoeffs);
  1355.       FIR_Window(FWindow, FnCoeffs, @FCoeffs);
  1357.       Change;
  1358.    end;
  1359. end;
  1361. {-- TMMFIRFilter --------------------------------------------------------------}
  1362. procedure TMMFIRFilter.UpdateFilter;
  1363. begin
  1364.    if FOpen and (FPFIR <> nil) then
  1365.    begin
  1366.       FCleanup := wioSamplesToBytes(PWaveFormat,FnCoeffs);
  1368.       SetFIRFilter(FPFIR, @FCoeffs, FnCoeffs, ord(FChannel));
  1369.    end;
  1370. end;
  1372. {-- TMMFIRFilter --------------------------------------------------------------}
  1373. procedure TMMFIRFilter.Change;
  1374. begin
  1375.    UpdateFilter;
  1377.    NotifyResponse(opInsert);
  1378.    NotifySpectrum;
  1380.    if assigned(FOnChange) then FOnChange(Self);
  1381. end;
  1383. {-- TMMFIRFilter --------------------------------------------------------------}
  1384. procedure TMMFIRFilter.Loaded;
  1385. begin
  1386.    inherited Loaded;
  1388.    CalcFilter;
  1389. end;
  1391. {-- TMMFIRFilter --------------------------------------------------------------}
  1392. procedure TMMFIRFilter.SetPWaveFormat(aValue: PWaveFormatEx);
  1393. begin
  1394.    if (aValue <> nil) then
  1395.    begin
  1396.       if not (csDesigning in ComponentState) then
  1397.          if not pcmIsValidFormat(aValue) or (aValue^.wBitsPerSample = 8) then
  1398.             raise EMMFIRError.Create(LoadResStr(IDS_INVALIDFORMAT));
  1400.       SampleRate := aValue^.nSamplesPerSec;
  1401.    end;
  1402.    inherited SetPWaveFormat(aValue);
  1403. end;
  1405. {-- TMMFIRFilter --------------------------------------------------------------}
  1406. procedure TMMFIRFilter.Assign(Source: TPersistent);
  1407. begin
  1408.    if (Source is TMMFIRFilter) then
  1409.    begin
  1410.       if (Source <> nil) then
  1411.       begin
  1412.          Channel    := TMMFIRFilter(Source).Channel;
  1413.          Enabled    := TMMFIRFilter(Source).Enabled;
  1414.          Description:= TMMFIRFilter(Source).Description;
  1415.          Order      := TMMFIRFilter(Source).Order;
  1416.          Window     := TMMFIRFilter(Source).Window;
  1417.          SampleRate := TMMFIRFilter(Source).SampleRate;
  1418.          Filters    := TMMFIRFilter(Source).Filters;
  1419.       end;
  1420.    end;
  1421. end;
  1423. {-- TMMFIRFilter --------------------------------------------------------------}
  1424. procedure TMMFIRFilter.Open;
  1425. begin
  1426.    if not FOpen then
  1427.    begin
  1428.       if pcmIsValidFormat(PWaveFormat) then
  1429.       begin
  1430.          FPFIR := InitFIRFilter(PWaveFormat);
  1431.          if (FPFIR = nil) then OutOfMemoryError
  1432.          else
  1433.          begin
  1434.             FTempBuffer := GlobalAllocMem(Max(QUEUE_READ_SIZE,BufferSize));
  1435.             FOpen := True;
  1436.          end;
  1437.       end;
  1438.    end;
  1439. end;
  1441. {-- TMMFIRFilter --------------------------------------------------------------}
  1442. procedure TMMFIRFilter.Start;
  1443. begin
  1444.    UpdateFilter;
  1445. end;
  1447. {-- TMMFIRFilter --------------------------------------------------------------}
  1448. procedure TMMFIRFilter.Close;
  1449. begin
  1450.    if FOpen then
  1451.    begin
  1452.       FOpen := False;
  1453.       DoneFIRFilter(FPFIR);
  1454.       GlobalFreeMem(Pointer(FTempBuffer));
  1455.    end;
  1456. end;
  1458. {-- TMMFIRFilter --------------------------------------------------------------}
  1459. procedure TMMFIRFilter.Process(Buffer: PChar; nBytes: Longint);
  1460. begin
  1461.    { process the buffer trough the delay line }
  1462.    if (FPFIR <> nil) then
  1463.    begin
  1464.       if DoFIRFilterShort(FPFIR, Buffer, FTempBuffer, nBytes) then
  1465.          GlobalSynchronize(PcmOverflow);
  1467.       GlobalMoveMem(FTempBuffer^,Buffer^,nBytes);
  1468.    end;
  1469. end;
  1471. {-- TMMFIRFilter --------------------------------------------------------------}
  1472. function TMMFIRFilter.CleanUp(Buffer: PChar; Length: integer): Longint;
  1473. begin
  1474.    { process the remaining bytes in the delay lines }
  1475.    if (FPFIR <> nil) and (FCleanup > 0) then
  1476.    begin
  1477.       FCleanup := Max(FCleanup - Length,0);
  1478.       FillChar(Buffer^, Length, 0);
  1479.       Process(Buffer, Length);
  1480.    end;
  1481.    { return the remaining bytes to process }
  1482.    Result := FCleanup;
  1483. end;
  1485. {-- TMMFIRFilter --------------------------------------------------------------}
  1486. procedure TMMFIRFilter.Opened;
  1487. begin
  1488.    inherited Opened;
  1490.    Open;
  1491. end;
  1493. {-- TMMFIRFilter --------------------------------------------------------------}
  1494. procedure TMMFIRFilter.Closed;
  1495. begin
  1496.    Close;
  1498.    inherited Closed;
  1499. end;
  1501. {-- TMMFIRFilter --------------------------------------------------------------}
  1502. procedure TMMFIRFilter.Started;
  1503. begin
  1504.    inherited Started;
  1506.    Start;
  1507. end;
  1509. {-- TMMFIRFilter --------------------------------------------------------------}
  1510. procedure TMMFIRFilter.BufferReady(lpwh: PWaveHdr);
  1511. begin
  1512.    if Enabled then
  1513.    begin
  1514.       Process(lpwh^.lpData,lpwh^.dwBytesRecorded);
  1515.    end;
  1517.    inherited BufferReady(lpwh);
  1518. end;
  1520. {-- TMMFIRFilter --------------------------------------------------------------}
  1521. procedure TMMFIRFilter.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
  1522. var
  1523.    aLength: Longint;
  1524. begin
  1525.    inherited BufferLoad(lpwh, MoreBuffers);
  1527.    if Enabled and FOpen then
  1528.    begin
  1529.       if not MoreBuffers then
  1530.       begin
  1531.          aLength := lpwh^.dwBufferLength;
  1532.          if Cleanup(lpwh^.lpData, aLength) > 0 then MoreBuffers := True;
  1533.          lpwh^.dwBytesRecorded := aLength;
  1534.       end
  1535.       else Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
  1536.    end;
  1537. end;
  1539. {==============================================================================}
  1540. {-- TMMFIRResponse                                                           --}
  1541. {==============================================================================}
  1542. constructor TMMFIRResponse.Create(aOwner: TComponent);
  1543. begin
  1544.    inherited Create(aOwner);
  1546.    Font.Style  := [fsBold];
  1548.    Ffs         := defRate;
  1549.    FnCoeffs    := 0;
  1550.    FGridColor  := defGridColor;
  1551.    FAxisColor  := defAxisColor;
  1552.    FRespColor  := defRespColor;
  1553.    FCoeffColor := defCoeffColor;
  1554.    FDBScale    := defDBScale;
  1555.    FNormalized := defNormalized;
  1556.    FShowCoeffs := defShowCoeffs;
  1557.    FScaleColor := defScaleColor;
  1559.    Color       := defColor;
  1560.    Width       := defWidth;
  1561.    Height      := defHeight;
  1563.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  1564.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  1565. end;
  1567. {-- TMMFIRResponse ------------------------------------------------------------}
  1568. destructor TMMFIRResponse.Destroy;
  1569. begin
  1571.    inherited Destroy;
  1572. end;
  1574. {-- TMMFIRResponse ------------------------------------------------------------}
  1575. procedure TMMFIRResponse.AdjustClientSize;
  1576. begin
  1577.    FClient := BeveledRect;
  1578.    InflateRect(FClient,-30,-30);
  1579. end;
  1581. {-- TMMFIRResponse ------------------------------------------------------------}
  1582. procedure TMMFIRResponse.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  1583. begin
  1584.    inherited SetBounds(aLeft, aTop, aWidth, aHeight);
  1586.    AdjustClientSize;
  1587. end;
  1589. {-- TMMFIRResponse ------------------------------------------------------------}
  1590. procedure TMMFIRResponse.Changed;
  1591. begin
  1592.    AdjustClientSize;
  1594.    inherited Changed;
  1595. end;
  1597. {-- TMMFIRResponse ------------------------------------------------------------}
  1598. procedure TMMFIRResponse.SetCoeffs(pCoeffs: PFloatArray; nCoeffs: integer);
  1599. begin
  1600.    FnCoeffs := nCoeffs;
  1601.    if (FnCoeffs > 0) then
  1602.    begin
  1603.       GlobalMoveMem(pCoeffs^,FCoeffs,FnCoeffs*sizeOf(Float));
  1604.    end;
  1605.    Invalidate;
  1606. end;
  1608. {-- TMMFIRResponse ------------------------------------------------------------}
  1609. procedure TMMFIRResponse.SetBoolean(index: integer; aValue: Boolean);
  1610. begin
  1611.    case index of
  1612.       0: if (FShowCoeffs = aValue) then exit else FShowCoeffs := aValue;
  1613.       1: if (FDBScale = aValue) then exit else FDBScale := aValue;
  1614.       2: if (FNormalized = aValue) then exit else FNormalized := aValue;
  1615.    end;
  1616.    Invalidate;
  1617. end;
  1619. {-- TMMFIRResponse ------------------------------------------------------------}
  1620. procedure TMMFIRResponse.SetSampleRate(aValue: Longint);
  1621. begin
  1622.    if (aValue <> Ffs) then
  1623.    begin
  1624.       Ffs := MinMax(aValue,4000,100000);
  1625.       Invalidate;
  1626.    end;
  1627. end;
  1629. {-- TMMFIRResponse ------------------------------------------------------------}
  1630. procedure TMMFIRResponse.SetColors(index: integer; aValue: TColor);
  1631. begin
  1632.    case index of
  1633.        0: if (aValue = FGridColor) then exit else FGridColor := aValue;
  1634.        1: if (aValue = FAxisColor) then exit else FAxisColor := aValue;
  1635.        2: if (aValue = FRespColor) then exit else FRespColor := aValue;
  1636.        3: if (aValue = FCoeffColor) then exit else FCoeffColor := aValue;
  1637.        4: if (aValue = FScaleColor) then exit else FScaleColor := aValue;
  1638.    end;
  1639.    Invalidate;
  1640. end;
  1642. {-- TMMFIRResponse ------------------------------------------------------------}
  1643. procedure TMMFIRResponse.VLineDoted(aCanvas:TCanvas;x,y1,y2:integer;Clr:TColorRef);
  1644. var
  1645.    DC: HDC;
  1646. begin
  1647.    DC := aCanvas.Handle;
  1648.    if (y1 > y2) then SwapInt(y1,y2);
  1649.    while y1 < y2 do
  1650.    begin
  1651.       SetPixel(DC,x,y1,Clr);
  1652.       inc(y1,2);
  1653.    end;
  1654. end;
  1656. {-- TMMFIRResponse ------------------------------------------------------------}
  1657. procedure TMMFIRResponse.HLineDoted(aCanvas:TCanvas;x1,x2,y:integer;Clr:TColorRef);
  1658. var
  1659.    DC: HDC;
  1660. begin
  1661.    DC := aCanvas.Handle;
  1662.    if (x1 > x2) then SwapInt(x1,x2);
  1663.    while x1 < x2 do
  1664.    begin
  1665.       SetPixel(DC,x1,y,Clr);
  1666.       inc(x1,2);
  1667.    end;
  1668. end;
  1670. {-- TMMFIRResponse ------------------------------------------------------------}
  1671. procedure TMMFIRResponse.DrawBackground(Canvas: TCanvas; Client: TRect);
  1672. var
  1673.    i,x,y: integer;
  1674.    str: string;
  1675.    th,tw: integer;
  1676.    W,H: integer;
  1677.    Clr: Longint;
  1678.    NGrids: integer;
  1680. begin
  1681.    with Canvas,Client do
  1682.    begin
  1683.       W:= Right-Left;
  1684.       H:= Bottom-Top;
  1686.       Pen.Color := FAxisColor;
  1687.       Font.Color := FScaleColor;
  1689.       MoveTo(Left,Top);
  1690.       LineTo(Left,Bottom);
  1691.       LineTo(Right,Bottom);
  1693.       Font := Self.Font;
  1694.       SetTextAlign(Handle,TA_BASELINE or TA_CENTER);
  1696. (*
  1697.       case FFirFunc of
  1698.           ffLowPass : str := Format('Low Pass:';
  1699.           ffHighPass: str := Format('High Pass:';
  1700.           ffBandPass: str := Format('Band Pass:';
  1701.           ffBandStop: str := Format('Band Stop: f1 %d, f2 %d, %d taps',[;
  1702.           ffUser    : str := Format('User: f1 %d, f2 %d';
  1704.       str := Format(str+' Sample rate %d, f1 %d, %d taps',
  1705.                     [Ffs,0,FnCoeffs]);
  1706.   *)
  1707.       str := Format('FIR Filter Response: %f Khz, %d taps',[Ffs/1000,FnCoeffs]);
  1708.       TextOut(Left+W div 2,Top-10,str);
  1710.       Font.Handle:= CreateFont(-9,0,0,0,FW_NORMAL,0,0,0,DEFAULT_CHARSET,
  1711.                                OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,
  1712.                                VARIABLE_PITCH or FF_SWISS,'arial');
  1714.       SetTextAlign(Handle,TA_RIGHT);
  1715.       Clr := ColorToRGB(GridColor);
  1717.       th := TextHeight('W');
  1718.       if FNormalized then
  1719.          tw := TextWidth('0.5')
  1720.       else
  1721.          tw := TextWidth(' '+IntToStr(Ffs div 2));
  1723.       { calc the number of steps required }
  1724.       NGrids := 20;
  1725.       while (H div NGrids < th) or
  1726.             (W div NGrids < tw) do
  1727.       begin
  1728.          NGrids := NGrids div 2;
  1729.          if NGrids = 1 then break;
  1730.       end;
  1732.       for i := 0 to NGrids do
  1733.       begin
  1734.          y := (H*i)div NGrids;
  1736.       MoveTo(Left, Top+y);
  1737.          LineTo(Left-5, Top+y);
  1739.          if (i <> NGrids) then
  1740.             HLineDoted(Canvas,Left+1,Left+W,Top+y,Clr);
  1742.          if FDBScale then
  1743.          begin
  1744.     if (i = 0) then
  1745.        str := '0'
  1746.             else
  1747.        str := Format('-%d',[(i*100)div NGrids]);
  1749.          end
  1750.          else str := Format('%d%',[100-(i*100)div NGrids]);
  1752.          TextOut(Left-7,Top+y-(th div 2),str);
  1753.       end;
  1755.       if FDBScale then
  1756.          TextOut(Left-8,Bottom+10,'dB')
  1757.       else
  1758.          TextOut(Left-7,Bottom+10,'%');
  1760.       // mark the frequency scale (linear as a function of sample frequency)
  1761.       SetTextAlign(Handle,TA_CENTER or TA_TOP);
  1763.       for i := 0 to NGrids do
  1764.       begin
  1765.          x := (i*W) div NGrids;
  1766.          MoveTo(Left+x,Bottom);
  1767.          LineTo(Left+x,Bottom+5);
  1769.          if (i > 0) then
  1770.             VLineDoted(Canvas,Left+x,Top,Top+H,Clr);
  1772.          if FNormalized then
  1773.             str := Format('%f',[(0.5*i)/NGrids])
  1774.          else
  1775.             str := Format('%d',[(Ffs div 2)*i div NGrids]);
  1777.          TextOut(Left+x,Bottom+10,str);
  1778.       end;
  1780.       if not FNormalized then
  1781.          TextOut(Left+x+(tw div 2)+5,Bottom+10,' Hz');
  1782.    end;
  1783. end;
  1785. {-- TMMFIRResponse ------------------------------------------------------------}
  1786. procedure TMMFIRResponse.DrawImpulseResponse(Canvas: TCanvas; Client: TRect);
  1787. const
  1788.      HS = 4;
  1789. var
  1790.    W,H,i,ftype: integer;
  1791.    coeffs: array[0..4096] of Float;
  1793. begin
  1794.    if (FnCoeffs > 0) then
  1795.    with Canvas,Client do
  1796.    begin
  1797.       if (FnCoeffs and 1 <> 0) then
  1798.           ftype := 1
  1799.       else
  1800.           ftype := 2;
  1802.       H := Bottom-Top;
  1803.       W := Right-Left;
  1805.       FIR_Response(ftype,FnCoeffs,@FCoeffs,FDBScale,W,@coeffs);
  1806.       FIR_NormaliseResponse(FDBScale,W,@coeffs);
  1808.       Pen.Color := FRespColor;
  1809.       MoveTo(Left,Bottom-Trunc(coeffs[0]*H));
  1810.       for i := 0 to W-1 do
  1811.       begin
  1812.          LineTo(Left+i,Bottom-Trunc(coeffs[i]*H));
  1813.       end;
  1815.       if FShowCoeffs then
  1816.       begin
  1817.          // last thing: draw the filter itself
  1818.          Pen.Color := FCoeffColor;
  1819.          MoveTo(Left,Bottom-Trunc(FCoeffs[0]));
  1820.          if (FnCoeffs > 1) then
  1821.          for i := 0 to FnCoeffs-1 do
  1822.          begin
  1823.             LineTo(Left+(W*i)div (FnCoeffs-1),
  1824.                    Bottom-Trunc(FCoeffs[i]*H));
  1825.          end;
  1826.       end;
  1827.    end;
  1828. end;
  1830. {-- TMMFIRResponse ------------------------------------------------------------}
  1831. procedure TMMFIRResponse.Paint;
  1832. begin
  1833.    inherited Paint;
  1835.    DrawBackground(Canvas,FClient);
  1836.    DrawImpulseResponse(Canvas,FClient);
  1837. end;
  1839. Initialization
  1840.    { register filter class for streaming ! }
  1841.    DoRegisterClass(@TMMFIRFilterItem.Load,
  1842.                    @TMMFIRFilterItem.Store,
  1843.                     TMMFIRFilterItem);
  1844. end.