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

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

Delphi控件源码

开发平台：

Delphi

MMSpectr.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/index.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: 19.11.98 - 22:31:13 $                                        =}
  24. {========================================================================}
  25. Unit MMSpectr;
  27. {$C FIXED PRELOAD PERMANENT}
  29. {$I COMPILER.INC}
  31. interface
  33. uses
  34. {$IFDEF WIN32}
  35.     Windows,
  36. {$ELSE}
  37.     WinTypes,
  38.     WinProcs,
  39. {$ENDIF}
  40.     SysUtils,
  41.     Messages,
  42.     Classes,
  43.     Graphics,
  44.     Controls,
  45.     Forms,
  46.     Menus,
  47.     MMSystem,
  48.     MMUtils,
  49.     MMObj,
  50.     MMTimer,
  51.     MMString,
  52.     MMMath,
  53.     MMMulDiv,
  54.     MMFFT,
  55.     MMRegs,
  56.     MMPCMSup,
  57.     MMDIBCv;
  59. const
  60.     {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEHEIGHT} {$ENDIF}
  61.     SCALEHEIGHT     = 40;
  62.     {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEWIDTH} {$ENDIF}
  63.     SCALEWIDTH      = 32;
  64.     {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEFONT} {$ENDIF}
  65.     SCALEFONT       = 'ARIAL';
  67.     SCALEFONTSIZE   : integer = 10;
  68.     SCROLLDISTANCE  : integer = 2;
  70.     INFOCOLOR       : TCOLOR = clWhite;
  72.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAX_FFTLEN} {$ENDIF}
  73.     MAX_FFTLEN      = 4096; { Define the maximum FFT buffer length.        }
  74.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAXDECAYCOUNT} {$ENDIF}
  75.     MAXDECAYCOUNT   = 32;   { Maximum amount of temporal averaging allowed }
  77. type
  78.     EMMSpectrumError     = class(Exception);
  79.     TMMSpectrumKind      = (skDots, skLines, skVLines, skBars, skPeaks, skScroll);
  80.     TMMSpectrumGain      = (sgNone,sg3db,sg6db,sg9db,sg12db);
  81.     TMMSpectrumDrawBar   = procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; nSpots,Peak: integer) of object;
  82.     TMMSpectrumClear     = procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect) of object;
  83.     TMMSpectrumGetXScale = procedure(Sender: TObject; pX1,pX2: PIntArray) of object;
  85.     { array for uniform decay mode values }
  86.     PDataBuf       = ^TDataBuf;
  87.     TDataBuf       = array[0..MAXDECAYCOUNT-1] of PLongArray;
  89.     TPeak     = record          { record for peak values                  }
  90.       Freq     : Float;
  91.       Amp      : Float;
  92.       db       : Float;
  93.       { !! internal for peak display, do not use !!                }
  94.       Amplitude: Long;          { peak amplitude found             }
  95.       Index    : integer;       { bin number of the peak amplitude }
  96.       X        : integer;       { the X value for the Peak         }
  97.     end;
  99.     TDrawVal = record           { record for display values to draw    }
  100.       Left     : integer;       { left X1 for this set of bin's        }
  101.       Right    : integer;       { right X2 for this set of bin's       }
  102.       Value    : Longint;       { the (Y) value for this set of bin's  }
  103.       Peak     : integer;       { the peak value for this set of bin's }
  104.       PeakCnt  : integer;       { internal peak counter for timing     }
  105.     end;
  106.     PDrawArray = ^TDrawArray;
  107.     TDrawArray = array[0..DebugCount] of TDrawVal;
  109.     {-- TMMSpectrum -----------------------------------------------------}
  110.     TMMSpectrum = class(TMMDIBGraphicControl)
  111.     private
  112.       FTimerID    : Longint;    { timer for peak handling                }
  113.       FBarDIB     : TMMDIBCanvas;{ bitmap for inactive bars              }
  114.       {$IFDEF WIN32}
  115.       FpFFT       : PFFTReal;   { the instance for the FFT               }
  116.       {$ELSE}
  117.       FFT         : TMMFFT;     { the object that performs the FFT       }
  118.       {$ENDIF}
  119.       FFFTData    : PSmallArray;{ Array for FFT data                     }
  120.       FWinBuf     : PIntArray;  { Array storing windowing function       }
  121.       FDataBuf    : PDataBuf;   { Memory for averaging mode              }
  122.       FYBase      : PLongArray; { Scaling offset for log calculations    }
  123.       FLastVal_F  : PFloatArray;{ Last value buffer for exp decay mode   }
  124.       FLastVal    : PLongArray; { Last value buffer for uniform averaging}
  125.       FDisplayVal : PLongArray; { Array storing display values           }
  126.       Fx1         : PIntArray;  { Array of bin #'s displayed             }
  127.       Fx2         : PIntArray;  { Array of terminal bin #'s              }
  128.       FYScale     : PIntArray;  { scaling factors                        }
  129.       FDrawVal    : PDrawArray; { array with the rect's / points to draw }
  131.       FFTLen      : integer;    { Number of points for FFT               }
  132.       FSampleRate : Longint;    { A/D sampling rate                      }
  133.       FLogFreq    : Boolean;    { true for log-based frequency scale     }
  134.       FLogAmp     : Boolean;    { true for log-based amplitude scale     }
  135.       Fys         : Float;      { set for max of y-axis                  }
  136.       FLogBase    : integer;    { base of log scale (default=6 = -60db)  }
  137.       FLogs       : integer;    { for max of log scale (default=0 = 0db) }
  138.       FGain3db    : integer;    { indicating 3db/octave scale factor gain}
  139.       FDeriv      : integer;    { doing differencing for 6db/octave gain }
  140.       FRefFreq    : integer;    { ref. frequency for n db/octave gains   }
  142.       FPeak         : TPeak;    { the current peak value over all frequ. }
  143.       FWindow       : TMMFFTWindow;{ selected window function            }
  144.       FDecay        : integer;  { the current Decay value                }
  145.       FDecayMode    : TMMDecayMode;{ indicating decay mode on/off        }
  146.       FDecayFactor  : Float;    { Geometric decay factor                 }
  147.       FDecayCount   : integer;  { Temporal averaging parameter           }
  148.       FDecayCntAct  : integer;  { Total number of bins averaged so far   }
  149.       FMaxDecayCount: integer;  { Maximum value for the decay count      }
  150.       FDecayPtr     : integer;  { index for cur. averag. buffer location }
  152.       FShift           : integer;{ Number of bits for gain shift         }
  153.       FLogScaleFactor  : Float;  { Scaling factor for log values         }
  154.       FDispScaleFactor : Float;  { Display scalefactor for log values    }
  155.       FFreqScaleFactor : Float;  { Scalefactor for inc. the horiz. scale }
  156.       FFreqBase        : Float;  { Base frequency for the display        }
  158.       FKind          : TMMSpectrumKind;{ draw as dots,bars,lines,vlines  }
  159.       FEnabled       : Boolean;  { Enable or disable Spectrum            }
  160.       FBar1Color     : TColor;   { Farbe f黵 die Punkte im 1. Abschnitt  }
  161.       FBar2Color     : TColor;   { Farbe f黵 die Punkte im 2. Abschnitt  }
  162.       FBar3Color     : TColor;   { Farbe f黵 die Punkte im 3. Abschnitt  }
  163.       FInact1Color   : TColor;   { foreColor for inactive spots 1        }
  164.       FInact2Color   : TColor;   { foreColor for inactive spots 2        }
  165.       FInact3Color   : TColor;   { foreColor for inactive spots 3        }
  166.       FScaleTextColor: TColor;   { the text color for the scale          }
  167.       FScaleLineColor: TColor;   { the line color for the scale          }
  168.       FGridColor     : TColor;   { the grid color                        }
  169.       FScaleBackColor: TColor;   { background color for the scale        }
  170.       FInactiveDoted : Boolean;  { draw the inactive spots doted         }
  171.       FActiveDoted   : Boolean;  { draw the active spots doted           }
  172.       FPoint1        : integer;  { Schwelle von 1. zu 2. Abschnitt %     }
  173.       FPoint2        : integer;  { Schwelle von 2. zu 3. Abschnitt %     }
  174.       FPoint1Spot    : integer;  { on which spot begins next color       }
  175.       FPoint2Spot    : integer;  { on which spot begins next color       }
  176.       FSpotSpace     : integer;  { vertical space between spots          }
  177.       FSpotHeight    : integer;  { the spot height in pixel              }
  178.       FSpace         : integer;  { horizontal between the bars           }
  179.       FFirstSpace    : integer;  { the space before the first spot       }
  180.       FNumSpots      : integer;  { number of Spots                       }
  181.       FNumPeaks      : integer;  { number of spots displayed as peak     }
  182.       FPeakDelay     : integer;  { the delay for the peak spots          }
  183.       FPeakSpeed     : integer;  { the decrease speed for the peak spots }
  184.       FDisplayPeak   : Boolean;  { show the highest frequency or not     }
  185.       FDrawInactive  : Boolean;  { draw the inactive spots or not        }
  186.       FBits          : TMMBits;  { bit8 or bit16                         }
  187.       FChannel       : TMMChannel;{ chBoth, chLeft or chRigth            }
  188.       FMode          : TMMMode;  { mMono, mStereo or mQuadro             }
  189.       FBytes         : Longint;  { calculated data bytes per spectrum    }
  190.       FGain          : TMMSpectrumGain;{ Amount of db/octave gain        }
  191.       FOldShowHint   : Boolean;  { saved ShowHint propertie              }
  192.       FShowInfo      : Boolean;  { show the freq/amp info or not         }
  193.       FShowInfoHint  : Boolean;  { mouse is down, show the info          }
  194.       FDrawFreqScale : Boolean;  { draw the horiz scale or not          }
  195.       FDrawAmpScale  : Boolean;  { draw the vert scale or not            }
  196.       FDrawGrid      : Boolean;  { draw the grid or not                  }
  197.       FWidth         : integer;  { calculated width without border       }
  198.       FHeight        : integer;  { calculated height without border      }
  199.       FClientRect    : TRect;    { calculated beveled Rect               }
  201.       { Events }
  202.       FOnNeedData       : TNotifyEvent;
  203.       FOnGainOverflow   : TNotifyEvent;
  204.       FOnPcmOverflow    : TNotifyEvent;
  205.       FOnDrawBar        : TMMSpectrumDrawBar;
  206.       FOnClearBackground: TMMSpectrumClear;
  207.       FOnGetXScale      : TMMSpectrumGetXScale;
  209.       procedure CreateDataBuffers(Length: integer);
  210.       procedure FreeDataBuffers;
  211.       procedure CreateArrays(Size: integer);
  212.       procedure FreeArrays;
  213.       procedure ResetDecayBuffers;
  214.       procedure ResetPeakValues;
  215.       procedure XRangeCheck;
  216.       procedure SetupXScale;
  217.       procedure SetupLogScales;
  218.       procedure SetupLinScales;
  219.       procedure CalcNumSpots;
  220.       procedure CalcMagnitude(MagnitudeForm: Boolean);
  221.       procedure CalcDisplayValues;
  222.       procedure SetBytesPerSpectrum;
  223.       procedure InitializeData;
  224.       procedure NeedData;
  225.       procedure DrawFrequencyScale(Dummy: Boolean);
  226.       procedure DrawAmplitudeScale;
  227.       procedure SetLocalVariables(DIB: TMMDIBCanvas);
  228.       procedure InitLocalVariables;
  229.       procedure DrawPeakValue;
  230.       {$IFDEF USEASM}
  231.       procedure DrawBar(X1,X2,nSpots,Peak: integer);{$IFDEF WIN32}pascal;{$ENDIF}
  232.       procedure DrawBarPeak(X1,X2,nSpots,Peak: integer);{$IFDEF WIN32}pascal;{$ENDIF}
  233.       procedure PointedLineTo(X,Y: integer; Pointed: Boolean);{$IFDEF WIN32}pascal;{$ENDIF}
  234.       {$ENDIF}
  235.       procedure DrawBar_Native(X1,X2,nSpots,Peak: integer);
  236.       procedure DrawBarPeak_Native(X1,X2,nSpots,Peak: integer);
  237.       procedure DrawGrids;
  238.       procedure DrawInfo(Pos: TPoint);
  239.       procedure DrawAsDots;
  240.       procedure DrawAsLines;
  241.       procedure DrawAsVLines;
  242.       procedure DrawAsBars;
  243.       procedure DrawInactiveSpots;
  244.       procedure DrawSpectrum(Clear: Boolean);
  246.       procedure SetOnDrawBar(aValue: TMMSpectrumDrawBar);
  247.       procedure AdjustSize(var W, H: Integer);
  248.       procedure AdjustBounds;
  249.       procedure SetFFTLen(aLength: integer);
  250.       procedure SetWindow(aValue: TMMFFTWindow);
  251.       procedure SetLogFreq(aValue: Boolean);
  252.       procedure SetLogAmp(aValue: Boolean);
  253.       procedure SetKind(aValue: TMMSpectrumKind);
  254.       procedure SetDecayMode(aValue: TMMDecayMode);
  255.       procedure SetDecay(aValue: integer);
  256.       procedure SetVertScale(aValue: integer);
  257.       function  GetVertScale: integer;
  258.       procedure SetFreqScale(aValue: integer);
  259.       function  GetFreqScale: integer;
  260.       procedure SetDrawFreqScale(aValue: Boolean);
  261.       procedure SetDrawAmpScale(aValue: Boolean);
  262.       procedure SetDrawGrid(aValue: Boolean);
  263.       procedure SetEnabled(aValue: Boolean);
  264.       procedure SetColors(Index: Integer; Value: TColor);
  265.       procedure SetPoints(Index, aValue: integer);
  266.       procedure SetSpotSpace(aValue: integer);
  267.       procedure SetSpotHeight(aValue: integer);
  268.       procedure SetSpace(aValue: integer);
  269.       procedure SetNumPeaks(aValue: integer);
  270.       procedure SetPeakDelay(aValue: integer);
  271.       procedure SetPeakSpeed(aValue: integer);
  272.       procedure SetDisplayPeak(aValue: Boolean);
  273.       procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
  274.       function  GetPCMWaveFormat: TPCMWaveFormat;
  275.       procedure SetBits(aValue: TMMBits);
  276.       procedure SetChannel(aValue: TMMChannel);
  277.       procedure SetMode(aValue: TMMMode);
  278.       procedure SetSampleRate(aValue: Longint);
  279.       procedure SetRefFreq(aValue: integer);
  280.       procedure SetGain(aValue: TMMSpectrumGain);
  281.       procedure SetDrawInactive(aValue: Boolean);
  282.       procedure SetInactiveDoted(aValue: Boolean);
  283.       procedure SetActiveDoted(aValue: Boolean);
  284.       function  GetScaleBackColor: TColor;
  285.       function  GetPeak: TPeak;
  287.       procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  289.     protected
  290.       procedure ChangeDesigning(aValue: Boolean); override;
  291.       procedure SetBPP(aValue: integer); override;
  292.       procedure Paint; override;
  293.       procedure Loaded; override;
  294.       procedure GainOverflow; dynamic;
  295.       procedure PcmOverflow; dynamic;
  296.       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  297.       procedure Changed; override;
  298.       procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  299.       procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  300.       procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  302.     public
  303.       constructor Create(AOwner: TComponent); override;
  304.       destructor  Destroy; override;
  306.       function  GetOptimalWidth(aWidth: integer): integer;
  308.       procedure ForceRescale;
  310.       function  GetFrequencyAtPos(Pos: TPoint): Float;
  311.       function  GetAmplitudeAtPos(Pos: TPoint): Float;
  313.       procedure RefreshPCMData(PCMData: Pointer);
  314.       procedure RefreshFFTData(FFTData: Pointer);
  315.       procedure RefreshMagnitudeData(MagData: Pointer);
  316.       procedure ResetData;
  318.       property  Peak: TPeak read GetPeak;
  319.       property  BytesPerSpectrum: Longint read FBytes;
  320.       property  PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
  321.       property  FFTData: PSmallArray read FFFTData;
  323.     published
  324.       { Events }
  325.       property OnClick;
  326.       property OnDblClick;
  327.       property OnMouseDown;
  328.       property OnMouseMove;
  329.       property OnMouseUp;
  330.       property OnDragDrop;
  331.       property OnDragOver;
  332.       property OnEndDrag;
  333.       property OnStartDrag;
  334.       property OnGetXScale: TMMSpectrumGetXScale read FOnGetXScale write FOnGetXScale;
  335.       property OnNeedData: TNotifyEvent read FOnNeedData write FOnNeedData;
  336.       property OnDrawBar: TMMSpectrumDrawBar read FOnDrawBar write SetOnDrawBar;
  337.       property OnClearBackground: TMMSpectrumClear read FOnClearBackground write FOnClearBackground;
  338.       property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
  339.       property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  341.       property Align;
  342.       property Bevel;
  343.       property BackGroundDIB;
  344.       property UseBackGroundDIB;
  345.       property PaletteRealize;
  346.       property Color default clBlack;
  347.       property Cursor default crCross;
  348.       property ParentShowHint;
  349.       property ParentColor default False;
  350.       property PopupMenu;
  351.       property Visible;
  352.       property ShowHint;
  353.       property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
  354.       property Enabled: Boolean read FEnabled write SetEnabled default True;
  355.       property DrawFreqScale: Boolean read FDrawFreqScale write SetDrawFreqScale default False;
  356.       property DrawAmpScale: Boolean read FDrawAmpScale write SetDrawAmpScale default False;
  357.       property DrawGrid: Boolean read FDrawGrid write SetDrawGrid default False;
  358.       property Height default 89;
  359.       property Width default 194;
  360.       property Space: integer read FSpace write SetSpace default 1;
  361.       property SpotSpace: integer read FSpotSpace write SetSpotSpace default 1;
  362.       property SpotHeight: integer read FSpotHeight write SetSpotHeight default 1;
  363.       property Bar1Color: TColor index 0 read FBar1Color write SetColors default clAqua;
  364.       property Bar2Color: TColor index 1 read FBar2Color write SetColors default clAqua;
  365.       property Bar3Color: TColor index 2 read FBar3Color write SetColors default clRed;
  366.       property Inactive1Color: TColor index 3 read FInact1Color write SetColors default clTeal;
  367.       property Inactive2Color: TColor index 4 read FInact2Color write SetColors default clTeal;
  368.       property Inactive3Color: TColor index 5 read FInact3Color write SetColors default clMaroon;
  369.       property ScaleTextColor: TColor index 6 read FScaleTextColor write SetColors default clBlack;
  370.       property ScaleLineColor: TColor index 7 read FScaleLineColor write SetColors default clBlack;
  371.       property GridColor: TColor index 8 read FGridColor write SetColors default clGray;
  372.       {$IFDEF BUILD_ACTIVEX}
  373.       property ScaleBackColor: TColor index 9 read FScaleBackColor write SetColors default clBtnFace;
  374.       {$ENDIF}
  375.       property Point1: integer index 0 read FPoint1 write SetPoints default 50;
  376.       property Point2: integer index 1 read FPoint2 write SetPoints default 85;
  377.       property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
  378.       property InactiveDoted: Boolean read FInactiveDoted write SetInactiveDoted default False;
  379.       property ActiveDoted: Boolean read FActiveDoted write SetActiveDoted default False;
  380.       property Mode: TMMMode read FMode write SetMode default mMono;
  381.       property BitLength: TMMBits read FBits write SetBits default b8bit;
  382.       property Channel: TMMChannel read FChannel write SetChannel default chBoth;
  383.       property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
  384.       property RefFreq: integer read FRefFreq write SetRefFreq default 1000;
  385.       property Gain: TMMSpectrumGain read FGain write SetGain default sgNone;
  386.       property FFTLength: integer read FFTLen write SetFFTLen default 128;
  387.       property LogFreq: Boolean read FLogFreq write SetLogFreq default False;
  388.       property LogAmp: Boolean read FLogAmp write SetLogAmp default False;
  389.       property Kind: TMMSpectrumKind read FKind write SetKind default skBars;
  390.       property Window: TMMFFTWindow read FWindow write SetWindow default fwHamming;
  391.       property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default dmNone;
  392.       property Decay: integer read FDecay write SetDecay default 1;
  393.       property VerticalScale: integer read GetVertScale write SetVertScale default 100;
  394.       property FrequencyScale: integer read GetFreqScale write SetFreqScale default 1;
  395.       property NumPeaks: integer read FNumPeaks write SetNumPeaks default 1;
  396.       property PeakDelay: integer read FPeakDelay write SetPeakDelay default 20;
  397.       property PeakSpeed: integer read FPeakSpeed write SetPeakSpeed default 0;
  398.       property DisplayPeak: Boolean read FDisplayPeak write SetDisplayPeak default False;
  399.     end;
  401. implementation
  403. uses Consts;
  405. {.$DEFINE USE_INTEGER_CODE}
  407. {$IFDEF USE_INTEGER_CODE}
  408. const
  409.     { Table for approximating the logarithm.
  410.     { These values are round(log2(index/16)*8192) for index=0:31 }
  411.     _ln: array[0..31] of Long = (-131072,-32768,-24576,-19784,-16384,
  412.                                  -13747,-11592,-9770,-8192,-6800,-5555,
  413.                                  -4428,-3400,-2454,-1578,-763,0,716,1392,
  414.                                  2031,2637,3214,3764,4289,4792,5274,5738,
  415.                                  6184,6614,7029,7429,7817);
  416. {$ENDIF}
  417. var
  418.    { local variables for fast asm drawing }
  419.    _DIB          : TMMDIBCanvas;
  420.    _DIB_ORIENT   : integer;
  421.    _biBits       : Longint;
  422.    _biBPP        : Longint;
  423.    _biWidth      : Longint;
  424.    _biHeight     : Longint;
  425.    _biScanWidth  : Longint;
  426.    _biLineDiff   : Longint;
  427.    _biColor      : Longint;
  428.    _biSurface    : Pointer;
  429.    _biPenPos     : TPoint;
  430.    _biClipRect   : TRect;
  432.    _Bar1Color    : Cardinal;
  433.    _Bar2Color    : Cardinal;
  434.    _Bar3Color    : Cardinal;
  435.    _Inact1Color  : Cardinal;
  436.    _Inact2Color  : Cardinal;
  437.    _Inact3Color  : Cardinal;
  438.    _NumSpots     : integer;
  439.    _NumPeaks     : integer;
  440.    _SpotHeight   : Longint;
  441.    _SpotSpace    : Longint;
  442.    _FirstSpace   : Longint;
  443.    _Space        : Longint;
  444.    _Point1Spot   : integer;
  445.    _Point2Spot   : integer;
  446.    _ActiveDoted  : Boolean;
  447.    _InactiveDoted: Boolean;
  448.    _DrawInactive : Boolean;
  449.    _Offset       : integer;
  451. const
  452.    SaveDC        : HDC     = 0;
  453.    SaveBitmap    : HBitmap = 0;
  454.    SaveWidth     : integer = 0;
  455.    SaveHeight    : integer = 0;
  456.    SaveInfoPos   : TPoint  = (X:0;Y:0);
  457.    OldBitmap     : HBitmap = 0;
  459. {------------------------------------------------------------------------}
  460. procedure TimeCallBack(uTimerID, dwUser: Longint);export;
  461. var
  462.    j: integer;
  464. begin
  465.   if (dwUser <> 0) then
  466.   with TMMSpectrum(dwUser) do
  467.   begin
  468.      if (FNumPeaks < 1) or (FDrawVal = nil) or FShowInfoHint then exit;
  470.      j := 0;
  471.      while (FDrawVal^[j].Left <> -1) and (j < FWidth) do
  472.      with FDrawVal^[j] do
  473.      begin
  474.         if (Peak > 0) then
  475.         begin
  476.            dec(PeakCnt);
  477.            if PeakCnt <= 0 then
  478.            begin
  479.               if (FPeakSpeed = 0) then
  480.               begin
  481.                  Peak := 0;                 { clear the peak hold spot }
  482.                  PeakCnt := 0;
  483.               end
  484.               else
  485.               begin
  486.                  dec(Peak);                       { dec the peak spot }
  487.                  PeakCnt := FPeakSpeed;
  488.               end;
  489.            end;
  490.         end;
  491.         inc(j);
  492.      end;
  493.   end;
  494. end;
  496. {-- TMMSpectrum ---------------------------------------------------------}
  497. constructor TMMSpectrum.Create(AOwner: TComponent);
  498. begin
  499.    inherited Create(AOwner);
  501.    ControlState := ControlState + [csCreating];
  503.    FTimerID := 0;
  504.    CreateDataBuffers(MAX_FFTLEN);
  505.    FBarDIB := TMMDIBCanvas.Create(Self);
  507.    {$IFDEF WIN32}
  508.    FpFFT := InitRealFFT(8);
  509.    {$ELSE}
  510.    FFT := TMMFFT.Create;
  511.    {$ENDIF}
  513.    FFTLen := 8;
  515.    FWindow := fwHamming;
  516.    FSampleRate := 11025;
  517.    FLogFreq := False;
  518.    FLogAmp := False;
  519.    FFreqScaleFactor := 1.0;
  520.    FFreqBase := 1.0;
  521.    Fys := 1.0;
  523.    FLogBase := 6;
  524.    FLogs := 0;
  526.    FGain3db := 0;
  527.    FDeriv := 0;
  528.    FRefFreq := 1000;
  529.    FDecay := 1;
  530.    FDecayMode := dmNone;
  531.    FDecayFactor := 0.0001;
  532.    FDecayCount := 1;
  533.    FDecayCntAct := 0;
  534.    FDecayPtr := 0;
  535.    FNumPeaks := 1;
  536.    FPeakDelay := 20;
  537.    FPeakSpeed := 0;
  538.    FDisplayPeak := False;
  539.    FKind := skBars;
  540.    FEnabled := True;
  541.    FBar1Color := clAqua;
  542.    FBar2Color := clAqua;
  543.    FBar3Color := clRed;
  544.    FInact1Color := clTeal;
  545.    FInact2Color := clTeal;
  546.    FInact3Color := clMaroon;
  547.    FScaleTextColor := clBlack;
  548.    FScaleLineColor:= clBlack;
  549.    FScaleBackColor:= clBtnFace;
  550.    FGridColor := clGray;
  551.    FPoint1 := 50;
  552.    FPoint2 := 85;
  553.    FInactiveDoted := False;
  554.    FActiveDoted := False;
  555.    FSpace := 1;
  556.    FSpotSpace := 1;
  557.    FSpotHeight := 1;
  558.    FChannel := chBoth;
  559.    FBits := b8bit;
  560.    FMode := mMono;
  561.    FGain := sgNone;
  562.    FDrawInactive := True;
  563.    FDrawFreqScale := False;
  564.    FDrawAmpScale := False;
  565.    FDrawGrid := False;
  566.    FDrawVal := nil;
  567.    FShowInfoHint := False;
  568.    FShowInfo := True;
  570.    Color := clBlack;
  571.    SetBounds(0,0,194,89);
  573.    Cursor := crCross;
  575.    ControlState := ControlState - [csCreating];
  577.    FFTLength := 128;
  579.    if not (csDesigning in ComponentState) then
  580.    begin
  581.       { create the peak timer }
  582.       FTimerID := MMTimeSetEvent(25,False,TimeCallBack,Longint(Self));
  583.    end;
  585.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  586.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  587. end;
  589. {-- TMMSpectrum ---------------------------------------------------------}
  590. Destructor TMMSpectrum.Destroy;
  591. begin
  592.    if (FTimerID <> 0) then
  593.    begin
  594.       { destroy the peak timer }
  595.       MMTimeKillEvent(FTimerID);
  596.    end;
  598.    FreeDataBuffers;
  599.    FreeArrays;
  600.    {$IFDEF WIN32}
  601.    DoneRealFFT(FpFFT);
  602.    {$ELSE}
  603.    FFT.Free;
  604.    {$ENDIF}
  605.    FBarDIB.Free;
  607.    inherited Destroy;
  608. end;
  610. {-- TMMSpectrum ---------------------------------------------------------}
  611. procedure TMMSpectrum.ChangeDesigning(aValue: Boolean);
  612. begin
  613.    inherited ChangeDesigning(aValue);
  615.    if not (csDesigning in ComponentState) then
  616.    begin
  617.       { create the peak timer }
  618.       if (FTimerID = 0) then
  619.           FTimerID := MMTimeSetEvent(25,False,TimeCallBack,Longint(Self));
  620.       InitializeData;
  621.    end;
  622. end;
  624. {-- TMMSpectrum ---------------------------------------------------------}
  625. procedure TMMSpectrum.SetBPP(aValue: integer);
  626. begin
  627.    if (aValue <> BitsPerPixel) then
  628.    begin
  629.       if (aValue <> 8) and (aValue <> 24) then
  630.          raise EMMDIBError.Create('Bitlength not supported yet');
  632.       FBarDIB.BitsPerPixel := aValue;
  633.       DIBCanvas.BitsPerPixel := aValue;
  634.       DrawInactiveSpots;
  635.       Invalidate;
  636.    end;
  638. //   inherited SetBPP(aValue);
  639. end;
  641. {-- TMMSpectrum ---------------------------------------------------------}
  642. procedure TMMSpectrum.GainOverflow;
  643. begin
  644.    if Assigned(FOnGainOverflow) then FOnGainOverflow(Self);
  645. end;
  647. {-- TMMSpectrum ---------------------------------------------------------}
  648. procedure TMMSpectrum.PcmOverflow;
  649. begin
  650.    if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
  651. end;
  653. {-- TMMSpectrum ---------------------------------------------------------}
  654. procedure TMMSpectrum.ResetDecayBuffers;
  655. var
  656.    i, j: integer;
  658. begin
  659.    FDecayPtr := 0;
  660.    FDecayCntAct := 0; { Restart the count of number of samples taken }
  661.    FillChar(FLastVal^, (FFTLen div 2)*sizeOf(Long),0);
  662.    FillChar(FLastVal_F^, (FFTLen div 2)*sizeOf(Float),0);
  663.    for i := 0 to FMaxDecayCount-1 do
  664.        for j := 0 to (FFTLen div 2)-1 do FDataBuf^[i]^[j] := 0;
  665. end;
  667. {-- TMMSpectrum ---------------------------------------------------------}
  668. procedure TMMSpectrum.ResetPeakValues;
  669. begin
  670.    FillChar(FDrawVal^[0], FWidth * sizeOf(TDrawVal), 0);
  671.    FillChar(FPeak, sizeOf(TPeak),0);
  672. end;
  674. {-- TMMSpectrum ---------------------------------------------------------}
  675. procedure TMMSpectrum.CreateDataBuffers(Length: integer);
  676. begin
  677.    if (Length > 0) then
  678.    begin
  679.       FFFTData   := GlobalAllocMem(Length * sizeOf(SmallInt));
  680.       FWinBuf    := GlobalAllocMem(Length * sizeOf(Integer));
  681.       FDisplayVal:= GlobalAllocMem((Length div 2) * sizeOf(Long));
  682.       FLastVal   := GlobalAllocMem((Length div 2) * sizeOf(Long));
  683.       FLastVal_F := GlobalAllocMem((Length div 2) * sizeOf(Float));
  684.       FYBase     := GlobalAllocMem((Length div 2) * sizeOf(Long));
  685.       FDataBuf   := GlobalAllocMem(MAXDECAYCOUNT * sizeOf(PLongArray));
  687.       {$IFDEF WIN32}
  688.       {$IFDEF TRIAL}
  689.       {$DEFINE _HACK1}
  690.       {$I MMHACK.INC}
  691.       {$ENDIF}
  692.       {$ENDIF}
  694.       FMaxDecayCount := 0;
  695.       while FMaxDecayCount < MAXDECAYCOUNT do
  696.       begin
  697.          FDataBuf^[FMaxDecayCount] := GlobalAllocMem((Length div 2) * sizeOf(Long));
  698.          if FDataBuf^[FMaxDecayCount] = nil then break;
  699.          inc(FMaxDecayCount);
  700.       end;
  701.       if (FMaxDecayCount < 1) then OutOfMemoryError;
  703.       FDecayCount := Min(FDecayCount, FMaxDecayCount);
  705.       { Clear out the memory buffers }
  706.       ResetDecayBuffers;
  707.    end;
  708. end;
  710. {-- TMMSpectrum ---------------------------------------------------------}
  711. procedure TMMSpectrum.FreeDataBuffers;
  712. var
  713.    i: integer;
  715. begin
  716.    GlobalFreeMem(Pointer(FFFTData));
  717.    GlobalFreeMem(Pointer(FWinBuf));
  718.    GlobalFreeMem(Pointer(FDisplayVal));
  719.    GlobalFreeMem(Pointer(FLastVal));
  720.    GlobalFreeMem(Pointer(FLastVal_F));
  721.    GlobalFreeMem(Pointer(FYBase));
  723.    if FDataBuf <> nil then
  724.    begin
  725.       for i := 0 to FMaxDecayCount-1 do
  726.           if FDataBuf^[i] <> nil then GlobalFreeMem(Pointer(FDataBuf^[i]));
  727.       GlobalFreeMem(Pointer(FDataBuf));
  728.    end;
  729. end;
  731. {-- TMMSpectrum ---------------------------------------------------------}
  732. procedure TMMSpectrum.CreateArrays(Size: integer);
  733. begin
  734.    if (Size > 0) then
  735.    begin
  736.       MMTimeSuspendEvent(FTimerID);
  737.       Fx1     := GlobalAllocMem((Size+10) * sizeOf(Integer));
  738.       Fx2     := GlobalAllocMem((Size+10) * sizeOf(Integer));
  739.       FYScale := GlobalAllocMem(Size * sizeOf(Integer));
  740.       FDrawVal:= GlobalAllocMem((Size+1) * sizeOf(TDrawVal));
  741.       FDrawVal^[Size].Left := -1; { mark the end }
  742.       MMTimeResumeEvent(FTimerID);
  743.    end;
  744. end;
  746. {-- TMMSpectrum ---------------------------------------------------------}
  747. procedure TMMSpectrum.FreeArrays;
  748. begin
  749.    MMTimeSuspendEvent(FTimerID);
  750.    GlobalFreeMem(Pointer(Fx1));
  751.    GlobalFreeMem(Pointer(Fx2));
  752.    GlobalFreeMem(Pointer(FYScale));
  753.    GlobalFreeMem(Pointer(FDrawVal));
  754.    MMTimeResumeEvent(FTimerID);
  755. end;
  757. {-- TMMSpectrum ---------------------------------------------------------}
  758. procedure TMMSpectrum.InitializeData;
  759. Var
  760.    i: integer;
  761. begin
  762.    FillChar(FDisplayVal^[0], FFTLen div 2 * sizeOf(Long), 0);
  763.    FillChar(FFFTData^[0], FFTLen * sizeOf(SmallInt), 0);
  764.    ResetPeakValues;
  765.    ResetDecayBuffers;
  767.    if Enabled then
  768.    begin
  769.       if assigned(FOnNeedData) then FOnNeedData(Self)
  770.       else if (csDesigning in ComponentState) then
  771.       begin
  772.          Randomize;
  773.          for i := 0 to FFTLen div 2-1 do
  774.          begin                                         { create random data }
  775.             FDisplayVal^[i] := Long(Random(32767));
  776.          end;
  777.       end;
  778.    end;
  779. end;
  781. {-- TMMSpectrum ---------------------------------------------------------}
  782. procedure TMMSpectrum.ResetData;
  783. var
  784.    P: TPoint;
  785. begin
  786.    if FShowInfoHint then
  787.    begin
  788.       GetCursorPos(P);
  789.       P := ScreenToClient(P);
  790.       Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  791.    end;
  792.    InitializeData;
  793.    Refresh;
  794. end;
  796. const
  797.     inHandler: Longint = 0;
  799. {-- TMMSpectrum ---------------------------------------------------------}
  800. procedure TMMSpectrum.NeedData;
  801. begin
  802.    inc(inHandler);
  803.    try
  804.       if (inHandler = 1)
  805.       {$IFDEF BUILD_ACTIVEX}
  806.       and not Selected
  807.       {$ENDIF} then
  808.       begin
  809.          if (csLoading in ComponentState) or
  810.             (csReading in ComponentState) then exit;
  812.          InitializeData;
  813.       end;
  814.    finally
  815.       dec(inHandler);
  816.    end;
  817. end;
  819. {-- TMMSpectrum ---------------------------------------------------------}
  820. procedure TMMSpectrum.ForceRescale;
  821. begin
  822.    SetupXScale;
  823. end;
  825. {-- TMMSpectrum ---------------------------------------------------------}
  826. procedure TMMSpectrum.SetFFTLen(aLength: integer);
  827. var
  828.    Order: integer;
  830. begin
  831.    aLength := MinMax(aLength,8,MAX_FFTLEN);
  832.    { Convert FFTLen to a power of 2 }
  833.    Order := 0;
  834.    while aLength > 1 do
  835.    begin
  836.       aLength := aLength shr 1;
  837.       inc(Order);
  838.    end;
  839.    if (Order > 0) then aLength := aLength shl Order;
  841.    {$IFDEF WIN32}
  842.    {$IFDEF TRIAL}
  843.    {$DEFINE _HACK3}
  844.    {$I MMHACK.INC}
  845.    {$ENDIF}
  846.    {$ENDIF}
  848.    if (aLength <> FFTLen) then
  849.    begin
  850.       { re-init the FFT instance with the new FFT-length }
  851.       {$IFDEF WIN32}
  852.       DoneRealFFT(FpFFT);
  853.       FpFFT := InitRealFFT(Order);
  855.       FFTLen := aLength;
  856.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  857.       {$ELSE}
  858.       FFT.FFTLength := aLength;
  859.       FFTLen := aLength;
  860.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  861.       {$ENDIF}
  862.       { Re-initialize the display }
  863.       SetupXScale;
  864.       SetBytesPerSpectrum;
  865.       { Flush the buffers }
  866.       NeedData;
  867.       Invalidate;
  868.    end;
  869. end;
  871. {-- TMMSpectrum ---------------------------------------------------------}
  872. procedure TMMSpectrum.SetWindow(aValue: TMMFFTWindow);
  873. begin
  874.    if (aValue <> FWindow) then
  875.    begin
  876.       FWindow := aValue;
  877.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  878.    end;
  879. end;
  881. {-- TMMSpectrum ---------------------------------------------------------}
  882. procedure TMMSpectrum.SetSampleRate(aValue: Longint);
  883. begin
  884.    if (aValue <> FSampleRate) then
  885.    begin
  886.       FSampleRate := MinMax(aValue, 8000,100000);
  887.       { Re-initialize the display }
  888.       SetupXScale;
  889.       NeedData;
  890.       Invalidate;
  891.    end;
  893.    {$IFDEF WIN32}
  894.    {$IFDEF TRIAL}
  895.    {$DEFINE _HACK2}
  896.    {$I MMHACK.INC}
  897.    {$ENDIF}
  898.    {$ENDIF}
  899. end;
  901. {-- TMMSpectrum ---------------------------------------------------------}
  902. procedure TMMSpectrum.SetLogFreq(aValue: Boolean);
  903. begin
  904.    { Toggle between linear and logarithmic frequency scale }
  905.    if (aValue <> FLogFreq) then
  906.    begin
  907.       FLogFreq := aValue;
  908.       SetupXScale;
  909.       NeedData;
  910.       Invalidate;
  911.    end;
  913.    {$IFDEF WIN32}
  914.    {$IFDEF TRIAL}
  915.    {$DEFINE _HACK3}
  916.    {$I MMHACK.INC}
  917.    {$ENDIF}
  918.    {$ENDIF}
  919. end;
  921. {-- TMMSpectrum ---------------------------------------------------------}
  922. procedure TMMSpectrum.SetLogAmp(aValue: Boolean);
  923. begin
  924.    { Toggle linear/logarithmic amplitude axis }
  925.    if (aValue <> FLogAmp) then
  926.    begin
  927.       FLogAmp := aValue;
  929.       if FLogAmp then SetupLogScales
  930.       else SetupLinScales;
  932.       NeedData;
  933.       Invalidate;
  934.    end;
  935.    {$IFDEF WIN32}
  936.    {$IFDEF TRIAL}
  937.    {$DEFINE _HACK1}
  938.    {$I MMHACK.INC}
  939.    {$ENDIF}
  940.    {$ENDIF}
  941. end;
  943. {-- TMMSpectrum ---------------------------------------------------------}
  944. procedure TMMSpectrum.SetDecayMode(aValue: TMMDecayMode);
  945. begin
  946.    { Select averaging mode }
  947.    if (aValue <> FDecayMode) then
  948.    begin
  949.       FDecayMode := aValue;
  950.       { Re-initialize the buffers }
  951.       ResetDecayBuffers;
  952.    end;
  954.    {$IFDEF WIN32}
  955.    {$IFDEF TRIAL}
  956.    {$DEFINE _HACK3}
  957.    {$I MMHACK.INC}
  958.    {$ENDIF}
  959.    {$ENDIF}
  960. end;
  962. {-- TMMSpectrum ---------------------------------------------------------}
  963. procedure TMMSpectrum.SetDecay(aValue: integer);
  964. var
  965.    i: integer;
  967. begin
  968.    aValue := MinMax(aValue,1,16);
  969.    if (aValue <> FDecay) then
  970.    begin
  971.       FDecay := aValue;
  973.       { factor for stepUp and exponential averaging }
  974.       FDecayFactor := 0.0001;
  975.       for i := 0 to FDecay-1 do
  976.           FDecayFactor := sqrt(FDecayFactor);
  978.       { counter for uniform averaging }
  979.       FDecayCount := MinMax(2*(aValue-1),1,MaxDecayCount);
  981.       { Re-initialize the buffers for uniform averaging }
  982.       if (FDecayMode = dmUniform) then ResetDecayBuffers;
  983.    end;
  985.    {$IFDEF WIN32}
  986.    {$IFDEF TRIAL}
  987.    {$DEFINE _HACK1}
  988.    {$I MMHACK.INC}
  989.    {$ENDIF}
  990.    {$ENDIF}
  991. end;
  993. {-- TMMSpectrum ---------------------------------------------------------}
  994. procedure TMMSpectrum.SetKind(aValue: TMMSpectrumKind);
  995. begin
  996.    if (aValue <> FKind) then
  997.    begin
  998.       FKind := aValue;
  999.       CalcNumSpots;
  1000.       ResetPeakValues;
  1001.       Invalidate;
  1002.    end;
  1004.    {$IFDEF WIN32}
  1005.    {$IFDEF TRIAL}
  1006.    {$DEFINE _HACK2}
  1007.    {$I MMHACK.INC}
  1008.    {$ENDIF}
  1009.    {$ENDIF}
  1010. end;
  1012. {-- TMMSpectrum ---------------------------------------------------------}
  1013. procedure TMMSpectrum.SetEnabled(aValue: Boolean);
  1014. begin
  1015.    if (aValue <> FEnabled) then
  1016.    begin
  1017.       FEnabled := aValue;
  1018.       { inherited Enabled := Value }
  1019.       if (not FEnabled) then
  1020.       begin
  1021.          ResetData;
  1022.          MMTimeSuspendEvent(FTimerID);
  1023.       end
  1024.       else
  1025.       begin
  1026.          NeedData;                         { init Data when in designing }
  1027.          MMTimeResumeEvent(FTimerID);
  1028.       end;
  1029.       Invalidate;
  1030.    end;
  1031. end;
  1033. {-- TMMSpectrum ---------------------------------------------------------}
  1034. procedure TMMSpectrum.Loaded;
  1035. begin
  1036.    inherited Loaded;
  1038.    SetupXScale;
  1039.    NeedData;
  1040.    Invalidate;
  1042.    {$IFDEF WIN32}
  1043.    {$IFDEF TRIAL}
  1044.    {$DEFINE _HACK3}
  1045.    {$I MMHACK.INC}
  1046.    {$ENDIF}
  1047.    {$ENDIF}
  1048. end;
  1050. {-- TMMSpectrum ---------------------------------------------------------}
  1051. procedure TMMSpectrum.CalcNumSpots;
  1052. begin
  1053.    FSpotHeight := Max(FSpotHeight, 1);
  1054.    FNumSpots := (FHeight+FSpotSpace) div (FSpotHeight+FSpotSpace);
  1055.    if (FNumSpots = 0) then inc(FNumSpots);     { fix divisio by zerro !!! }
  1056.    FFirstSpace := (FHeight-(FNumSpots*(FSpotHeight+FSpotSpace)-FSpotSpace)) div 2;
  1058.    case FKind of
  1059.        skBars,
  1060.        skPeaks:
  1061.        begin
  1062.           { calc the spot on which the next color starts }
  1063.           FPoint1Spot := Round((FPoint1 * FNumSpots) / 100);
  1064.           FPoint2Spot := Round((FPoint2 * FNumSpots) / 100);
  1065.        end;
  1066.        skLines,
  1067.        skVLines:
  1068.        begin
  1069.           { calc the point on which the next color starts }
  1070.           FPoint1Spot := Round((FPoint1 * FHeight) / 100);
  1071.           FPoint2Spot := Round((FPoint2 * FHeight) / 100);
  1072.        end;
  1073.        skScroll:
  1074.        begin
  1075.           { calc the point on which the next color starts }
  1076.           FPoint1Spot := Round((FPoint1 * FHeight/3) / 100);
  1077.           FPoint2Spot := Round((FPoint2 * FHeight/3) / 100);
  1078.        end;
  1079.        else
  1080.        begin
  1081.           { calc the point on which the next color starts }
  1082.           FPoint1Spot := Round(FHeight-((FPoint1 * FHeight) / 100));
  1083.           FPoint2Spot := Round(FHeight-((FPoint2 * FHeight) / 100));
  1084.        end;
  1085.    end;
  1087.    { prepare the second DIB with the inactive spots }
  1088.    DrawInactiveSpots;
  1089.    { we will see anything in designer or clear out the buffers at runtime }
  1090.    NeedData;
  1091. end;
  1093. {-- TMMSpectrum ---------------------------------------------------------}
  1094. procedure TMMSpectrum.AdjustSize(var W, H: Integer);
  1095. begin
  1096.    W := Max(W,2*BevelExtend+5);
  1097.    H := Max(H,2*BevelExtend+5);
  1099.    if FDrawAmpScale then
  1100.       W := Max(W,2*SCALEWIDTH+2*BevelExtend+5);
  1102.    if FDrawFreqScale then
  1103.       H := Max(H,SCALEHEIGHT+2*BevelExtend+5);
  1104. end;
  1106. {-- TMMSpectrum ---------------------------------------------------------}
  1107. procedure TMMSpectrum.AdjustBounds;
  1108. var
  1109.   W, H: Integer;
  1111. begin
  1112.    W := Width;
  1113.    H := Height;
  1114.    AdjustSize(W, H);
  1115.    if (W <> Width) or (H <> Height) then SetBounds(Left, Top, W, H)
  1116.    else Changed;
  1117. end;
  1119. {-- TMMSpectrum ---------------------------------------------------------}
  1120. procedure TMMSpectrum.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  1121. var
  1122.   W, H: Integer;
  1124. begin
  1125.    W := aWidth;
  1126.    H := aHeight;
  1127.    AdjustSize (W, H);
  1128.    inherited SetBounds(aLeft, aTop, W, H);
  1129.    Changed;
  1130. end;
  1132. {-- TMMSpectrum ---------------------------------------------------------}
  1133. procedure TMMSpectrum.Changed;
  1134. begin
  1135.    FClientRect := Rect(0,0,Width,Height);
  1137.    { make place for the amp scale }
  1138.    if FDrawAmpScale then
  1139.       InflateRect(FClientRect, -SCALEWIDTH,0);
  1141.    { make place for the freq scale }
  1142.    if FDrawFreqScale then
  1143.       dec(FClientRect.Bottom, SCALEHEIGHT);
  1145.    { and now for the bevel }
  1146.    InflateRect(FClientRect, -Bevel.BevelExtend, -Bevel.BevelExtend);
  1148.    { save the real height and width }
  1149.    FWidth  := Max(FClientRect.Right - FClientRect.Left,4);
  1150.    FHeight := Max(FClientRect.Bottom - FClientRect.Top,4);
  1152.    { adjust the dyn.array size }
  1153.    FreeArrays;
  1154.    CreateArrays(FWidth);
  1156.    { set the DIB sizes }
  1157.    DIBCanvas.SetBounds(0,0,FWidth,FHeight);
  1158.    FBarDIB.SetBounds(0,0,FWidth,FHeight);
  1160.    { recalculate the number of spots }
  1161.    CalcNumSpots;
  1162.    { calc the new bytes per Scope }
  1163.    SetBytesPerSpectrum;
  1165.    { recalc the scalings }
  1166.    SetupXScale;
  1168.    { init the data buffers }
  1169.    NeedData;
  1171.    inherited Changed;
  1172. end;
  1174. {-- TMMSpectrum ---------------------------------------------------------}
  1175. procedure TMMSpectrum.SetBytesPerSpectrum;
  1176. begin
  1177.    FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FFTLen;
  1178. end;
  1180. {-- TMMSpectrum ---------------------------------------------------------}
  1181. Procedure TMMSpectrum.SetPCMWaveFormat(wf: TPCMWaveFormat);
  1182. var
  1183.    pwfx: PWaveFormatEx;
  1185. begin
  1186.    pwfx := @wf;
  1187.    if not pcmIsValidFormat(pwfx) then
  1188.       raise EMMSpectrumError.Create(LoadResStr(IDS_INVALIDFORMAT));
  1190.    SampleRate := pwfx^.nSamplesPerSec;
  1191.    BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
  1192.    Mode := TMMMode(pwfx^.nChannels-1);
  1193. end;
  1195. {-- TMMSpectrum ---------------------------------------------------------}
  1196. function TMMSpectrum.GetPCMWaveFormat: TPCMWaveFormat;
  1197. var
  1198.    wfx: TWaveFormatEx;
  1199. begin
  1200.    pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
  1201.    Result := PPCMWaveFormat(@wfx)^;
  1202. end;
  1204. {-- TMMSpectrum ---------------------------------------------------------}
  1205. Procedure TMMSpectrum.SetBits(aValue: TMMBits);
  1206. begin
  1207.    if (aValue <> FBits) then
  1208.    begin
  1209.       FBits := aValue;
  1210.       SetBytesPerSpectrum;
  1211.       Invalidate;
  1212.    end;
  1213. end;
  1215. {-- TMMSpectrum ---------------------------------------------------------}
  1216. Procedure TMMSpectrum.SetChannel(aValue: TMMChannel);
  1217. begin
  1218.    if (aValue <> FChannel) then
  1219.    begin
  1220.       FChannel := aValue;
  1221.       SetBytesPerSpectrum;
  1222.       Invalidate;
  1223.    end;
  1224.    {$IFDEF WIN32}
  1225.    {$IFDEF TRIAL}
  1226.    {$DEFINE _HACK2}
  1227.    {$I MMHACK.INC}
  1228.    {$ENDIF}
  1229.    {$ENDIF}
  1230. end;
  1232. {-- TMMSpectrum ---------------------------------------------------------}
  1233. Procedure TMMSpectrum.SetMode(aValue: TMMMode);
  1234. begin
  1235.    if (aValue <> FMode) then
  1236.    begin
  1237.       FMode := aValue;
  1238.       SetBytesPerSpectrum;
  1239.       Invalidate;
  1240.    end;
  1241. end;
  1243. {-- TMMSpectrum ---------------------------------------------------------}
  1244. procedure TMMSpectrum.SetRefFreq(aValue: integer);
  1245. begin
  1246.    aValue := MinMax(aValue,1,44100);
  1247.    if (aValue <> FRefFreq) then
  1248.    begin
  1249.       FRefFreq := aValue;
  1251.       if LogAmp then SetupLogScales
  1252.       else SetupLinScales;
  1254.       { Re-initialize the buffers }
  1255.       ResetPeakValues;
  1256.       Invalidate;
  1257.    end;
  1258.    {$IFDEF WIN32}
  1259.    {$IFDEF TRIAL}
  1260.    {$DEFINE _HACK3}
  1261.    {$I MMHACK.INC}
  1262.    {$ENDIF}
  1263.    {$ENDIF}
  1264. end;
  1266. {-- TMMSpectrum ---------------------------------------------------------}
  1267. procedure TMMSpectrum.SetGain(aValue: TMMSpectrumGain);
  1268. begin
  1269.    if (aValue <> FGain) then
  1270.    begin
  1271.       FGain := aValue;
  1273.       FDeriv := Ord(FGain) div 2;
  1274.       FGain3db := Ord(FGain) - FDeriv * 2;
  1276.       if LogAmp then SetupLogScales
  1277.       else SetupLinScales;
  1279.       ResetPeakValues;
  1280.       Invalidate;
  1281.    end;
  1282.    {$IFDEF WIN32}
  1283.    {$IFDEF TRIAL}
  1284.    {$DEFINE _HACK3}
  1285.    {$I MMHACK.INC}
  1286.    {$ENDIF}
  1287.    {$ENDIF}
  1288. end;
  1290. {-- TMMSpectrum ---------------------------------------------------------}
  1291. procedure TMMSpectrum.SetVertScale;
  1292. begin
  1293.    { Change the vertical scale factor }
  1294.    aValue := MinMax(aValue, 1, 500);
  1295.    if (aValue <> GetVertScale) then
  1296.    begin
  1297.       Fys := 0.01 * aValue;
  1298.       if LogAmp then SetupLogScales
  1299.       else SetupLinScales;
  1300. {TODO: !!!}
  1301.       (* VK_UP: Increase the vertical scale factor }
  1302.       if LogAmp then
  1303.       begin
  1304.          if (Log_Base < 10) then
  1305.          begin
  1306.             inc(Logs, 1);
  1307.             inc(Log_Base, 1);
  1308.             if (Log_Base > 10) then
  1309.             begin
  1310.                Logs := Logs - (Log_Base-10);
  1311.                Log_Base := 10;
  1312.             end;
  1313.             Setup_LogScales;
  1314.          end;
  1315.       end;
  1316.       VK_DOWN: { Decrease the vertical scale factor }
  1317.       if LogAmp then
  1318.       begin
  1319.          if (Logs > 0) then
  1320.          begin
  1321.             dec(Logs, 1);
  1322.             dec(Log_Base, 1);
  1323.             if (Logs < 0) then
  1324.             begin
  1325.                dec(Log_Base, Logs);
  1326.                Logs := 0;
  1327.             end;
  1328.             Setup_LogScales;
  1329.          end;
  1330.       end*)
  1331.       ResetPeakValues;
  1332.       Invalidate;
  1333.    end;
  1334. end;
  1336. {-- TMMSpectrum ---------------------------------------------------------}
  1337. function TMMSpectrum.GetVertScale: integer;
  1338. begin
  1339.    Result := Round(Fys / 0.01);
  1340. end;
  1342. {-- TMMSpectrum ---------------------------------------------------------}
  1343. procedure TMMSpectrum.SetFreqScale(aValue: integer);
  1344. var
  1345.    i: integer;
  1347. begin
  1348.    aValue := MinMax(aValue,1,16);
  1349.    { Convert scale to a power of 2 }
  1350.    i := 0;
  1351.    while aValue > 1 do
  1352.    begin
  1353.       aValue := aValue shr 1;
  1354.       inc(i);
  1355.    end;
  1356.    if (i > 0) then aValue := aValue shl i;
  1358.    if (aValue <> Trunc(FFreqScaleFactor)) then
  1359.    begin
  1360.       FFreqScaleFactor := aValue;
  1361.       { Re-initialize the display }
  1362.       SetupXScale;
  1363.       NeedData;
  1364.       Invalidate;
  1365.    end;
  1366.    {$IFDEF WIN32}
  1367.    {$IFDEF TRIAL}
  1368.    {$DEFINE _HACK1}
  1369.    {$I MMHACK.INC}
  1370.    {$ENDIF}
  1371.    {$ENDIF}
  1372. end;
  1374. {-- TMMSpectrum ---------------------------------------------------------}
  1375. function TMMSpectrum.GetFreqScale: integer;
  1376. begin
  1377.    Result := Trunc(FFreqScaleFactor);
  1378. end;
  1380. {-- TMMSpectrum ---------------------------------------------------------}
  1381. procedure TMMSpectrum.SetDrawFreqScale(aValue: Boolean);
  1382. begin
  1383.    if (aValue <> FDrawFreqScale) then
  1384.    begin
  1385.       FDrawFreqScale := aValue;
  1386.       AdjustBounds;
  1387.       Refresh;
  1388.    end;
  1389.    {$IFDEF WIN32}
  1390.    {$IFDEF TRIAL}
  1391.    {$DEFINE _HACK2}
  1392.    {$I MMHACK.INC}
  1393.    {$ENDIF}
  1394.    {$ENDIF}
  1395. end;
  1397. {-- TMMSpectrum ---------------------------------------------------------}
  1398. procedure TMMSpectrum.SetDrawAmpScale(aValue: Boolean);
  1399. begin
  1400.    if (aValue <> FDrawAmpScale) then
  1401.    begin
  1402.       FDrawAmpScale := aValue;
  1403.       AdjustBounds;
  1404.       Refresh;
  1405.    end;
  1406.    {$IFDEF WIN32}
  1407.    {$IFDEF TRIAL}
  1408.    {$DEFINE _HACK3}
  1409.    {$I MMHACK.INC}
  1410.    {$ENDIF}
  1411.    {$ENDIF}
  1412. end;
  1414. {-- TMMSpectrum ---------------------------------------------------------}
  1415. procedure TMMSpectrum.SetDrawGrid(aValue: Boolean);
  1416. begin
  1417.    if (aValue <> FDrawGrid) then
  1418.    begin
  1419.       FDrawGrid := aValue;
  1420.       Invalidate;
  1421.    end;
  1422.    {$IFDEF WIN32}
  1423.    {$IFDEF TRIAL}
  1424.    {$DEFINE _HACK1}
  1425.    {$I MMHACK.INC}
  1426.    {$ENDIF}
  1427.    {$ENDIF}
  1428. end;
  1430. {-- TMMSpectrum ---------------------------------------------------------}
  1431. procedure TMMSpectrum.CMColorChanged(var Message: TMessage);
  1432. begin
  1433.    DrawInactiveSpots;
  1434.    inherited;
  1435. end;
  1437. {-- TMMSpectrum ---------------------------------------------------------}
  1438. Procedure TMMSpectrum.SetColors(Index: Integer; Value: TColor);
  1439. begin
  1440.    case Index of
  1441.         0: if FBar1Color = Value then exit else FBar1Color := Value;
  1442.         1: if FBar2Color = Value then exit else FBar2Color := Value;
  1443.         2: if FBar3Color = Value then exit else FBar3Color := Value;
  1444.         3: if FInact1Color = Value then exit else FInact1Color := Value;
  1445.         4: if FInact2Color = Value then exit else FInact2Color := Value;
  1446.         5: if FInact3Color = Value then exit else FInact3Color := Value;
  1447.         6: if FScaleTextColor = Value then exit else FScaleTextColor := Value;
  1448.         7: if FScaleLineColor = Value then exit else FScaleLineColor := Value;
  1449.         8: if FGridColor = Value then exit else FGridColor := Value;
  1450.         9: if FScaleBackColor = Value then exit else FScaleBackColor := Value;
  1451.    end;
  1452.    DrawInactiveSpots;
  1453.    Invalidate;
  1454. end;
  1456. {-- TMMSpectrum ---------------------------------------------------------}
  1457. Procedure TMMSpectrum.SetPoints(Index, aValue: integer);
  1458. begin
  1459.    if (aValue>=1) and (aValue<=100) then
  1460.    begin
  1461.       case Index of
  1462.          0: if FPoint1 = aValue then exit else FPoint1 := aValue;
  1463.          1: if FPoint2 = aValue then exit else FPoint2 := aValue;
  1464.       end;
  1465.       CalcNumSpots;
  1466.       Invalidate;
  1467.    end;
  1468. end;
  1470. {-- TMMSpectrum ---------------------------------------------------------}
  1471. Procedure TMMSpectrum.SetSpace(aValue: integer);
  1472. begin
  1473.    if (aValue <> FSpace) AND (aValue >= 0) AND (aValue <= 5) then
  1474.    begin
  1475.       FSpace := aValue;
  1476.       ResetPeakValues;
  1477.       DrawInactiveSpots;
  1478.       Invalidate;
  1479.    end;
  1480. end;
  1482. {-- TMMSpectrum ---------------------------------------------------------}
  1483. Procedure TMMSpectrum.SetSpotSpace(aValue: integer);
  1484. begin
  1485.    if (aValue <> FSpotSpace) AND (aValue >= 0) AND (aValue <= 10) then
  1486.    begin
  1487.       FSpotSpace := aValue;
  1488.       CalcNumSpots;
  1489.       ResetPeakValues;
  1490.       Invalidate;
  1491.    end;
  1492.    {$IFDEF WIN32}
  1493.    {$IFDEF TRIAL}
  1494.    {$DEFINE _HACK1}
  1495.    {$I MMHACK.INC}
  1496.    {$ENDIF}
  1497.    {$ENDIF}
  1498. end;
  1500. {-- TMMSpectrum ---------------------------------------------------------}
  1501. Procedure TMMSpectrum.SetSpotHeight(aValue: integer);
  1502. begin
  1503.    if (aValue <> FSpotHeight) and (aValue > 0) and (aValue <= FHeight div 3) then
  1504.    begin
  1505.       FSpotHeight := aValue;
  1506.       CalcNumSpots;
  1507.       ResetPeakValues;
  1508.       Invalidate;
  1509.    end;
  1510.    {$IFDEF WIN32}
  1511.    {$IFDEF TRIAL}
  1512.    {$DEFINE _HACK2}
  1513.    {$I MMHACK.INC}
  1514.    {$ENDIF}
  1515.    {$ENDIF}
  1516. end;
  1518. {-- TMMSpectrum ---------------------------------------------------------}
  1519. procedure TMMSpectrum.SetDrawInactive(aValue: Boolean);
  1520. begin
  1521.    if (aValue <> FDrawInactive) then
  1522.    begin
  1523.       FDrawInactive := aValue;
  1524.       Invalidate;
  1525.    end;
  1526. end;
  1528. {-- TMMSpectrum ---------------------------------------------------------}
  1529. procedure TMMSpectrum.SetInactiveDoted(aValue: Boolean);
  1530. begin
  1531.    if (aValue <> FInactiveDoted) then
  1532.    begin
  1533.       FInactiveDoted := aValue;
  1534.       DrawInactiveSpots;
  1535.       Invalidate;
  1536.    end;
  1537.    {$IFDEF WIN32}
  1538.    {$IFDEF TRIAL}
  1539.    {$DEFINE _HACK1}
  1540.    {$I MMHACK.INC}
  1541.    {$ENDIF}
  1542.    {$ENDIF}
  1543. end;
  1545. {-- TMMSpectrum ---------------------------------------------------------}
  1546. procedure TMMSpectrum.SetActiveDoted(aValue: Boolean);
  1547. begin
  1548.    if (aValue <> FActiveDoted) then
  1549.    begin
  1550.       FActiveDoted := aValue;
  1551.       Invalidate;
  1552.    end;
  1553.    {$IFDEF WIN32}
  1554.    {$IFDEF TRIAL}
  1555.    {$DEFINE _HACK2}
  1556.    {$I MMHACK.INC}
  1557.    {$ENDIF}
  1558.    {$ENDIF}
  1559. end;
  1561. {-- TMMSpectrum ---------------------------------------------------------}
  1562. procedure TMMSpectrum.SetPeakDelay(aValue: integer);
  1563. begin
  1564.    if (aValue <> FPeakDelay) AND (aValue >= 0) AND (aValue <= 50) then
  1565.    begin
  1566.       FPeakDelay := aValue;
  1567.       ResetPeakValues;
  1568.       Invalidate;
  1569.    end;
  1570.    {$IFDEF WIN32}
  1571.    {$IFDEF TRIAL}
  1572.    {$DEFINE _HACK3}
  1573.    {$I MMHACK.INC}
  1574.    {$ENDIF}
  1575.    {$ENDIF}
  1576. end;
  1578. {-- TMMSpectrum ---------------------------------------------------------}
  1579. procedure TMMSpectrum.SetPeakSpeed(aValue: integer);
  1580. begin
  1581.    if (aValue <> FPeakSpeed) AND (aValue >= 0) AND (aValue <= 50) then
  1582.    begin
  1583.       FPeakSpeed := aValue;
  1584.       ResetPeakValues;
  1585.       Invalidate;
  1586.    end;
  1587.    {$IFDEF WIN32}
  1588.    {$IFDEF TRIAL}
  1589.    {$DEFINE _HACK1}
  1590.    {$I MMHACK.INC}
  1591.    {$ENDIF}
  1592.    {$ENDIF}
  1593. end;
  1595. {-- TMMSpectrum ---------------------------------------------------------}
  1596. procedure TMMSpectrum.SetNumPeaks(aValue: integer);
  1597. begin
  1598.    if (aValue <> FNumPeaks) AND (aValue >= 0) AND (aValue <= 5) then
  1599.    begin
  1600.       FNumPeaks := aValue;
  1601.       ResetPeakValues;
  1602.       if (FNumPeaks = 0) then
  1603.          MMTimeSuspendEvent(FTimerID)
  1604.       else if FEnabled then
  1605.          MMTimeResumeEvent(FTimerID);
  1606.       Invalidate;
  1607.    end;
  1608.    {$IFDEF WIN32}
  1609.    {$IFDEF TRIAL}
  1610.    {$DEFINE _HACK2}
  1611.    {$I MMHACK.INC}
  1612.    {$ENDIF}
  1613.    {$ENDIF}
  1614. end;
  1616. {-- TMMSpectrum ---------------------------------------------------------}
  1617. procedure TMMSpectrum.SetDisplayPeak(aValue: Boolean);
  1618. begin
  1619.    if (aValue <> FDisplayPeak) then
  1620.    begin
  1621.       FDisplayPeak := aValue;
  1622.       Invalidate;
  1623.    end;
  1624. end;
  1626. {-- TMMSpectrum ---------------------------------------------------------}
  1627. function TMMSpectrum.GetPeak: TPeak;
  1628. var
  1629.    re,im: Float;
  1631. begin
  1632.    with FPeak do
  1633.    begin
  1634.       if (FDecayMode <> dmNone) then
  1635.       begin
  1636.          re := FDisplayVal^[index]/16.0;
  1637.          im := 0;
  1638.       end
  1639.       else
  1640.       begin
  1641.          {$IFDEF WIN32}
  1642.          re := FFFTData^[2*index];
  1643.          im := FFFTData^[2*index+1];
  1644.          {$ELSE}
  1645.          re := FFFTData^[FFT.BitReversed^[index]];
  1646.          im := FFFTData^[FFT.BitReversed^[index]+1];
  1647.          {$ENDIF}
  1648.       end;
  1650.       amp := sqrt(re*re+im*im)/32768.0;
  1652.       if (FGain3db > 0) then
  1653.          amp := amp * sqrt((index+1)*FSampleRate/FFTLen/FRefFreq);
  1655.       if (FDeriv = 1) then
  1656.          amp := amp * FSampleRate/(2*M_PI*FRefFreq);
  1658.       if (FDeriv = 2) then
  1659.          amp := amp * FSampleRate/(2*M_PI*FRefFreq)
  1660.             * FSampleRate/(2*M_PI*FRefFreq);
  1662.       if (amp <> 0) and (FPeak.Amplitude > 0) then
  1663.       begin
  1664.          db := 20*log10(amp);
  1665.          if FLogFreq then
  1666.          begin
  1667.             if index <= 1 then Freq := (index+0.25) * FSampleRate/FFTLen
  1668.             else Freq := index * FSampleRate/FFTLen;
  1669.          end
  1670.          else Freq := (index+0.5) * FSampleRate/FFTLen;
  1671.       end
  1672.       else
  1673.       begin
  1674.          amp := 0;
  1675.          db := -100;
  1676.          Freq := 0;
  1677.       end;
  1678.    end;
  1679.    Result := FPeak;
  1680. end;
  1682. {-- TMMSpectrum ---------------------------------------------------------}
  1683. { Set up logarithmic amplitude (Y) scale factors and offsets. }
  1684. procedure TMMSpectrum.SetupLogScales;
  1685. var
  1686.    i: integer;
  1687.    Scale,Base,Convert,Offset: Float;
  1689. begin
  1690.    if not(csLoading in ComponentState) then
  1691.    begin
  1692.       { Compute the (logarithmic) y scale factor and offset.
  1693.         This may include a 3dB/octave gain.
  1695.         Conversion factor from db/10 to dPhils (the computed "unit")
  1696.         where a factor of 2 yields 16384 dPhils (6.02dB)
  1697.         Scaling factor is such that  32768 ->   0.00 dB -> 245760 dPhils
  1698.                                 and      2 -> -84.29 dB ->  16384 dPhils
  1699.                                 and      1 -> -90.31 dB ->      0 dPhils
  1700.         i.e. dPhils=16384.0/log(2) * log(value)
  1701.         and changes of 6.02 dB = 16384 dPhils }
  1703.       Convert := 819.2*log(10)/log(2); { Scale for dB to dPhils conversion  }
  1704.       Offset := log10(32768)*20;       { Offset for db to dPhils conversion }
  1706.       { This value is used in the main program group to convert squared values
  1707.         amplitudes to dPhils using dPhils = log(value^2)*Log_ScaleFactor }
  1709.       FLogScaleFactor := 8192.0/log(2);
  1711.       Scale := FHeight/(10*(FLogBase-FLogs)*Convert);
  1712.       if (FDeriv = 0) then
  1713.          Base := (Offset-FLogBase*10)*Convert
  1714.       else if(FDeriv = 1) then
  1715.          Base := (Offset-log10(FSampleRate/(2*M_PI*FRefFreq))*20-FLogBase*10)*Convert
  1716.       else
  1717.          Base := (Offset-log10(FSampleRate/(2*M_PI*FRefFreq))*40-FLogBase*10)*Convert;
  1719.       FDispScaleFactor := Scale; { Save the unshifted version for avg. display mode }
  1721.       FShift := 0;
  1723.       {  Make maximum use of available bits
  1724.          (use only 12 bits--other 4 used for higher resolution in the data) }
  1726.       while (Scale < 4096) do
  1727.       begin
  1728.          Scale := Scale*2;
  1729.          inc(FShift);
  1730.       end;
  1732.       for i := 0 to FWidth-1 do
  1733.           FYScale^[i] := Floor(Scale+0.5);
  1735.       if (FGain3db > 0) then
  1736.       begin
  1737.          for i := 0 to (FFTLen div 2)-1 do
  1738.      FYBase^[i] := Floor(0.5+Base-log10((i+1)*FSampleRate/FFTLen/FRefFreq)*Convert*10);
  1739.       end
  1740.       else
  1741.       begin
  1742.          for i := 0 to (FFTLen div 2)-1 do
  1743.      FYBase^[i] := Floor(0.5+Base);
  1744.       end;
  1745.    end;
  1746. end;
  1748. {-- TMMSpectrum ---------------------------------------------------------}
  1749. { Set up linear amplitude (Y) scale factors }
  1750. procedure TMMSpectrum.SetupLinScales;
  1751. var
  1752.    i: integer;
  1753.    Scale: Float;
  1755. begin
  1756.    if not(csLoading in ComponentState) then
  1757.    begin
  1758.       { Compute the (linear) y scale factor.
  1759.         This may include  a 3dB/octave gain. }
  1761.       Scale := FHeight/(Fys*32768.0*sqrt(FRefFreq));
  1763.       FShift := 4; { Display data has an extra factor of 16 for better resolution }
  1765.       if (FDeriv = 1) then
  1766.       begin
  1767.          Scale := Scale*FSampleRate/(2*M_PI*FRefFreq);
  1768.       end
  1769.       else if (FDeriv = 2) then
  1770.       begin
  1771.          Scale := Scale*FSampleRate*FSampleRate/(4*M_PI*M_PI*FRefFreq*FRefFreq);
  1772.       end;
  1774.       { Make maximum use of available bits }
  1775.       if (FGain3db > 0) then
  1776.       begin
  1777.          { Make maximum use of available bits
  1778.          (use only 12 bits--other 4 used for higher resolution in the data) }
  1780.          while Scale*sqrt(FSampleRate/2) < 4096 do
  1781.          begin
  1782.     Scale := Scale*2;
  1783.     inc(FShift);
  1784.          end;
  1786.          for i := 0 to FWidth-1 do
  1787.          begin
  1788.     if (Fx1^[i] = -1) then FYScale^[i] := 0
  1789.     else FYScale^[i] := Round(Scale*sqrt((Fx1^[i]+1)*FSampleRate/FFTLen)+0.5);
  1790.          end;
  1791.       end
  1792.       else
  1793.       begin
  1794.          { Make maximum use of available bits
  1795.          (use only 12 bits--other 4 used for higher resolution in the data) }
  1796.          Scale := Scale*sqrt(FRefFreq);
  1797.          while (Scale < 4096) do
  1798.          begin
  1799.     Scale := Scale*2;
  1800.     inc(FShift);
  1801.          end;
  1803.          for i := 0 to FWidth-1 do
  1804.          begin
  1805.     if (Fx1^[i] = -1) then FYScale^[i] := 0
  1806.     else FYScale^[i] := Floor(Scale+0.5);
  1807.          end;
  1808.       end;
  1809.    end;
  1810. end;
  1812. {-- TMMSpectrum ---------------------------------------------------------}
  1813. procedure TMMSpectrum.XRangeCheck;
  1814. var
  1815.    MaxBase: Float;
  1817. begin
  1818.    FFreqScaleFactor := MinMaxR(FFreqScaleFactor, 1.0, 16.0);
  1820.    if FLogFreq then
  1821.    begin
  1822.       MaxBase := FSampleRate/2/exp(log(FFTLen/2)/FFreqScaleFactor);
  1823.       FFreqBase := MinMaxR(FFreqBase, FSampleRate/FFTLen, MaxBase);
  1824.    end
  1825.    else
  1826.    begin
  1827.       FFreqBase := MaxR(FFreqBase, 0);
  1828.       if ((FFreqBase+FSampleRate/(2*FFreqScaleFactor))>FSampleRate/2) then
  1829.  FFreqBase := FSampleRate/2-FSampleRate/(2*FFreqScaleFactor);
  1830.    end;
  1831. end;
  1833. {-- TMMSpectrum ---------------------------------------------------------}
  1834. { Set up X axis scales }
  1835. procedure TMMSpectrum.SetupXScale;
  1836. var
  1837.    i,ival: Long;
  1839. begin
  1840.    if not(csLoading in ComponentState) then
  1841.    begin
  1842.       { Do some range checking on the base and scale factors }
  1843.       XRangeCheck;
  1845.       if assigned(FOnGetXScale) then FOnGetXScale(Self,Fx1,Fx2)
  1846.       else
  1847.       begin
  1848.          { Initialize graph x scale (linear or logarithmic).
  1849.            This array points to the bin to be plotted on a given line.}
  1851.          for i := 0 to FWidth-1 do
  1852.          begin
  1853.             if FLogFreq then
  1854.                ival := Floor(FFTLen*FFreqBase/FSampleRate*exp((i-0.45)/
  1855.                              FWidth*Log((FFTLen+1)/2)/FFreqScaleFactor)+0.51)-1
  1856.             else
  1857.                ival := Floor((i/FWidth*FFTLen/2.0/FFreqScaleFactor)+
  1858.                              (FFreqBase/FSampleRate*FFTLen)+0.01);
  1860.             ival := MinMax(ival,0,(FFTLen div 2)-1);
  1862.             Fx1^[i] := ival;
  1863.             if (i > 0) then Fx2^[i-1] := ival;
  1864.          end;
  1866.          { Compute the ending locations for lines holding multiple bins }
  1867.          for i := 0 to FWidth-1 do
  1868.              if (Fx2^[i] <= (Fx1^[i]+1)) then Fx2^[i] := 0;
  1869.       end;
  1871.       { If lines are repeated on the screen, flag this so that we don't
  1872.         have to recompute the y values. }
  1874.       for i := FWidth-1 downTo 1 do
  1875.       begin
  1876.          if (Fx1^[i] = Fx1^[i-1]) then
  1877.          begin
  1878.             Fx1^[i] := -1;
  1879.             Fx2^[i]:= 0;
  1880.          end;
  1881.       end;
  1883.       if FLogAmp then SetupLogScales
  1884.       else SetupLinScales;
  1886.       DrawInactiveSpots;
  1888.       if not (csDesigning in ComponentState) then
  1889.          FastDraw(DrawFrequencyScale,True)
  1890.       else
  1891.          Invalidate;
  1892.    end;
  1893. end;
  1895. {-- TMMSpectrum ---------------------------------------------------------}
  1896. function TMMSpectrum.GetFrequencyAtPos(Pos: TPoint): Float;
  1897. var
  1898.    Step: Float;
  1900. begin
  1901.    Result := 0;
  1902.    if PtInRect(FClientRect,Pos) then
  1903.    begin
  1904.       dec(Pos.X,FClientRect.Left);
  1905.       if (FLogFreq) then
  1906.       begin
  1907.          Step := log(FFTLen/2)/((FWidth-1)*FFreqScaleFactor);
  1908.          Result := MaxR(FFreqBase*exp(Pos.X*Step),0);
  1909.       end
  1910.       else
  1911.       begin
  1912.          Step := (FSampleRate/2-FFreqBase)/(FWidth-1)/FFreqScaleFactor;
  1913.          Result := MaxR(FFreqBase+Pos.X*Step,0);
  1914.       end;
  1915.    end;
  1916. end;
  1918. {-- TMMSpectrum ---------------------------------------------------------}
  1919. function TMMSpectrum.GetAmplitudeAtPos(Pos: TPoint): Float;
  1920. begin
  1921.    Result := 0;
  1922.    if PtInRect(FClientRect,Pos) then
  1923.    begin
  1924.       dec(Pos.Y,FClientRect.Top);
  1925.       if FLogAmp then
  1926.          Result := (Pos.Y*((FLogBase-FLogs)/(FHeight-1))+FLogs)*-10
  1927.       else
  1928.          Result := (FHeight-Pos.Y-1)*(10/(FHeight-1))*Fys*0.1;
  1929.    end;
  1930. end;
  1932. {-- TMMSpectrum ---------------------------------------------------------}
  1933. function TMMSpectrum.GetScaleBackColor: TColor;
  1934. begin
  1935.    {$IFNDEF BUILD_ACTIVEX}
  1936.    Result := TForm(Parent).Color;
  1937.    {$ELSE}
  1938.    Result := FScaleBackColor;
  1939.    {$ENDIF}
  1940. end;
  1942. {-- TMMSpectrum ---------------------------------------------------------}
  1943. procedure TMMSpectrum.DrawFrequencyScale(Dummy: Boolean);
  1944. var
  1945.    aBitmap: TBitmap;
  1946.    i, X: integer;
  1947.    Step, Freq: Float;
  1948.    Text: String;
  1949.    NumSteps: integer;
  1951. begin
  1952.    if FDrawFreqScale then
  1953.    begin
  1954.       aBitmap := TBitmap.Create;
  1955.       try
  1956.          aBitmap.Width := FWidth + 2*BevelExtend;
  1957.          aBitmap.Height := SCALEHEIGHT;
  1958.          aBitmap.Canvas.Font.Color := FScaleTextColor;
  1959.          aBitmap.Canvas.Pen.Color := FScaleLineColor;
  1960.          aBitmap.Canvas.Brush.Color := GetScaleBackColor;
  1961.          with aBitmap.Canvas do
  1962.          begin
  1963.             FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  1965.             { calc the number of steps required }
  1966.             NumSteps := 32;
  1967.             while (FWidth div NumSteps < SCALEFONTSIZE) do
  1968.             begin
  1969.                NumSteps := NumSteps div 2;
  1970.                if NumSteps = 1 then break;
  1971.             end;
  1973.             { Put up the frequency scale. }
  1974.             if (FLogFreq) then
  1975.                 Step := log(FFTLen/2)/(NumSteps*FFreqScaleFactor)
  1976.             else
  1977.                 Step := (FSampleRate/2-FFreqBase)/NumSteps/FFreqScaleFactor;
  1979.             MoveTo(BevelExtend,0);
  1980.             for i := 0 to NumSteps do
  1981.             begin
  1982.                X := BevelExtend + Round(i * (FWidth-1)/NumSteps);
  1983.                LineTo(X, 0);
  1984.                LineTo(X, 3);
  1985.                MoveTo(X, 0);
  1986.                if (FLogFreq) then
  1987.                    Freq := MaxR(FFreqBase*exp(Step*i),0)
  1988.                else
  1989.                    Freq := MaxR(FFreqBase+i*step,0);
  1991.                Text := Format('%.0f',[Freq]);
  1992.                TextOutAligned(aBitmap.Canvas,X,6,Text,SCALEFONT,SCALEFONTSIZE,2);{ vertical text }
  1993.             end;
  1994.          end;
  1995.          Canvas.Draw(FClientRect.Left-BevelExtend,
  1996.                      FClientRect.Bottom+BevelExtend+3, aBitmap);
  1998.       finally
  1999.          aBitmap.Free;
  2000.       end;
  2001.    end;
  2002. end;
  2004. {-- TMMSpectrum ---------------------------------------------------------}
  2005. procedure TMMSpectrum.DrawAmplitudeScale;
  2006. var
  2007.    aBitmap: TBitmap;
  2008.    i, X, Y, H: integer;
  2009.    Text: String;
  2010.    Scale: Float;
  2011.    NumSteps: integer;
  2013. begin
  2014.    { Put up the amplitude scale }
  2015.    if FDrawAmpScale then
  2016.    begin
  2017.       aBitmap := TBitmap.Create;
  2018.       try
  2019.          if FdrawFreqScale then
  2020.             H := Height-ScaleHeight
  2021.          else
  2022.             H := Height;
  2024.          aBitmap.Width := SCALEWIDTH;
  2025.          aBitmap.Height := H;
  2026.          aBitmap.Canvas.Font.Color := FScaleTextColor;
  2027.          aBitmap.Canvas.Pen.Color := FScaleLineColor;
  2028.          aBitmap.Canvas.Brush.Color := GetScaleBackColor;
  2029.          with aBitmap.Canvas do
  2030.          begin
  2031.             if (LogAmp) then
  2032.             begin
  2033.                { calc the number of steps required }
  2034.                NumSteps := (FLogBase-FLogs);
  2035.                while (FHeight div NumSteps < SCALEFONTSIZE) do
  2036.                begin
  2037.                   dec(NumSteps);
  2038.                   if NumSteps <= 1 then break;
  2039.                end;
  2041.                { draw the left side }
  2042.                FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  2043.                X := SCALEWIDTH-1;
  2044.                MoveTo(X, BevelExtend);
  2045.                for i := 0 to NumSteps do
  2046.                begin
  2047.                   Y := BevelExtend + Trunc(i*(FHeight-1)/NumSteps);
  2048.                   LineTo(X, Y);
  2049.                   LineTo(X-3, Y);
  2050.                   MoveTo(X, Y);
  2051.           Text := Format('%d',[Round((i*((FLogBase-FLogs)/NumSteps)+FLogs)*-10)]);
  2052.                   TextOutAligned(aBitmap.Canvas, X-4, Y, Text, SCALEFONT,SCALEFONTSIZE, 1);{ right text }
  2053.                end;
  2054.                Canvas.Draw(-3, 0, aBitmap);
  2056.                { draw the right side }
  2057.                FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  2058.                X := 0;
  2059.                MoveTo(X, BevelExtend);
  2060.                for i := 0 to NumSteps do
  2061.                begin
  2062.                   Y := BevelExtend + Trunc(i*(FHeight-1)/NumSteps);
  2063.                   LineTo(X, Y);
  2064.                   LineTo(X+3, Y);
  2065.                   MoveTo(X, Y);
  2066.                   Text := Format('%2.d',[Round((i*((FLogBase-FLogs)/NumSteps)+FLogs)*-10)]);
  2067.                   TextOutAligned(aBitmap.Canvas, X+6, Y, Text, SCALEFONT,SCALEFONTSIZE,0);
  2068.                end;
  2069.                Canvas.Draw((Width - SCALEWIDTH)+3, 0, aBitmap);
  2070.             end
  2071.             else
  2072.             begin
  2073.                { calc the number of steps required }
  2074.                NumSteps := 10;
  2075.                while (FHeight div NumSteps < SCALEFONTSIZE) do
  2076.                begin
  2077.                   dec(NumSteps);
  2078.                   if NumSteps <= 1 then break;
  2079.                end;
  2081.                { calc the scaling steps }
  2082.                Scale := (Fys*32768.0)/FHeight;
  2083.                { draw the left side }
  2084.                FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  2085.                X := SCALEWIDTH-1;
  2086.                MoveTo(X, H-BevelExtend-1);
  2087.                for i := 0 to NumSteps do
  2088.                begin
  2089.                   if (Fys > 0.095) then Text := Format('%4.2f',[i*(10/NumSteps)*Fys*0.1])
  2090.           else Text := Format('%5.3f',[i*(10/NumSteps)*Fys*0.1]);
  2091.                   Y := H-BevelExtend-Trunc(i*Fys*32760.0/NumSteps/Scale)-1;
  2092.                   LineTo(X, Y);
  2093.                   LineTo(X-3, Y);
  2094.                   MoveTo(X, Y);
  2095.           TextOutAligned(aBitmap.Canvas, X-5, Y, Text,SCALEFONT,SCALEFONTSIZE,1);{ right text }
  2096.                end;
  2097.                Canvas.Draw(-3, 0, aBitmap);
  2099.                { draw the right side }
  2100.                FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  2101.                X := 0;
  2102.                MoveTo(X, H-BevelExtend-1);
  2103.                for i := 0 to NumSteps do
  2104.                begin
  2105.                   if (Fys > 0.095) then Text := Format('%4.2f',[i*(10/NumSteps)*Fys*0.1])
  2106.           else Text := Format('%5.3f',[i*(10/NumSteps)*Fys*0.1]);
  2107.                   Y := H-BevelExtend-Trunc(i*Fys*32760.0/NumSteps/Scale)-1;
  2108.                   LineTo(X, Y);
  2109.                   LineTo(X+3, Y);
  2110.                   MoveTo(X, Y);
  2111.           TextOutAligned(aBitmap.Canvas, X+6, Y, Text, SCALEFONT,SCALEFONTSIZE,0);{ left text }
  2112.                end;
  2113.                Canvas.Draw((Width - SCALEWIDTH)+3, 0, aBitmap);
  2114.             end;
  2115.          end;
  2117.       finally
  2118.          aBitmap.Free;
  2119.       end;
  2120.    end;
  2121. end;
  2123. {-- TMMSpectrum ---------------------------------------------------------}
  2124. procedure TMMSpectrum.DrawGrids;
  2125. var
  2126.    i,X,Y,NumSteps: integer;
  2127.    Scale: Float;
  2129. begin
  2130.    if FDrawGrid then
  2131.    with DIBCanvas do
  2132.    begin
  2133.       DIB_SetTColor(FGridColor);
  2135.       { the horizontal lines }
  2136.       if (LogAmp) then
  2137.       begin
  2138.          { calc the number of steps required }
  2139.          NumSteps := (FLogBase-FLogs);
  2140.          while (FHeight div NumSteps < SCALEFONTSIZE) do
  2141.          begin
  2142.             dec(NumSteps);
  2143.             if NumSteps <= 1 then break;
  2144.          end;
  2146.          for i := 0 to NumSteps do
  2147.          begin
  2148.             Y := Trunc(i*(FHeight-1)/NumSteps);
  2149.             DIB_HLineDoted(0, FWidth, Y, 1);
  2150.          end;
  2151.       end
  2152.       else
  2153.       begin
  2154.          { calc the number of steps required }
  2155.          NumSteps := 10;
  2156.          while (FHeight div NumSteps < SCALEFONTSIZE) do
  2157.          begin
  2158.             dec(NumSteps);
  2159.             if NumSteps <= 1 then break;
  2160.          end;
  2161.          { calc the scale steps required }
  2162.          Scale := (Fys*32768.0)/FHeight;
  2163.          for i := 0 to NumSteps do
  2164.          begin
  2165.             Y := FHeight-Trunc(i*Fys*32760.0/NumSteps/Scale)-1;
  2166.             DIB_HLineDoted(0, FWidth, Y, 1);
  2167.          end;
  2168.       end;
  2170.       { the vertical lines }
  2172.       { calc the number of steps required }
  2173.       NumSteps := 32;
  2174.       while (FWidth div NumSteps < SCALEFONTSIZE) do
  2175.       begin
  2176.          NumSteps := NumSteps div 2;
  2177.          if NumSteps = 1 then break;
  2178.       end;
  2180.       for i := 0 to NumSteps do
  2181.       begin
  2182.          X := i * (FWidth-1) div NumSteps;
  2183.          DIB_VLineDoted(X, 0, FHeight, 1);
  2184.       end;
  2185.    end;
  2186. end;
  2188. {-- TMMSpectrum ---------------------------------------------------------}
  2189. procedure TMMSpectrum.RefreshPCMData(PCMData: Pointer);
  2190. var
  2191.    Value: Longint;
  2192.    i: Integer;
  2193.    ReIndex: integer;
  2194.    Back1, Back2: Long;                       { Variables for differencing }
  2195.    {$IFDEF WIN32}
  2196.    fTemp : array[0..MAX_FFTLen-1] of Float;
  2197.    {$ELSE}
  2198.    fTemp : array[0..MAX_FFTLen-1] of Smallint;
  2199.    {$ENDIF}
  2201. begin
  2202.    if FEnabled and Visible and not FShowInfoHint then
  2203.    begin
  2204.       ReIndex := Ord(FChannel)-1;
  2205.       if (FDeriv = 0) then
  2206.       begin
  2207.          { perform windowing on sample Data from PCMData to FFFTData }
  2208.          if (FBits = b8bit) then
  2209.             if (FMode = mMono) then
  2210.             for i := 0 to FFTLen-1 do
  2211.             begin
  2212.                Value := PByteArray(PCMData)^[i];
  2213.                if Value >= 255 then PcmOverflow;
  2214.                fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  2215.             end
  2216.             else if (FChannel = chBoth) then
  2217.             for i := 0 to FFTLen-1 do
  2218.             begin
  2219.                Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  2220.                if Value >= 255 then PcmOverflow;
  2221.                fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  2222.             end
  2223.             else
  2224.             for i := 0 to FFTLen-1 do
  2225.             begin
  2226.                Value := PByteArray(PCMData)^[i+i+ReIndex];
  2227.                if Value >= 255 then PcmOverflow;
  2228.                ftemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  2229.             end
  2230.          else
  2231.             if (FMode = mMono) then
  2232.             for i := 0 to FFTLen-1 do
  2233.             begin
  2234.                Value := PSmallArray(PCMData)^[i];
  2235.                if Value >= 32767 then PcmOverflow;
  2236.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  2237.             end
  2238.             else if (FChannel = chBoth) then
  2239.             for i := 0 to FFTLen-1 do
  2240.             begin
  2241.                Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  2242.                if Value >= 32766 then PcmOverflow;
  2243.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  2244.             end
  2245.             else
  2246.             for i := 0 to FFTLen-1 do
  2247.             begin
  2248.                Value := PSmallArray(PCMData)^[i+i+ReIndex];
  2249.                if Value >= 32767 then PcmOverflow;
  2250.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  2251.             end;
  2252.       end
  2253.       else if (FDeriv = 1) then
  2254.       begin
  2255.          { perform windowing on sample Data from PCMData to FFFTData }
  2256.          if (FBits = b8bit) then
  2257.          begin
  2258.             if (FMode = mMono) then
  2259.             begin
  2260.                Back1 := PByteArray(PCMData)^[0];
  2261.                for i := 0 to FFTLen-1 do
  2262.                begin
  2263.                   Value := PByteArray(PCMData)^[i];
  2264.                   if Value >= 255 then PcmOverflow;
  2265.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  2266.                   Back1 := Value;
  2267.                end;
  2268.             end
  2269.             else if (FChannel = chBoth) then
  2270.             begin
  2271.                Back1 := PByteArray(PCMData)^[0];
  2272.                for i := 0 to FFTLen-1 do
  2273.                begin
  2274.                   Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  2275.                   if Value >= 255 then PcmOverflow;
  2276.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  2277.                   Back1 := Value;
  2278.                end;
  2279.             end
  2280.             else
  2281.             begin
  2282.                Back1 := PByteArray(PCMData)^[ReIndex];
  2283.                for i := 0 to FFTLen-1 do
  2284.                begin
  2285.                   Value := PByteArray(PCMData)^[i+i+ReIndex];
  2286.                   if Value >= 255 then PcmOverflow;
  2287.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  2288.                   Back1 := Value;
  2289.                end;
  2290.             end;
  2291.          end
  2292.          else
  2293.          begin
  2294.             if (FMode = mMono) then
  2295.             begin
  2296.                Back1 := PSmallArray(PCMData)^[0];
  2297.                for i := 0 to FFTLen-1 do
  2298.                begin
  2299.                   Value := PSmallArray(PCMData)^[i];
  2300.                   if Value >= 32767 then PcmOverflow;
  2301.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  2302.                   Back1 := Value;
  2303.                end;
  2304.             end
  2305.             else if (FChannel = chBoth) then
  2306.             begin
  2307.                Back1 := PSmallArray(PCMData)^[0];
  2308.                for i := 0 to FFTLen-1 do
  2309.                begin
  2310.                   Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  2311.                   if Value >= 32766 then PcmOverflow;
  2312.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  2313.                   Back1 := Value;
  2314.                end;
  2315.             end
  2316.             else
  2317.             begin
  2318.                Back1 := PSmallArray(PCMData)^[ReIndex];
  2319.                for i := 0 to FFTLen-1 do
  2320.                begin
  2321.                   Value := PSmallArray(PCMData)^[i+i+ReIndex];
  2322.                   if Value >= 32767 then PcmOverflow;
  2323.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  2324.                   Back1 := Value;
  2325.                end;
  2326.             end;
  2327.          end;
  2328.       end
  2329.       else { Deriv = 2 }
  2330.       begin
  2331.          { perform windowing on sample Data from PCMData to FFFTData }
  2332.          if (FBits = b8bit) then
  2333.          begin
  2334.             if (FMode = mMono) then
  2335.             begin
  2336.                Back1 := PByteArray(PCMData)^[0];
  2337.                Back2 := Back1;
  2338.                for i := 0 to FFTLen-1 do
  2339.                begin
  2340.                   Value := PByteArray(PCMData)^[i];
  2341.                   if Value >= 255 then PcmOverflow;
  2342.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  2343.                   Back2 := Back1;
  2344.                   Back1 := Value;
  2345.                end;
  2346.             end
  2347.             else if (FChannel = chBoth) then
  2348.             begin
  2349.                Back1 := PByteArray(PCMData)^[0];
  2350.                Back2 := Back1;
  2351.                for i := 0 to FFTLen-1 do
  2352.                begin
  2353.                   Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  2354.                   if Value >= 255 then PcmOverflow;
  2355.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  2356.                   Back2 := Back1;
  2357.                   Back1 := Value;
  2358.                end;
  2359.             end
  2360.             else
  2361.             begin
  2362.                Back1 := PByteArray(PCMData)^[ReIndex];
  2363.                Back2 := Back1;
  2364.                for i := 0 to FFTLen-1 do
  2365.                begin
  2366.                   Value := PByteArray(PCMData)^[i+i+ReIndex];
  2367.                   if Value >= 255 then PcmOverflow;
  2368.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  2369.                   Back2 := Back1;
  2370.                   Back1 := Value;
  2371.                end;
  2372.             end;
  2373.          end
  2374.          else
  2375.          begin
  2376.             if (FMode = mMono) then
  2377.             begin
  2378.                Back1 := PSmallArray(PCMData)^[0];
  2379.                Back2 := Back1;
  2380.                for i := 0 to FFTLen-1 do
  2381.                begin
  2382.                   Value := PSmallArray(PCMData)^[i];
  2383.                   if Value >= 32767 then PcmOverflow;
  2384.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  2385.                   Back2 := Back1;
  2386.                   Back1 := Value;
  2387.                end;
  2388.             end
  2389.             else if (FChannel = chBoth) then
  2390.             begin
  2391.                Back1 := PSmallArray(PCMData)^[0];
  2392.                Back2 := Back1;
  2393.                for i := 0 to FFTLen-1 do
  2394.                begin
  2395.                   Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  2396.                   if Value >= 32767 then PcmOverflow;
  2397.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  2398.                   Back2 := Back1;
  2399.                   Back1 := Value;
  2400.                end;
  2401.             end
  2402.             else
  2403.             begin
  2404.                Back1 := PSmallArray(PCMData)^[ReIndex];
  2405.                Back2 := Back1;
  2406.                for i := 0 to FFTLen-1 do
  2407.                begin
  2408.                   Value := PSmallArray(PCMData)^[i+i+ReIndex];
  2409.                   if Value >= 32767 then PcmOverflow;
  2410.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  2411.                   Back2 := Back1;
  2412.                   Back1 := Value;
  2413.                end;
  2414.             end;
  2415.          end;
  2416.       end;
  2418.       { calc the FFT }
  2419.       {$IFDEF WIN32}
  2420.       DoRealFFT(FpFFT,@fTemp, 1);
  2421.       for i := 0 to FFTLen-1 do FFFTData^[i] := Trunc(fTemp[i]/(FFTLen div 2));
  2422.       {$ELSE}
  2423.       for i := 0 to FFTLen-1 do FFFTData^[i] := fTemp[i];
  2424.       FFT.CalcFFT(Pointer(FFFTData));
  2425.       {$ENDIF}
  2427.       { calc the magnitude }
  2428.       CalcMagnitude(False);
  2430.       { next, put this data up on the display }
  2431.       FastDraw(DrawSpectrum,False);
  2432.    end;
  2433. end;
  2435. {-- TMMSpectrum ---------------------------------------------------------}
  2436. procedure TMMSpectrum.RefreshFFTData(FFTData: Pointer);
  2437. begin
  2438.    Move(PByte(FFTData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
  2439.    { calc the magnitude }
  2440.    CalcMagnitude(False);
  2441.    { next, put this data up on the display }
  2442.    FastDraw(DrawSpectrum,False);
  2443. end;
  2445. {-- TMMSpectrum ---------------------------------------------------------}
  2446. procedure TMMSpectrum.RefreshMagnitudeData(MagData: Pointer);
  2447. begin
  2448.    Move(PChar(MagData)^, FFFTData^, (FFTLen div 2)*sizeOf(Longint));
  2449.    { calc display values }
  2450.    CalcMagnitude(True);
  2451.    { next, put this data up on the display }
  2452.    FastDraw(DrawSpectrum,False);
  2453. end;
  2455. {-- TMMSpectrum ---------------------------------------------------------}
  2456. procedure TMMSpectrum.CalcMagnitude(MagnitudeForm: Boolean);
  2457. var
  2458.    i: integer;
  2459.    re,im: Long;
  2460.    a2,Root: Long;{ Variables for computing Sqrt/Log of Amplitude^2 }
  2462. begin
  2463.    { go through the data set and convert it to magnitude form }
  2464.    if (FDecayMode <> dmNone) or  (not FLogAmp) then
  2465.    begin
  2466.       { Use sqrt(a2) in averaging mode and linear-amplitude mode }
  2467.       inc(FDecayPtr);
  2468.       inc(FDecayCntAct);
  2470.       if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;
  2472.       if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;
  2474.       for i := 0 to (FFTLen div 2)-1 do
  2475.       begin
  2476.          if MagnitudeForm then
  2477.          begin
  2478.             Root := PLongArray(FFFTData)^[i];
  2479.          end
  2480.          else
  2481.          begin
  2482.             { Compute the magnitude }
  2483.             {$IFDEF WIN32}
  2484.             re := FFFTData^[i+i];
  2485.             im := FFFTData^[i+i+1];
  2486.             {$ELSE}
  2487.             re := FFFTData^[FFT.BitReversed^[i]];
  2488.             im := FFFTData^[FFT.BitReversed^[i]+1];
  2489.             {$ENDIF}
  2490.             a2 := re*re+im*im;
  2492.             { Watch for possible overflow }
  2493.             if (a2 < 0) then a2 := 0;
  2495.             { Use higher resolution only for small values }
  2496.             {$IFDEF USE_INTEGER_CODE}
  2497.     if (a2 > 4194304) then
  2498.     begin
  2499.        Root := 32;
  2500.        repeat
  2501.            Mask :=a2 div Root;
  2502.            Root := (Root+Mask) shr 1;
  2503.                until not (abs(Root-Mask) > 1);
  2504.        Root := Root*16;
  2505.             end
  2506.             else
  2507.     begin
  2508.        Root := 512;
  2509.        a2 := a2*256;
  2510.                repeat
  2511.            Mask := a2 div Root;
  2512.            Root := (Root+Mask) shr 1;
  2513.                until not (abs(root-mask) > 1);
  2514.             end;
  2515.             {$ELSE}
  2516.             Root := Trunc(sqrt(a2)*16);
  2517.             {$ENDIF}
  2518.          end;
  2520.  { In decay mode, need to average this value }
  2521.  case Ord(FDecayMode) of
  2522.     1: begin
  2523.                FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor;
  2524.                   if (Root >= FLastVal_F^[i]) then FLastVal_F^[i] := Root
  2525.                   else Root := Trunc(FLastVal_F^[i]);
  2526.                end;
  2527.             2: begin
  2528.   FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor+(1-FDecayFactor)*Root;
  2529.   Root := Floor(FLastVal_F^[i]);
  2530.                end;
  2531.             3: begin
  2532.                   FLastVal^[i] := FLastVal^[i] + (Root-FDataBuf^[FDecayPtr]^[i]);
  2533.                   FDataBuf^[FDecayPtr]^[i] := Root;
  2534.                   Root := FLastVal^[i] div FDecayCntAct;
  2535.                end;
  2536.          end;
  2537.  FDisplayVal^[i] := Root;
  2538.       end;
  2539.    end
  2540.    else { No averaging, log-amplitude mode }
  2541.    begin
  2542.       for i := 0 to (FFTLen div 2)-1 do
  2543.       begin
  2544.          if MagnitudeForm then
  2545.          begin
  2546.             Root := PLongArray(FFFTData)^[i];
  2547.          end
  2548.          else
  2549.          begin
  2550.             { Compute the magnitude }
  2551.             {$IFDEF WIN32}
  2552.             re := FFFTData^[i+i];
  2553.             im := FFFTData^[i+i+1];
  2554.             {$ELSE}
  2555.             re := FFFTData^[FFT.BitReversed^[i]];
  2556.             im := FFFTData^[FFT.BitReversed^[i]+1];
  2557.             {$ENDIF}
  2558.             a2 := re*re+im*im;
  2560.             { Watch for possible overflow }
  2561.             if (a2 < 0) then a2 := 0;
  2563.             {$IFDEF USE_INTEGER_CODE}
  2564.     Root := 32768;
  2565.     while (a2 >= 32) do
  2566.     begin
  2567.        Root := Root + 8192;
  2568.        a2 := a2 shr 1;
  2569.     end;
  2570.     Root := Root + _ln[a2]-FYBase^[i];
  2571.             {$ELSE}
  2572.     if (a2 > 0) then Root := Trunc(log(a2)*FLogScaleFactor-FYBase^[i])
  2573.     else Root := 0;
  2574.             {$ENDIF}
  2575.          end;
  2577.          if (Root < 0) then
  2578.             FDisplayVal^[i] := 0
  2579.          else
  2580.          FDisplayVal^[i] := Root;
  2581.       end;
  2582.    end;
  2583. end;
  2585. {-- TMMSpectrum ---------------------------------------------------------}
  2586. procedure TMMSpectrum.CalcDisplayValues;
  2587. var
  2588.    i, j, index, xval: integer;
  2589.    dv: Long;
  2591. begin
  2592.    dv := 0;
  2593.    j := 0;
  2594.    { In log-amp decay mode, need to do some special things }
  2595.    if (FDecayMode <> dmNone) and FLogAmp then
  2596.    begin
  2597.       i := 0;
  2598.       while i < FWidth do
  2599.       begin
  2600.          { If this line is the same as the previous one, just use the
  2601.            previous Y value.  Else go ahead and compute the value. }
  2602.          index := Fx1^[i];
  2603.          if (index <> -1) then
  2604.          begin
  2605.             if i > 0 then
  2606.             begin
  2607.                { save the display rect for this set of bins }
  2608.                FDrawVal^[j].Right := i;
  2609.                FDrawVal^[j].Value := dv;
  2610.                inc(j);
  2611.             end;
  2612.             FDrawVal^[j].Left := i;
  2613.     { Convert the amplitude values to log scale }
  2614.     dv := FDisplayVal^[index];
  2615.             if (Fx2^[i] > 0) then { Take the max of a set of bins }
  2616.             begin
  2617.                xval := index;
  2618.                while xval < Fx2^[i] do
  2619.        begin
  2620.           if (FDisplayVal^[xval] > dv) then
  2621.                   begin
  2622.      dv := FDisplayVal^[xval];
  2623.                      index := xval;
  2624.                   end;
  2625.                   inc(xval);
  2626.                end;
  2627.             end;
  2629.             if (dv > 0) then
  2630.                 dv := Trunc((log(dv/16.0)*2*FLogScaleFactor-FYBase^[index])
  2631.                              * FDispScaleFactor)
  2632.             else dv := 0;
  2634.             { new peak found ? }
  2635.             if (dv > FPeak.Amplitude) then
  2636.             begin
  2637.        FPeak.Amplitude := dv;
  2638.                FPeak.Index := Fx1^[i];
  2639.                FPeak.X := i;
  2640.             end;
  2642.             if dv >= FHeight then GainOverflow;
  2643.          end;
  2644.          inc(i);
  2645.       end;
  2646.    end
  2647.    else
  2648.    begin
  2649.       { For linear amplitude mode and log amp without decay }
  2650.       i := 0;
  2651.       while i < FWidth do
  2652.       begin
  2653.          { If this line is the same as the previous one, just use the previous
  2654.            Y value. Else go ahead and compute the value. }
  2655.          index := Fx1^[i];
  2656.          if (index <> -1) then
  2657.          begin
  2658.             if i > 0 then
  2659.             begin
  2660.                { save the display rect for this set of bins }
  2661.                FDrawVal^[j].Right := i;
  2662.                FDrawVal^[j].Value := dv;
  2663.                { now the next rect }
  2664.                inc(j);
  2665.             end;
  2666.             FDrawVal^[j].Left := i;
  2667.     dv := FDisplayVal^[index];
  2668.     if (Fx2^[i] > 0) then { Take the maximum of a set of bins }
  2669.     begin
  2670.        while (index < Fx2^[i]) do
  2671.                begin
  2672.           if (FDisplayVal^[index] > dv) then dv := FDisplayVal^[index];
  2673.                   inc(index);
  2674.                end;
  2675.             end;
  2677.             if (dv > 0) then dv := (dv * FYScale^[i]) shr FShift
  2678.             else dv := 0;
  2680.             { new peak found ? }
  2681.             if (dv > FPeak.Amplitude) then
  2682.             begin
  2683.        FPeak.Amplitude := dv;
  2684.        FPeak.Index := Fx1^[i];
  2685.                FPeak.X := i;
  2686.             end;
  2688.             if dv >= FHeight then GainOverflow;
  2689.          end;
  2690.          inc(i);
  2691.       end;
  2692.    end;
  2693.    { save the last value }
  2694.    FDrawVal^[j].Right := i;
  2695.    FDrawVal^[j].Value := dv;
  2696.    { and mark the end }
  2697.    FDrawVal^[j+1].Left := -1;
  2698. end;
  2700. {-- TMMSpectrum ---------------------------------------------------------}
  2701. procedure TMMSpectrum.SetOnDrawBar(aValue: TMMSpectrumDrawBar);
  2702. begin
  2703.    FOnDrawBar := aValue;
  2704.    if not assigned(FOnDrawBar) then DrawInactiveSpots;
  2705.    Invalidate;
  2706. end;
  2708. {-- TMMSpectrum ---------------------------------------------------------}
  2709. procedure TMMSpectrum.SetLocalVariables(DIB: TMMDIBCanvas);
  2710. begin
  2711.    with DIB do
  2712.    begin
  2713.       _DIB := DIB;
  2714.       _Bar1Color  := DIB_ColorToIndex(FBar1Color);
  2715.       _Bar2Color  := DIB_ColorToIndex(FBar2Color);
  2716.       _Bar3Color  := DIB_ColorToIndex(FBar3Color);
  2717.       _Inact1Color := DIB_ColorToIndex(FInact1Color);
  2718.       _Inact2Color := DIB_ColorToIndex(FInact2Color);
  2719.       _Inact3Color := DIB_ColorToIndex(FInact3Color);
  2720.       _NumSpots   := FNumSpots;
  2721.       _NumPeaks   := FNumPeaks;
  2722.       _SpotHeight := FSpotHeight;
  2723.       _SpotSpace  := FSpotSpace;
  2724.       _FirstSpace := FFirstSpace;
  2725.       _Space      := FSpace;
  2726.       _Point1Spot := FPoint1Spot;
  2727.       _Point2Spot := FPoint2Spot;
  2728.       _ActiveDoted  := FActiveDoted;
  2729.       _InactiveDoted:= FInactiveDoted;
  2730.       _DrawInactive := FDrawInactive;
  2731.       _Offset := 1;
  2732.       if (FKind = skScroll) then _Offset := FHeight-FHeight div 3;
  2733.    end;
  2734. end;
  2736. {-- TMMSpectrum ---------------------------------------------------------}
  2737. procedure TMMSpectrum.InitLocalVariables;
  2738. begin
  2739.    { copy some variables from the DIBCanvas unit to this scope to fix a bug in CBuilder 3.0 }
  2740.    _DIB_ORIENT   := DIB_ORIENT;
  2741.    _biBits       := biBits;
  2742.    _biBPP        := biBPP;
  2743.    _biWidth      := biWidth;
  2744.    _biHeight     := biHeight;
  2745.    _biScanWidth  := biScanWidth;
  2746.    _biLineDiff   := biLineDiff;
  2747.    _biColor      := biColor;
  2748.    _biSurface    := biSurface;
  2749.    _biPenPos     := biPenPos;
  2750.    _biClipRect   := biClipRect;
  2751. end;
  2753. {-- TMMSpectrum ---------------------------------------------------------}
  2754. procedure TMMSpectrum.DrawAsDots;
  2755. var
  2756.    i, Y: integer;
  2758. begin
  2759.    SetLocalVariables(DIBCanvas);
  2760.    with DIBCanvas do
  2761.    begin
  2762.       i := 0;
  2763.       while (FDrawVal^[i].Left <> -1) and (i < FWidth) do
  2764.       with FDrawVal^[i] do
  2765.       begin
  2766.          Y := MinMax(FHeight-Value-1,0,FHeight-1);
  2767.          if not FEnabled then DIB_SetTColor(_Inact1Color)
  2768.          else if Y <= _Point2Spot then DIB_SetColor(_Bar3Color)
  2769.          else if Y <= _Point1Spot then DIB_SetColor(_Bar2Color)
  2770.          else DIB_SetColor(_Bar1Color);
  2771.          DIB_HLine(Left, Right, Y);
  2772.          inc(i);
  2773.       end;
  2774.    end;
  2775. end;
  2777. {-- TMMSpectrum ---------------------------------------------------------}
  2778. procedure TMMSpectrum.DrawAsLines;
  2779. var
  2780.    i,y: integer;
  2782. begin
  2783.    SetLocalVariables(DIBCanvas);
  2785.    with DIBCanvas do
  2786.    begin
  2787.       if FEnabled then DIB_SetTColor(FBar1Color)
  2788.       else DIB_SetTColor(FInact1Color);
  2790.       DIB_MoveTo(0,MinMax(FHeight-FDrawVal^[0].Value-_Offset,0,FHeight-1));
  2791.       {$IFDEF USEASM}
  2792.       _biPenPos := biPenPos;
  2793.       {$ENDIF}
  2794.       i := 0;
  2795.       y := 0;
  2796.       while (FDrawVal^[i].Left <> -1) and (i < FWidth) do
  2797.       with FDrawVal^[i] do
  2798.       begin
  2799.          y := MinMax(FHeight-Value-_Offset,0,FHeight-1);
  2800.          {$IFDEF USEASM}
  2801.          if (BitsPerPixel <> 24) then
  2802.              PointedLineTo(Left+(Right-Left) div 2, y,(FKind = skScroll))
  2803.          else
  2804.              DIB_LineTo(Left+(Right-Left) div 2, y);
  2805.          {$ELSE}
  2806.          DIB_LineTo(Left+(Right-Left) div 2, y);
  2807.          {$ENDIF}
  2808.          inc(i);
  2809.       end;
  2810.       {$IFDEF USEASM}
  2811.       biPenPos := _biPenPos;
  2812.       {$ENDIF}
  2813.       if (BitsPerPixel <> 24) then DIB_LineTo(FWidth,y);
  2815.       if (FKind <> skScroll) and (FNumPeaks > 0) then
  2816.       begin
  2817.          i := 0;
  2818.          while (FDrawVal^[i].Left <> -1) and (i < FWidth) do
  2819.          with FDrawVal^[i] do
  2820.          begin
  2821.             if (Value >= Peak) and (Value > 0) then
  2822.             begin
  2823.                Peak := Value;
  2824.                PeakCnt := (FPeakDelay*2)+1;
  2825.             end;
  2826.             y := MinMax(FHeight-Peak-_Offset,0,FHeight-1);
  2827.             if (i = 0) then
  2828.             begin
  2829.                DIB_MoveTo(0,y);
  2830.                {$IFDEF USEASM}
  2831.                _biPenPos := biPenPos;
  2832.                {$ENDIF}
  2833.             end;
  2834.             {$IFDEF USEASM}
  2835.             if (BitsPerPixel <> 24) then
  2836.                 PointedLineTo(Left+(Right-Left) div 2, y,(FKind = skScroll))
  2837.             else
  2838.                 DIB_LineTo(Left+(Right-Left) div 2, y);
  2839.             {$ELSE}
  2840.             DIB_LineTo(Left+(Right-Left) div 2, y);
  2841.             {$ENDIF}
  2842.             inc(i);
  2843.          end;
  2844.          {$IFDEF USEASM}
  2845.          biPenPos := _biPenPos;
  2846.          {$ENDIF}
  2847.          DIB_LineTo(FWidth,y);
  2848.       end;
  2849.    end;
  2850. end;
  2852. {-- TMMSpectrum ---------------------------------------------------------}
  2853. procedure TMMSpectrum.DrawAsVLines;
  2854. var
  2855.    aRect: TRect;
  2856.    i, Y: integer;
  2858. begin
  2859.    SetLocalVariables(DIBCanvas);
  2860.    with DIBCanvas do
  2861.    begin
  2862.       i := 0;
  2863.       while (FDrawVal^[i].Left <> -1) and (i < FWidth) do
  2864.       with FDrawVal^[i] do
  2865.       begin
  2866.          Value := MinMax(Value,0,FHeight-1);
  2867.          Y := (FHeight + Value) div 2;
  2868.          aRect.Top := FHeight-Y-1;
  2869.          aRect.Bottom := Y+1;
  2870.          aRect.Left := Left;
  2871.          aRect.Right := Right;
  2872.          with aRect do
  2873.          begin
  2874.             if Right - Left <= 0 then Right := Left + 1;{ we don't accept <= 0 }
  2875.             if Right - Left > _Space then               { can we work with space ? }
  2876.             begin
  2877.                Left := Left + _Space div 2;
  2878.                Right := (Right + _Space div 2) - _Space;
  2879.             end;
  2880.             if FEnabled then
  2881.             begin
  2882.                if Value > _Point2Spot then
  2883.                begin
  2884.                   DIB_SetColor(_Bar3Color);
  2885.                   DIB_FillRect(aRect);
  2886.                   InflateRect(aRect,0,-(Value-_Point2Spot)div 2);
  2887.                   dec(Value,Value-_Point2Spot);
  2888.                end;
  2889.                if Value > _Point1Spot then
  2890.                begin
  2891.                   DIB_SetColor(_Bar2Color);
  2892.                   DIB_FillRect(aRect);
  2893.                   InflateRect(aRect,0,-(Value-_Point1Spot)div 2);
  2894.                end;
  2895.                DIB_SetColor(_Bar1Color);
  2896.                DIB_FillRect(aRect);
  2897.             end
  2898.             else
  2899.             begin
  2900.                DIB_SetColor(_Inact1Color);
  2901.                DIB_FillRect(aRect);
  2902.             end;
  2903.          end;
  2904.          inc(i);
  2905.       end;
  2906.    end;
  2907. end;
  2909. {-- TMMSpectrum ---------------------------------------------------------}
  2910. procedure TMMSpectrum.DrawAsBars;
  2911. var
  2912.    i: integer;
  2913.    nSpots,iMax: integer;
  2915. begin
  2916.    SetLocalVariables(DIBCanvas);
  2918.    if assigned(FOnDrawBar) then
  2919.       iMax := FHeight
  2920.    else
  2921.       iMax := FNumSpots;
  2923.    i := 0;
  2925.    while (FDrawVal^[i].Left <> -1) and (i < FWidth) do
  2926.    with FDrawVal^[i] do
  2927.    begin
  2928.       nSpots := MinMax(Round(Value/(FHeight/iMax)+0.5),0,iMax);
  2929.       if (nSpots >= Peak) and (nSpots > 0) and (FNumPeaks > 0) then
  2930.       begin
  2931.          Peak := nSpots;
  2932.          PeakCnt := (FPeakDelay*2)+1;
  2933.       end;
  2935.       if assigned(FOnDrawBar) then
  2936.          FOnDrawBar(Self,_DIB,Rect(Left,0,Right,FHeight),nSpots,Peak)
  2937.       else if (FKind = skBars) then
  2938.       begin
  2939.          {$IFDEF USEASM}
  2940.          if (BitsPerPixel <> 24) then
  2941.              DrawBar(Left,Right,nSpots,Peak)
  2942.          else
  2943.              DrawBar_Native(Left,Right,nSpots,Peak);
  2944.          {$ELSE}
  2945.          DrawBar_Native(Left,Right,nSpots,Peak);
  2946.          {$ENDIF}
  2947.       end
  2948.       else
  2949.       begin
  2950.          {$IFDEF USEASM}
  2951.          if (BitsPerPixel <> 24) then
  2952.              DrawBarPeak(Left,Right,nSpots,Peak)
  2953.          else
  2954.              DrawBarPeak_Native(Left,Right,nSpots,Peak);
  2955.          {$ELSE}
  2956.          DrawBarPeak_Native(Left,Right,nSpots,Peak);
  2957.          {$ENDIF}
  2958.       end;
  2960.       inc(i);
  2961.    end;
  2962. end;
  2964. {-- TMMSpectrum ---------------------------------------------------------}
  2965. procedure TMMSpectrum.DrawInactiveSpots;
  2966. var
  2967.    i, L: integer;
  2969. begin
  2970.    if not (csLoading in ComponentState) and not (csCreating in ControlState) and
  2971.       not assigned(FOnDrawBar) and ((FKind = skBars) or (FKind = skPeaks)) then
  2972.    begin
  2973.       SetLocalVariables(FBarDIB);
  2974.       _Bar1Color  := _Inact1Color;
  2975.       _Bar2Color  := _Inact2Color;
  2976.       _Bar3Color  := _Inact3Color;
  2977.       _ActiveDoted := _InactiveDoted;
  2978.       with _DIB do
  2979.       begin
  2980.          DIB_InitDrawing;
  2982.          InitLocalVariables;
  2984.          DIB_SetTColor(Color);
  2985.          DIB_Clear;
  2987.          L := 0;
  2989.          for i := 0 to FWidth-1 do
  2990.          begin
  2991.             { If this line is the same as the previous one, just use the
  2992.               previous Y value.  Else go ahead and compute the value. }
  2993.             if (Fx1^[i] <> -1) then
  2994.             begin
  2995.                { draw this bar }
  2996.                if i > 0 then
  2997.                begin
  2998.                   {$IFDEF USEASM}
  2999.                   if (BitsPerPixel <> 24) then
  3000.                       DrawBar(L,i,FNumSpots,0)
  3001.                   else
  3002.                       DrawBar_Native(L,i,FNumSpots,0);
  3003.                   {$ELSE}
  3004.                   DrawBar_Native(L,i,FNumSpots,0);
  3005.                   {$ENDIF}
  3006.                end;
  3007.                L := i;
  3008.             end;
  3009.          end;
  3010.          {$IFDEF USEASM}
  3011.          if (BitsPerPixel <> 24) then
  3012.              DrawBar(L,FWidth,FNumSpots,0)
  3013.          else
  3014.             DrawBar_Native(L,FWidth,FNumSpots,0);
  3015.          {$ELSE}
  3016.          DrawBar_Native(L,FWidth,FNumSpots,0);
  3017.          {$ENDIF}
  3018.          DIB_DoneDrawing;
  3019.       end;
  3020.    end;
  3021. end;
  3023. {$IFDEF USEASM}
  3024. {$IFDEF WIN32}{$L MMSPEC32.OBJ}{$ELSE}{$L MMSPEC16.OBJ}{$ENDIF}
  3025. {$F+}
  3026. procedure TMMSpectrum.DrawBar(X1,X2,nSpots, Peak: integer); external;
  3027. procedure TMMSpectrum.DrawBarPeak(X1,X2, nSpots, Peak: integer); external;
  3028. procedure TMMSpectrum.PointedLineTo(X,Y: integer; Pointed: Boolean); external;
  3029. {$F-}
  3030. {$ENDIF}
  3032. {-- TMMSpectrum ---------------------------------------------------------}
  3033. procedure TMMSpectrum.DrawBar_Native(X1, X2, nSpots, Peak: integer);
  3034. Var
  3035.    SpotRect: TRect;                                 { Spot draw rectangle }
  3036.    i,SpotInc: integer;
  3038. begin
  3039.    SpotInc    := FSpotHeight + FSpotSpace;
  3040.    if X2 - X1 <= 0 then X2 := X1 + 1;              { we don't accept <= 0 }
  3041.    if X2 - X1 > FSpace then                    { can we work with space ? }
  3042.    begin
  3043.       X1 := X1 + FSpace div 2;
  3044.       X2 := (X2 + FSpace div 2) - FSpace;
  3045.    end;
  3046.    SpotRect.Left := X1;
  3047.    SpotRect.Right := X2;
  3048.    SpotRect.Bottom := FHeight - _FirstSpace;
  3049.    SpotRect.Top := SpotRect.Bottom - _SpotHeight;
  3050.    with _DIB do
  3051.    begin
  3052.       DIB_SetColor(_Bar1Color);
  3053.       for i := 1 to nSpots do                  { draw the highlited spots }
  3054.       begin
  3055.          if i > _Point2Spot then DIB_SetColor(_Bar3Color)
  3056.          else if i > _Point1Spot then DIB_SetColor(_Bar2Color);
  3058.          DIB_FillRectDoted(SpotRect,_ActiveDoted);
  3059.          OffsetRect(SpotRect, 0, -SpotInc);
  3060.       end;
  3062.       if (_NumPeaks > 0) and (Peak > nSpots) then
  3063.       begin
  3064.          OffsetRect(SpotRect, 0, -((Peak-1)-nSpots)*SpotInc);
  3066.          for i := 0 to _NumPeaks-1 do          { draw the peak spots }
  3067.          begin
  3068.             if Peak-i  > _Point2Spot then DIB_SetColor(_Bar3Color)
  3069.             else if Peak-i > _Point1Spot then DIB_SetColor(_Bar2Color)
  3070.             else DIB_SetColor(_Bar1Color);
  3071.             DIB_FillRectDoted(SpotRect,_ActiveDoted);
  3072.             OffsetRect(SpotRect, 0, SpotInc);
  3073.          end;
  3074.       end;
  3075.    end;
  3076. end;
  3078. {-- TMMSpectrum ---------------------------------------------------------}
  3079. procedure TMMSpectrum.DrawBarPeak_Native(X1, X2, nSpots, Peak: integer);
  3080. Var
  3081.    SpotRect: TRect;                                 { Spot draw rectangle }
  3082.    i,SpotInc: integer;
  3084. begin
  3085.    if X2 - X1 <= 0 then X2 := X1 + 1;              { we don't accept <= 0 }
  3086.    if X2 - X1 > FSpace then                    { can we work with space ? }
  3087.    begin
  3088.       X1 := X1 + FSpace div 2;
  3089.       X2 := (X2 + FSpace div 2) - FSpace;
  3090.    end;
  3091.    SpotInc := FSpotHeight + FSpotSpace;
  3092.    SpotRect.Left := X1;
  3093.    SpotRect.Right := X2;
  3094.    with DIBCanvas do
  3095.    begin
  3096.       if (nSpots > 0) then
  3097.       begin
  3098.          SpotRect.Bottom := FHeight - _FirstSpace - ((nSpots-1)*SpotInc);
  3099.          SpotRect.Top := SpotRect.Bottom - _SpotHeight;
  3100.          if nSpots > _Point2Spot then DIB_SetColor(_Bar3Color)
  3101.          else if nSpots > _Point1Spot then DIB_SetColor(_Bar2Color)
  3102.          else DIB_SetColor(_Bar1Color);
  3103.          DIB_FillRectDoted(SpotRect,_ActiveDoted);
  3104.       end;
  3106.       if (_NumPeaks > 0) and (Peak > nSpots) then
  3107.       begin
  3108.          SpotRect.Bottom := FHeight - _FirstSpace - (Peak-1)*SpotInc;
  3109.          SpotRect.Top := SpotRect.Bottom - _SpotHeight;
  3110.          for i := 0 to _NumPeaks-1 do             { draw the peak spots }
  3111.          begin
  3112.             if Peak-i  > FPoint2Spot then DIB_SetColor(_Bar3Color)
  3113.             else if Peak-i > FPoint1Spot then DIB_SetColor(_Bar2Color)
  3114.             else DIB_SetColor(_Bar1Color);
  3115.             DIB_FillRectDoted(SpotRect,_ActiveDoted);
  3116.             OffsetRect(SpotRect, 0, SpotInc);
  3117.          end;
  3118.       end;
  3119.    end;
  3120. end;
  3122. {-- TMMSpectrum ---------------------------------------------------------}
  3123. procedure TMMSpectrum.DrawPeakValue;
  3124. var
  3125.    Border,Y: integer;
  3126.    Text: String;
  3128. begin
  3129.    if not (csDesigning in ComponentState) then
  3130.    begin
  3131.       if FDisplayPeak and (FPeak.Amplitude > 5) then
  3132.       with Canvas, FPeak do
  3133.       begin
  3134.          Font.Name := 'MS Sans Serif';
  3135.          Font.Style := [fsBold];
  3136.          Font.Size := 8;
  3137.          Font.Color := clWhite;
  3138.          Brush.Style := bsClear;
  3139.          if FLogFreq then
  3140.          begin
  3141.             if index <= 1 then Freq := (index+0.25) * FSampleRate/FFTLen
  3142.             else Freq := index * FSampleRate/FFTLen;
  3143.          end
  3144.          else Freq := (index+0.5) * FSampleRate/FFTLen;
  3145.          Text := TrimLeft(Format('%7.1f Hz',[Freq]));
  3146.          if X + TextWidth(Text) >= FWidth then X := FWidth-TextWidth(Text)-1;
  3147.          Y := Max((FHeight-Amplitude-_Offset)-TextHeight(Text),0);
  3148.          Border := BevelExtend;
  3149.          if FDrawAmpScale then inc(Border, SCALEWIDTH);
  3150.          TextOut(Border+X,BevelExtend+Y,Text);
  3151.          Font.Style := [];
  3152.          Brush.Style := bsSolid;
  3153.       end;
  3154.    end;
  3155. end;
  3157. {$IFDEF WIN32}
  3158. {-- TMMSpectrum --------------------------------------------------------}
  3159. procedure TMMSpectrum.DrawInfo(Pos: TPoint);
  3160. var
  3161.    Freq, Amp, Text: String;
  3162.    aRect: TRect;
  3163.    Buf: array[0..255] of char;
  3164.    DC: HDC;
  3165.    WindowHandle: HWND;
  3167. begin
  3168.    if FShowInfoHint then
  3169.    with DIBCanvas do
  3170.    begin
  3171.       if PtInRect(FClientRect,Pos) then
  3172.       begin
  3173.          Freq := Format('%2.3f KHz', [GetFrequencyAtPos(Pos)/1000]);
  3174.          if (FKind <> skScroll) then
  3175.          begin
  3176.             if FLogAmp then
  3177.                Amp := Format(' %2.1f dB',[GetAmplitudeAtPos(Pos)])
  3178.             else
  3179.             begin
  3180.                if (VerticalScale > 9) then
  3181.                   Amp := Format(' %4.2f V',[GetAmplitudeAtPos(Pos)])
  3182.                else
  3183.                   Amp := Format(' %5.3f V',[GetAmplitudeAtPos(Pos)]);
  3184.             end;
  3185.          end
  3186.          else Amp := '';
  3188.          Font.Name := 'MS Sans Serif';
  3189.          Font.Style := [];
  3190.          Font.Size := 8;
  3191.          {$IFDEF WIN32}
  3192.          Font.Color := clInfoText;
  3193.          {$ELSE}
  3194.          Font.Color := clBlack;
  3195.          {$ENDIF}
  3197.          Text := Freq+Amp;
  3198.          aRect.Left := Pos.X-BevelExtend;
  3199.          if FDrawAmpScale then dec(aRect.Left, SCALEWIDTH);
  3200.          aRect.Top := Pos.Y-BevelExtend+15;
  3201.          aRect.Right := aRect.Left + TextWidth(Text)+4;
  3202.          aRect.Bottom := aRect.Top + TextHeight(Text)+2;
  3203.          if (aRect.Bottom > FHeight) then OffsetRect(aRect,0,-40);
  3204.          if (aRect.Right > FWidth) then OffsetRect(aRect,FWidth-aRect.Right,0);
  3205.          if (aRect.Top < 0) then
  3206.          begin
  3207.             aRect.Top := 0;
  3208.             aRect.Bottom := TextHeight(Text)+2;
  3209.          end;
  3211.          if (SaveDC = 0) then
  3212.          begin
  3213.             { create memory DC for save bitmap }
  3214.             SaveDC := CreateCompatibleDC(DIBCanvas.Handle);
  3215.             { create bitmap to store background }
  3216.             SaveWidth := 10*TextWidth('W')+4;
  3217.             SaveHeight := TextHeight('W')+2;
  3218.             SaveBitmap := CreateCompatibleBitmap(DIBCanvas.Handle,SaveWidth,SaveHeight);
  3219.             OldBitmap := SelectObject(SaveDC, SaveBitmap);
  3220.          end
  3221.          else
  3222.             { restore background }
  3223.             BitBlt(DIBCanvas.Handle,SaveInfoPos.X,
  3224.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  3225.                    SaveDC,0,0,SRCCOPY);
  3227.          { save background }
  3228.          BitBlt(SaveDC,0,0,SaveWidth,SaveHeight,
  3229.                 DIBCanvas.Handle,aRect.Left,aRect.Top,SRCCOPY);
  3231.          SaveInfoPos := aRect.TopLeft;
  3233.          Brush.Color := INFOCOLOR;
  3234.          Brush.Style := bsSolid;
  3235.          Pen.Color := clBlack;
  3236.          Rectangle(aRect.Left,aRect.Top,aRect.Right,aRect.Bottom);
  3237.          Brush.Style := bsClear;
  3238.          DrawText(Handle, StrPCopy(Buf, Text), -1, aRect,
  3239.                   DT_SINGLELINE  or DT_VCENTER or DT_CENTER or DT_NOPREFIX);
  3240.          Brush.Style := bsSolid;
  3241.       end
  3242.       else if (SaveBitmap <> 0) then
  3243.       begin
  3244.          { restore background }
  3245.          BitBlt(DIBCanvas.Handle,SaveInfoPos.X,
  3246.                 SaveInfoPos.Y,SaveWidth,SaveHeight,
  3247.                 SaveDC,0,0,SRCCOPY);
  3248.       end;
  3249.       DIB_InitDrawing;                                  { copy to screen }
  3250.       DC := GetDeviceContext(WindowHandle);
  3251.       DIBCanvas.DIB_BitBlt(DC, FClientRect,0,0);
  3252.       ReleaseDC(WindowHandle, DC);
  3253.       DIB_DoneDrawing;
  3255.       DrawPeakValue;
  3256.    end;
  3257. end;
  3258. {$ELSE}
  3259. {-- TMMSpectrum --------------------------------------------------------}
  3260. procedure TMMSpectrum.DrawInfo(Pos: TPoint);
  3261. var
  3262.    Freq, Amp, Text: String;
  3263.    aRect: TRect;
  3264.    Buf: array[0..255] of char;
  3265.    Border: integer;
  3267. begin
  3268.    if FShowInfoHint then
  3269.    with Canvas do
  3270.    begin
  3271.       if PtInRect(FClientRect,Pos) then
  3272.       begin
  3273.          Freq := Format('%2.3f KHz', [GetFrequency(Pos)/1000]);
  3274.          if (FKind <> skScroll) then
  3275.          begin
  3276.             if FLogAmp then
  3277.                Amp := Format(' %2.1f dB',[GetAmplitude(Pos)])
  3278.             else
  3279.             begin
  3280.                if (VerticalScale > 9) then
  3281.                    Amp := Format(' %4.2f V',[GetAmplitude(Pos)])
  3282.                else
  3283.                    Amp := Format(' %5.3f V',[GetAmplitude(Pos)]);
  3284.             end;
  3285.          end
  3286.          else Amp := '';
  3287.          Font.Name := 'MS Sans Serif';
  3288.          Font.Size := 8;
  3289.          {$IFDEF WIN32}
  3290.          Font.Color := clInfoText;
  3291.          {$ELSE}
  3292.          Font.Color := clBlack;
  3293.          {$ENDIF}
  3295.          Text := Freq+Amp;
  3296.          aRect.Left := Pos.X;
  3297.          aRect.Top := Pos.Y+15;
  3298.          aRect.Right := aRect.Left + TextWidth(Text)+4;
  3299.          aRect.Bottom := aRect.Top + TextHeight(Text)+2;
  3301.          Border := BevelExtend;
  3302.          if FDrawFreqScale then inc(Border,SCALEWIDTH);
  3303.          if (aRect.Bottom > Height-Border) then OffsetRect(aRect,0,-40);
  3304.          Border := BevelExtend;
  3305.          if FDrawAmpScale then inc(Border,SCALEWIDTH);
  3306.          if (aRect.Right > Width-Border) then OffsetRect(aRect,Width-Border-aRect.Right,0);
  3307.          if (aRect.Top < 0) then
  3308.          begin
  3309.             aRect.Top := 0;
  3310.             aRect.Bottom := TextHeight(Text)+2;
  3311.          end;
  3313.          if (SaveDC = 0) then
  3314.          begin
  3315.             { create memory DC for save bitmap }
  3316.             SaveDC := CreateCompatibleDC(Canvas.Handle);
  3317.             { create bitmap to store background }
  3318.             SaveWidth := 10*TextWidth('W')+4;
  3319.             SaveHeight := TextHeight('W')+2;
  3320.             SaveBitmap := CreateCompatibleBitmap(Canvas.Handle,SaveWidth,SaveHeight);
  3321.             OldBitmap := SelectObject(SaveDC, SaveBitmap);
  3322.          end
  3323.          else
  3324.             { restore background }
  3325.             BitBlt(Canvas.Handle,SaveInfoPos.X,
  3326.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  3327.                    SaveDC,0,0,SRCCOPY);
  3329.          { save background }
  3330.          BitBlt(SaveDC,0,0,SaveWidth,SaveHeight,
  3331.                 Canvas.Handle,aRect.Left,aRect.Top,SRCCOPY);
  3333.          SaveInfoPos := aRect.TopLeft;
  3335.          Brush.Color := INFOCOLOR;
  3336.          Brush.Style := bsSolid;
  3337.          Pen.Color := clBlack;
  3338.          Rectangle(aRect.Left,aRect.Top,aRect.Right,aRect.Bottom);
  3339.          Brush.Style := bsClear;
  3340.          DrawText(Handle, StrPCopy(Buf, Text), -1, aRect,
  3341.                   DT_SINGLELINE  or DT_VCENTER or DT_CENTER or DT_NOPREFIX);
  3342.          Brush.Style := bsSolid;
  3343.       end
  3344.       else if (SaveDC <> 0) then
  3345.       begin
  3346.          { restore background }
  3347.          BitBlt(Canvas.Handle,SaveInfoPos.X,
  3348.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  3349.                    SaveDC,0,0,SRCCOPY);
  3350.       end;
  3351.    end;
  3352. end;
  3353. {$ENDIF}
  3355. {-- TMMSpectrum ---------------------------------------------------------}
  3356. procedure TMMSpectrum.DrawSpectrum(Clear: Boolean);
  3357. Label Calc;
  3358. begin                                             { reset the peak index }
  3359.    FPeak.Amplitude := 0;
  3360.    FPeak.Index := 0;
  3362.    DIBCanvas.DIB_InitDrawing;
  3364.    InitLocalVariables;
  3365.                                           { Clear background or draw DIB }
  3366.    if (FKind <> skScroll) or Clear then
  3367.    begin
  3368.       if not assigned(FOnDrawBar) then
  3369.       begin
  3370.          if ((FKind = skBars) or (FKind = skPeaks)) and FDrawInactive then
  3371.          begin
  3372.              DIBCanvas.DIB_CopyDIBBits(FBarDIB.Surface,0,0,FWidth,FHeight,0,0);
  3373.              goto Calc;
  3374.          end
  3375.          else if (FKind <> skScroll) then
  3376.          begin
  3377.             if assigned(FOnClearBackground) then
  3378.                FOnClearBackground(Self, DIBCanvas, Rect(0,0,FWidth,FHeight))
  3379.             else
  3380.                DrawBackGround;
  3381.             goto Calc;
  3382.          end;
  3383.       end;
  3384.       if assigned(FOnClearBackground) then
  3385.       begin
  3386.          FOnClearBackground(Self, DIBCanvas, Rect(0,0,FWidth,FHeight));
  3387.       end
  3388.       else
  3389.       begin
  3390.          DIBCanvas.DIB_SetTColor(Color);
  3391.          DIBCanvas.DIB_Clear;
  3392.       end;
  3393.    end
  3394.    else if (FKind = skScroll) and not (csDesigning in ComponentState) then
  3395.    begin                                                   { scroll down }
  3396.       DIBCanvas.DIB_CopyDIBBits(biSurface,0,SCROLLDISTANCE,FWidth,FHeight-SCROLLDISTANCE,0,0);
  3397.       DIBCanvas.DIB_SetTColor(Color);
  3398.       DIBCanvas.DIB_FillRect(Rect(0,0,FWidth,SCROLLDISTANCE));
  3399.    end;
  3401. Calc:
  3402.    CalcDisplayValues;                    { calculate the amplitude values }
  3404.    if (FKind <> skScroll) then DrawGrids;                 { draw the grid }
  3406.    case FKind of                            { draw the spectrum to bitmap }
  3407.       skDots  : DrawAsDots;
  3408.       skLines,
  3409.       skScroll: DrawAsLines;
  3410.       skVLines: DrawAsVLines;
  3411.       skBars,
  3412.       skPeaks: DrawAsBars;
  3413.    end;
  3414.                                                          { copy to screen }
  3415.    DIBCanvas.DIB_BitBlt(Canvas.Handle, FClientRect,0,0);
  3417.    DIBCanvas.DIB_DoneDrawing;
  3419.    DrawPeakValue;                                   { Draw the Peak value }
  3420. end;
  3422. {-- TMMSpectrum ---------------------------------------------------------}
  3423. Procedure TMMSpectrum.Paint;
  3424. var
  3425.    H,L: integer;
  3426.    Text: String;
  3427.    aRect: TRect;
  3429. begin
  3430.    with Canvas do
  3431.    begin
  3432.       if FDrawFreqScale or FDrawAmpScale then
  3433.       begin
  3434.          { clear the space between the scales only, to eliminate flicker }
  3435.          Brush.Color := GetScaleBackColor;
  3436.          Brush.Style := bsSolid;
  3438.          if FDrawAmpScale then
  3439.          begin
  3440.             H := Height;
  3441.             if FDrawFreqScale then H := Height-SCALEHEIGHT;
  3443.             aRect := Rect(SCALEWIDTH-3,0,SCALEWIDTH,H);
  3444.             FillRect(aRect);
  3446.             aRect:= Rect(Width-SCALEWIDTH,0,Width-SCALEWIDTH+3,H);
  3447.             FillRect(aRect);
  3448.          end;
  3450.          if FDrawFreqScale then
  3451.          begin
  3452.             aRect:= Rect(0,Height-SCALEHEIGHT,Width,Height-SCALEHEIGHT+3);
  3453.             FillRect(aRect);
  3455.             if FdrawAmpScale then
  3456.             begin
  3457.                aRect:= Rect(0,Height-SCALEHEIGHT,SCALEWIDTH,Height);
  3458.                FillRect(aRect);
  3460.                aRect:= Rect(WIDTH-SCALEWIDTH,Height-SCALEHEIGHT,Width,Height);
  3461.                FillRect(aRect);
  3462.             end;
  3463.          end;
  3465.          { write scale text }
  3466.          Canvas.Font.Color := FScaleTextColor;
  3467.          if FDrawAmpScale and FDrawFreqScale then
  3468.          begin
  3469.             if LogAmp then
  3470.             begin
  3471.                Text := 'db';
  3472.                L := SCALEWIDTH-9;
  3473.             end
  3474.             else
  3475.             begin
  3476.                Text := 'V';
  3477.                L := SCALEWIDTH-16;
  3478.             end;
  3480.             TextOutAligned(Canvas, L, Height-SCALEWIDTH,
  3481.                            Text, SCALEFONT,SCALEFONTSIZE, 1);
  3482.             TextOutAligned(Canvas, Width-SCALEWIDTH+12, Height-SCALEWIDTH,
  3483.                            Text, SCALEFONT,SCALEFONTSIZE,0);
  3484.             TextOutAligned(Canvas, Width-SCALEWIDTH+2, Height-SCALEHEIGHT+20,
  3485.                            'Hz', SCALEFONT,SCALEFONTSIZE,0);
  3486.          end;
  3487.          
  3488.          { make place for the scale }
  3489.          aRect := GetClientRect;
  3490.          if FDrawAmpScale then InflateRect(aRect,-SCALEWIDTH,0);
  3491.          if FDrawFreqScale then dec(aRect.Bottom, SCALEHEIGHT);
  3492.       end
  3493.       else aRect := GetClientRect;
  3494.       { draw the Bevel and fill the real area }
  3495.       aRect := Bevel.PaintBevel(Canvas, aRect,True);
  3496.    end;
  3497.    { now draw scales and the the spectrum }
  3498.    DrawAmplitudeScale;
  3499.    DrawFrequencyScale(True);
  3500.    DrawSpectrum(True);
  3502.    {$IFDEF BUILD_ACTIVEX}
  3503.    if Selected then
  3504.    begin
  3505.       Canvas.Brush.Style := bsClear;
  3506.       Canvas.Pen.Color   := clRed;
  3507.       Canvas.Rectangle(0,0,Width,Height);
  3508.       Canvas.Brush.Style := bsSolid;
  3509.    end;
  3510.    {$ENDIF}
  3511. end;
  3513. {-- TMMSpectrum --------------------------------------------------------}
  3514. procedure TMMSpectrum.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3515. var
  3516.    aRect: TRect;
  3518. begin
  3519.    if not (csDesigning in ComponentState) and Enabled and (Button = mbLeft) and FShowInfo then
  3520.    begin
  3521.       aRect.TopLeft := ClientToScreen(FClientRect.TopLeft);
  3522.       aRect.BottomRight := ClientToScreen(FClientRect.BottomRight);
  3523.       ClipCursor(@aRect);
  3524.       FShowInfoHint := True;
  3526.       { maybe there is a hint, hide it }
  3527.       if ShowHint then
  3528.       begin
  3529.          FOldShowHint := ShowHint;
  3530.          ShowHint := False;
  3531.          Application.CancelHint;
  3532.          Update;
  3533.       end
  3534.       else FOldShowHint := False;
  3536.       DrawInfo(Point(X,Y));
  3537.    end;
  3539.    inherited MouseDown(Button, Shift, X, Y);
  3540. end;
  3542. {-- TMMSpectrum --------------------------------------------------------}
  3543. procedure TMMSpectrum.MouseMove(Shift: TShiftState; X, Y: Integer);
  3544. begin
  3545.    inherited MouseMove(Shift, X, Y);
  3547.    if FShowInfoHint then DrawInfo(Point(X,Y));
  3548. end;
  3550. {-- TMMSpectrum --------------------------------------------------------}
  3551. procedure TMMSpectrum.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3552. begin
  3553.    if (Button = mbLeft) and FShowInfoHint then
  3554.    begin
  3555.       { restore background }
  3556.       if FEnabled then DrawInfo(Point(-1,-1));
  3557.       if (SaveDC <> 0) then
  3558.       begin
  3559.          SelectObject(SaveDC, OldBitmap);
  3560.          DeleteObject(SaveBitmap);
  3561.          SaveBitmap := 0;
  3562.          DeleteDC(SaveDC);
  3563.          SaveDC := 0;
  3564.       end;
  3565.       FShowInfoHint := False;
  3566.       ClipCursor(nil);
  3567.       ShowHint := FOldShowHint;
  3568.    end;
  3570.    inherited MouseUp(Button, Shift, X, Y);
  3571. end;
  3573. {-- TMMSpectrum --------------------------------------------------------}
  3574. function TMMSpectrum.GetOptimalWidth(aWidth: integer): integer;
  3575. var
  3576.    NumBars, SpotWidth: integer;
  3578. begin
  3579.    Result := aWidth;
  3580.    if (Kind = skBars) or (Kind = skPeaks) or (Kind = skVLines) then
  3581.    begin
  3582.       NumBars := (FFTLen div 2)div FrequencyScale;
  3583.       if FDrawAmpScale then
  3584.       begin
  3585.          SpotWidth := (((aWidth-2*SCALEWIDTH)-2*BevelExtend) div NumBars);
  3586.          if SpotWidth > 0 then
  3587.             Result := 2*SCALEWIDTH + SpotWidth*NumBars + 2*BevelExtend;
  3588.       end
  3589.       else
  3590.       begin
  3591.          SpotWidth := ((aWidth-2*BevelExtend) div NumBars);
  3592.          if SpotWidth > 0 then
  3593.             Result := SpotWidth*NumBars + 2*BevelExtend;
  3594.       end;
  3595.    end;
  3596. end;
  3598. end.