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

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

Delphi控件源码

开发平台：

Delphi

MMSpGram.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: 05.10.98 - 15:53:33 $                                        =}
  24. {========================================================================}
  25. Unit MMSpGram;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.     Windows,
  34. {$ELSE}
  35.     WinTypes,
  36.     WinProcs,
  37. {$ENDIF}
  38.     SysUtils,
  39.     Messages,
  40.     Classes,
  41.     Graphics,
  42.     Controls,
  43.     Forms,
  44.     Menus,
  45.     MMSystem,
  46.     MMUtils,
  47.     MMObj,
  48.     MMString,
  49.     MMMath,
  50.     MMMulDiv,
  51.     MMFFT,
  52.     MMRegs,
  53.     MMPCMSup,
  54.     MMDIBCv;
  56. const
  57.     {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEWIDTH} {$ENDIF}
  58.     SCALEWIDTH      = 32;
  59.     {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEFONT} {$ENDIF}
  60.     SCALEFONT       = 'ARIAL';
  62.     SCALEFONTSIZE   : integer = 10;
  63.     INFOCOLOR       : TCOLOR = clWhite;
  65.     {$IFDEF CBUILDER3} {$EXTERNALSYM MIN_COLOR} {$ENDIF}
  66.     MIN_COLOR       : Word = 10;
  67.     {$IFDEF CBUILDER3} {$EXTERNALSYM NUM_COLORS} {$ENDIF}
  68.     NUM_COLORS      : Word = 236;
  69.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAX_FFTLEN} {$ENDIF}
  70.     MAX_FFTLEN      = 4096; { Define the maximum FFT buffer length.        }
  72. type
  73.     EMMSpectrogramError  = class(Exception);
  74.     TMMSpectrogramGain   = (sgrNone,sgr6db,sgr12db);
  75.     TMMSpectrogramPalette= (spHSV,spThreshold,spBlackWhite,spWhiteBlack,spBone,spCopper,spCool,spHot);
  76.     TMMSpectrogramSelect = procedure(Sender: TObject; Min, Max: Longint) of object;
  78.     PMMSaveBuffer        = ^TMMSaveBuffer;
  79.     TMMSaveBuffer        = array[0..0,0..0] of integer;
  81.     {-- TMMSpectrogram --------------------------------------------------}
  82.     TMMSpectrogram = class(TMMDIBGraphicControl)
  83.     private
  84.       {$IFDEF WIN32}
  85.       FpFFT           : PFFTReal;   { the instance for the FFT calculation}
  86.       {$ELSE}
  87.       FFT             : TMMFFT;     { the object that performs the FFT    }
  88.       {$ENDIF}
  89.       FFFTData        : PSmallArray;{ Array for FFT data                  }
  90.       FOldData        : PSmallArray;{ Storage for embossed mode           }
  91.       FWinBuf         : PIntArray;  { Array storing windowing function    }
  92.       FDisplayVal     : PLongArray; { Array storing display values        }
  93.       FColorValues    : PByteArray; { Array holding color values          }
  94.       Fy1             : PIntArray;  { Array of bin #'s displayed          }
  95.       Fy2             : PIntArray;  { Array of terminal bin #'s           }
  97.       FFTLen          : integer;    { Number of points for FFT            }
  98.       FSampleRate     : Longint;    { A/D sampling rate                   }
  99.       FFreqScaleFactor: Float;      { Scalefactor for the horiz. scale    }
  100.       FFreqBase       : Float;      { Base frequency for the display      }
  101.       FAmpScale       : Float;      { scaling factor for amplitude scaling}
  102.       FLogAmp         : Boolean;    { true for log-based amplitude scale  }
  103.       FSensitivy      : integer;    { here starts the display (db) scaling}
  104.       FWindow         : TMMFFTWindow;{ selected window function           }
  105.       FEmbossed       : Boolean;    { enable/disable embossed palette mode}
  106.       FEnabled        : Boolean;    { Enable or disable Spectrogram       }
  107.       FScaleTextColor : TColor;     { the text color for the scale        }
  108.       FScaleLineColor : TColor;     { the line color for the scale        }
  109.       FScaleBackColor : TColor;     { background color for the scale      }
  110.       FSelectColor    : TColor;     { color for selected range            }
  111.       FSelectDotColor : TColor;     { border color for selected range     }
  112.       FLocatorColor   : TColor;     { locator color                       }
  113.       FPalMode        : TMMSpectrogramPalette;
  114.       FBits           : TMMBits;    { b8bit or b16bit                     }
  115.       FChannel        : TMMChannel; { chBoth, chLeft or chRigth           }
  116.       FMode           : TMMMode;    { mMono, mStereo or mQuadro           }
  117.       FBytes          : Longint;    { calculated data bytes p. spectrogram}
  118.       FGain           : TMMSpectrogramGain;{ Amount of db/octave gain     }
  119.       FOldShowHint    : Boolean;    { save ShowHint propertie             }
  120.       FShowInfo       : Boolean;    { show the freq info or not           }
  121.       FShowInfoHint   : Boolean;    { mouse is down, show the info hint   }
  122.       FDrawScale      : Boolean;    { draw the scale or not               }
  123.       FWidth          : integer;    { calculated width without border     }
  124.       FHeight         : integer;    { calculated height without border    }
  125.       FClientRect     : TRect;      { calculated beveled Rect             }
  126.       Fx1             : integer;    { horiz. position counter for display }
  127.       Fx2             : integer;    { horizontal position counter for bar }
  128.       FNumScaleSteps  : integer;    { pre-calculated number of scale steps}
  129.       FBarWidth       : integer;    { width for the moving bar            }
  130.       FBarColor       : TColor;     { the color for the moving bar        }
  131.       FBarTickColor   : TColor;     { the color for the ticks on the bar  }
  132.       FNeedReset      : Boolean;    { the spectrum needs a reset          }
  133.       FAccelerate     : Boolean;    { accelerate the display refresh      }
  134.       FScroll         : Boolean;    { scroll the display or not           }
  135.       FSaveData       : Boolean;    { save the actual spectrum data       }
  136.       FSaveBuffer     : PMMSaveBuffer;
  137.       FSelectStart    : Longint;    { start pos for selected region       }
  138.       FSelectEnd      : Longint;    { end pos for selected region         }
  139.       FLocator        : Longint;    { current locator position            }
  140.       FDrawing        : Boolean;
  141.       FOldCursor      : TCursor;
  142.       FOrigin         : TRect;
  143.       FMoveRect       : TRect;
  144.       FLocked         : Boolean;
  145.       FUseSelection   : Boolean;
  147.       { Events }
  148.       FOnPcmOverflow  : TNotifyEvent;
  149.       FOnSelecting    : TMMSpectrogramSelect;
  150.       FOnSelectEnd    : TMMSpectrogramSelect;
  152.       procedure CreateDataBuffers(Length: Cardinal);
  153.       procedure FreeDataBuffers;
  154.       procedure CreateArrays(Size: Cardinal);
  155.       procedure FreeArrays;
  156.       procedure SetBytesPerSpectrogram;
  157.       procedure SetupYScale;
  158.       procedure CalcScaleSteps;
  159.       procedure CalcMagnitude(MagnitudeForm: Boolean);
  160.       procedure DrawInfo(Pos: TPoint);
  161.       procedure DrawFrequencyScale;
  162.       procedure DrawData(pDispData: PLongArray);
  163.       procedure DrawBar;
  164.       procedure DrawSelection(aCanvas: TMMDIBCanvas; sStart, sEnd: Longint;
  165.                               sColor: TColor; Solid: Boolean);
  166.       procedure DrawLocator(aCanvas: TMMDIBCanvas; aPos: Longint; aColor: TColor);
  167.       procedure DrawSpectrogram(ClearBackGround: Boolean);
  169.       procedure AdjustSize(var W, H: Integer);
  170.       procedure AdjustBounds;
  171.       procedure SetFFTLen(aLength: integer);
  172.       procedure SetWindow(aValue: TMMFFTWindow);
  173.       procedure SetPalMode(aValue: TMMSpectrogramPalette);
  174.       procedure SetEmbossed(aValue: Boolean);
  175.       procedure SetLogAmp(aValue: Boolean);
  176.       procedure SetFreqScale(aValue: integer);
  177.       function  GetFreqScale: integer;
  178.       procedure SetFreqBase(aValue: integer);
  179.       function  GetFreqBase: integer;
  180.       procedure SetAmplitudeScale(aValue: integer);
  181.       function  GetAmplitudeScale: integer;
  182.       procedure SetAccelerate(aValue: Boolean);
  183.       procedure SetDrawScale(aValue: Boolean);
  184.       procedure SetEnabled(aValue: Boolean);
  185.       procedure SetColors(Index: Integer; Value: TColor);
  186.       procedure SetBarWidth(aValue: integer);
  187.       procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
  188.       function  GetPCMWaveFormat: TPCMWaveFormat;
  189.       procedure SetBits(aValue: TMMBits);
  190.       procedure SetChannel(aValue: TMMChannel);
  191.       procedure SetMode(aValue: TMMMode);
  192.       procedure SetSampleRate(aValue: Longint);
  193.       procedure SetGain(aValue: TMMSpectrogramGain);
  194.       procedure SetSensitivy(aValue: integer);
  195.       procedure SetScroll(aValue: Boolean);
  196.       function  GetScaleBackColor: TColor;
  197.       procedure SetLocator(aValue: Longint);
  198.       procedure SetSaveData(aValue: Boolean);
  199.       
  200.     protected
  201.       procedure ChangeDesigning(aValue: Boolean); override;
  202.       procedure Paint; override;
  203.       procedure Loaded; override;
  204.       procedure PcmOverflow; dynamic;
  205.       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  206.       procedure Changed; override;
  207.       procedure Selecting(Min, Max: Longint); dynamic;
  208.       procedure SelectEnd(Min, Max: Longint); dynamic;
  209.       procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  210.       procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  211.       procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  213.     public
  214.       constructor Create(AOwner: TComponent); override;
  215.       destructor  Destroy; override;
  217.       function    GetFrequency(Pos: TPoint): Float;
  218.       procedure   SetPalette(LogPal: PLogPalette);
  219.       procedure   RefreshPCMData(PCMData: Pointer);
  220.       procedure   RefreshFFTData(FFTData: Pointer);
  221.       procedure   RefreshMagnitudeData(MagData: Pointer);
  222.       procedure   ResetData;
  224.       property    ColorValues: PByteArray read FColorValues;
  225.       property    BytesPerSpectrogram: Longint read FBytes;
  226.       property    PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
  227.       property    FFTData: PSmallArray read FFFTData;
  229.       procedure   Select(sStart, sEnd: Longint; Redraw: Boolean);
  231.       property    SelectionStart: Longint read FSelectStart;
  232.       property    SelectionEnd: Longint read FSelectEnd;
  234.       property    Locator: Longint read Flocator write SetLocator default -1;
  236.       function    IsLocator(X: integer): Boolean;
  237.       function    IsSelectStart(X: integer): Boolean;
  238.       function    IsSelectEnd(X: integer): Boolean;
  239.       function    IsInSelection(X: integer): Boolean;
  241.       property    SaveData: Boolean read FSaveData write SetSaveData default False;
  243.     published
  244.       { Events }
  245.       property OnClick;
  246.       property OnDblClick;
  247.       property OnMouseDown;
  248.       property OnMouseMove;
  249.       property OnMouseUp;
  250.       property OnDragDrop;
  251.       property OnDragOver;
  252.       property OnEndDrag;
  253.       property OnStartDrag;
  254.       property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  255.       property OnSelecting: TMMSpectrogramSelect read FOnSelecting write FOnSelecting;
  256.       property OnSelectEnd: TMMSpectrogramSelect read FOnSelectEnd write FOnSelectEnd;
  258.       property Align;
  259.       property Bevel;
  260.       property PopupMenu;
  261.       property ParentShowHint;
  262.       property ShowHint;
  263.       property Visible;
  264.       property Cursor default crCross;
  265.       property PaletteRealize default True;
  266.       property PaletteMapped;
  267.       property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
  268.       property Enabled: Boolean read FEnabled write SetEnabled default True;
  269.       property DrawScale: Boolean read FDrawScale write SetDrawScale default False;
  270.       property Height default 90;
  271.       property Width default 194;
  272.       property Accelerate: Boolean read FAccelerate write SetAccelerate default True;
  273.       property Scroll: Boolean read FScroll write SetScroll default False;
  274.       property ScaleTextColor: TColor index 0 read FScaleTextColor write SetColors default clBlack;
  275.       property ScaleLineColor: TColor index 1 read FScaleLineColor write SetColors default clBlack;
  276.       property BarColor: TColor index 2 read FBarColor write SetColors default clGray;
  277.       property BarTickColor: TColor index 3 read FBarTickColor write SetColors default clWhite;
  278.       {$IFDEF BUILD_ACTIVEX}
  279.       property ScaleBackColor: TColor index 4 read FScaleBackColor write SetColors default clBtnface;
  280.       {$ENDIF}
  281.       property SelectionColor: TColor index 5 read FSelectColor write SetColors default clRed;
  282.       property SelectionDotColor: TColor index 6 read FSelectDotColor write SetColors default clRed;
  283.       property LocatorColor: TColor index 7 read FLocatorColor write SetColors default clYellow;
  284.       property BarWidth: integer read FBarWidth write SetBarWidth default 5;
  285.       property Mode: TMMMode read FMode write SetMode default mMono;
  286.       property BitLength: TMMBits read FBits write SetBits default b8bit;
  287.       property Channel: TMMChannel read FChannel write SetChannel default chBoth;
  288.       property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
  289.       property Gain: TMMSpectrogramGain read FGain write SetGain default sgrNone;
  290.       property FFTLength: integer read FFTLen write SetFFTLen default 128;
  291.       property Window: TMMFFTWindow read FWindow write SetWindow default fwHamming;
  292.       property LogAmp: Boolean read FLogAmp write SetLogAmp default False;
  293.       property Embossed: Boolean read FEmbossed write SetEmbossed default False;
  294.       property AmplitudeScale: integer read GetAmplitudeScale write SetAmplitudeScale default 100;
  295.       property FrequencyBase: integer read GetFreqBase write SetFreqBase default 0;
  296.       property FrequencyScale: integer read GetFreqScale write SetFreqScale default 1;
  297.       property Sensitivy: integer read FSensitivy write SetSensitivy default -90;
  298.       property PaletteTyp: TMMSpectrogramPalette read FPalMode write SetPalMode default spThreshold;
  299.       property Locked: Boolean read FLocked write FLocked default False;
  300.       property UseSelection: Boolean read FUseSelection write FUseSelection default False;
  301.     end;
  303. implementation
  305. uses consts;
  307. const
  308.    CreateCount: Longint = 0;
  309.    ControlList: TList   = nil;
  310.    SaveDC     : HDC     = 0;
  311.    SaveBitmap : HBitmap = 0;
  312.    SaveWidth  : integer = 0;
  313.    SaveHeight : integer = 0;
  314.    SaveInfoPos: TPoint  = (X:0;Y:0);
  315.    OldBitmap  : HBitmap = 0;
  316.    OldPalette : HPalette= 0;
  318. {------------------------------------------------------------------------}
  319. procedure AddSpectrogram(Spectrogram: TMMSpectrogram);
  320. begin
  321.    inc(CreateCount);
  322.    if (CreateCount = 1) then
  323.    begin
  324.       ControlList := TList.Create;
  325.    end;
  326.    if ControlList.IndexOf(Spectrogram) = -1 then
  327.       ControlList.Add(Spectrogram);
  328. end;
  330. {------------------------------------------------------------------------}
  331. procedure RemoveSpectrogram(Spectrogram: TMMSpectrogram);
  332. begin
  333.    ControlList.Remove(Spectrogram);
  334.    ControlList.Pack;
  335.    dec(CreateCount);
  336.    if (CreateCount = 0) then
  337.    begin
  338.       ControlList.Free;
  339.       ControlList := nil;
  340.    end;
  341. end;
  343. {------------------------------------------------------------------------}
  344. procedure ResetSpectrograms(Spectrogram: TMMSpectrogram);
  345. var
  346.    i: integer;
  347. begin
  348.    if (ControlList <> nil) and (ControlList.Count > 0) then
  349.    begin
  350.       for i := 0 to ControlList.Count-1 do
  351.           if (ControlList.Items[i] <> Spectrogram) then
  352.              TMMSpectrogram(ControlList.Items[i]).FNeedReset := True;
  353.    end;
  354. end;
  356. {-- TMMSpectrogram ------------------------------------------------------}
  357. constructor TMMSpectrogram.Create(AOwner: TComponent);
  358. begin
  359.    inherited Create(AOwner);
  361.    CreateDataBuffers(MAX_FFTLEN);
  362.    PaletteRealize := True;
  363.    {$IFDEF WIN32}
  364.    FpFFT := InitRealFFT(8);
  365.    {$ELSE}
  366.    FFT := TMMFFT.Create;
  367.    {$ENDIF}
  368.    FFTLen := 8;
  369.    FAccelerate := True;
  370.    FSampleRate := 11025;
  371.    FChannel := chBoth;
  372.    FBits := b8bit;
  373.    FMode := mMono;
  374.    FGain := sgrNone;
  375.    FEmbossed := False;
  376.    FWindow := fwHamming;
  377.    FFreqScaleFactor := 1.0;
  378.    FFreqBase := 0;
  379.    FAmpScale := 1.0;
  380.    FLogAmp := False;
  381.    FSensitivy := -90;
  382.    FEnabled := True;
  383.    FPalMode := spThreshold;
  384.    Color := clBlack;
  385.    FScaleTextColor := clBlack;
  386.    FScaleLineColor:= clBlack;
  387.    FScaleBackColor := clBtnFace;
  388.    FBarWidth := 5;
  389.    FBarColor := clGray;
  390.    FBarTickColor := clWhite;
  391.    FDrawScale := False;
  392.    Fx1 := -FBarWidth;
  393.    Fx2 := 0;
  394.    FNeedReset := False;
  395.    FScroll := False;
  396.    FShowInfoHint := False;
  397.    FShowInfo := True;
  398.    FSaveData := False;
  399.    FSelectStart := -1;
  400.    FSelectEnd := -1;
  401.    FLocator := -1;
  402.    FSelectColor := clRed;
  403.    FSelectDotColor := clRed;
  404.    FLocatorColor := clYellow;
  405.    FDrawing := False;
  406.    FLocked := False;
  407.    FUseSelection := False;
  408.    FSaveBuffer := nil;
  410.    Height := 90;
  411.    Width := 194;
  412.    Cursor := crCross;
  413.    FFTLength := 128;
  415.    if not (csDesigning in ComponentState) then
  416.    begin
  417.       { update the spectrogram list }
  418.       AddSpectrogram(Self);
  419.    end;
  421.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  422.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  423. end;
  425. {-- TMMSpectrogram ------------------------------------------------------}
  426. Destructor TMMSpectrogram.Destroy;
  427. begin
  428.    if not (csDesigning in ComponentState) then
  429.    begin
  430.       { update the spectrogram list }
  431.       RemoveSpectrogram(Self);
  432.    end;
  434.    FreeDataBuffers;
  435.    FreeArrays;
  436.    {$IFDEF WIN32}
  437.    DoneRealFFT(FpFFT);
  438.    {$ELSE}
  439.    FFT.Free;
  440.    {$ENDIF}
  442.    inherited Destroy;
  443. end;
  445. {-- TMMSpectrogram ------------------------------------------------------}
  446. procedure TMMSpectrogram.ChangeDesigning(aValue: Boolean);
  447. begin
  448.    inherited ChangeDesigning(aValue);
  450.    if not (csDesigning in ComponentState) then
  451.    begin
  452.       { update the spectrogram list }
  453.       AddSpectrogram(Self);
  454.    end;
  455. end;
  457. {-- TMMSpectrogram ------------------------------------------------------}
  458. procedure TMMSpectrogram.PcmOverflow;
  459. begin
  460.    if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
  461. end;
  463. {-- TMMSpectrogram ------------------------------------------------------}
  464. procedure TMMSpectrogram.CreateDataBuffers(Length: Cardinal);
  465. begin
  466.    if (Length > 0) then
  467.    begin
  468.       FFFTData   := GlobalAllocMem(Length * sizeOf(SmallInt));
  469.       FWinBuf    := GlobalAllocMem(Length * sizeOf(Integer));
  470.       FOldData   := GlobalAllocMem((Length div 2) * sizeOf(SmallInt));
  471.       FDisplayVal:= GlobalAllocMem((Length div 2) * sizeOf(Long));
  472.    end;
  473. end;
  475. {-- TMMSpectrogram ------------------------------------------------------}
  476. procedure TMMSpectrogram.FreeDataBuffers;
  477. begin
  478.    GlobalFreeMem(Pointer(FFFTData));
  479.    GlobalFreeMem(Pointer(FWinBuf));
  480.    GlobalFreeMem(Pointer(FOldData));
  481.    GlobalFreeMem(Pointer(FDisplayVal));
  482.    GlobalFreeMem(Pointer(FSaveBuffer));
  483. end;
  485. {-- TMMSpectrogram ------------------------------------------------------}
  486. procedure TMMSpectrogram.CreateArrays(Size: Cardinal);
  487. begin
  488.    if (Size > 0) then
  489.    begin
  490.       Fy1          := GlobalAllocMem(Size * sizeOf(Integer));
  491.       Fy2          := GlobalAllocMem(Size * sizeOf(Integer));
  492.       FColorValues := GlobalAllocMem(Size * sizeOf(Byte));
  493.    end;
  494. end;
  496. {-- TMMSpectrogram ------------------------------------------------------}
  497. procedure TMMSpectrogram.FreeArrays;
  498. begin
  499.    GlobalFreeMem(Pointer(Fy1));
  500.    GlobalFreeMem(Pointer(Fy2));
  501.    GlobalFreeMem(Pointer(FColorValues));
  502. end;
  504. {-- TMMSpectrogram ------------------------------------------------------}
  505. procedure TMMSpectrogram.ResetData;
  506. var
  507.    P: TPoint;
  508. begin
  509.    if FShowInfoHint then
  510.    begin
  511.       GetCursorPos(P);
  512.       P := ScreenToClient(P);
  513.       Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  514.    end;
  515.    FNeedReset   := True;
  516.    FSelectStart := -1;
  517.    FSelectEnd   := -1;
  518.    FLocator     := -1;
  520.    Fx1 := -BarWidth;//Max(-FBarWidth,0);
  521.    Fx2 := 0;
  523.    if (FSaveBuffer <> nil) then
  524.        FillChar(FSaveBuffer^,(MAX_FFTLEN div 2) * sizeOf(Long)*FWidth,0);
  526.    Refresh;
  527. end;
  529. {-- TMMSpectrogram ------------------------------------------------------}
  530. procedure TMMSpectrogram.SetFFTLen(aLength: integer);
  531. var
  532.    Order: integer;
  534. begin
  535.    aLength := MinMax(aLength,8,MAX_FFTLEN);
  536.    { Convert FFTLen to a power of 2 }
  537.    Order := 0;
  538.    while aLength > 1 do
  539.    begin
  540.       aLength := aLength shr 1;
  541.       inc(Order);
  542.    end;
  543.    if (Order > 0) then aLength := aLength shl Order;
  545.    {$IFDEF WIN32}
  546.    {$IFDEF TRIAL}
  547.    {$DEFINE _HACK1}
  548.    {$I MMHACK.INC}
  549.    {$ENDIF}
  550.    {$ENDIF}
  552.    if (aLength <> FFTLen) then
  553.    begin
  554.       { re-init the FFTObject with the new FFT-length }
  555.       {$IFDEF WIN32}
  556.       DoneRealFFT(FpFFT);
  557.       FpFFT := InitRealFFT(Order);
  558.       FFTLen := aLength;
  559.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  560.       {$ELSE}
  561.       FFT.FFTLength := aLength;
  562.       FFTLen := aLength;
  563.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  564.       {$ENDIF}
  566.       { Re-initialize the display }
  567.       SetupYScale;
  568.       SetBytesPerSpectrogram;
  569.       Invalidate;
  570.    end;
  571. end;
  573. {-- TMMSpectrogram ------------------------------------------------------}
  574. procedure TMMSpectrogram.SetWindow(aValue: TMMFFTWindow);
  575. begin
  576.    if (aValue <> FWindow) then
  577.    begin
  578.       FWindow := aValue;
  579.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  580.    end;
  581. end;
  583. {-- TMMSpectrogram ------------------------------------------------------}
  584. procedure TMMSpectrogram.SetSampleRate(aValue: Longint);
  585. begin
  586.    if (aValue <> FSampleRate) then
  587.    begin
  588.       FSampleRate := MinMax(aValue, 8000, 100000);
  589.       { Re-initialize the display }
  590.       SetupYScale;
  591.       { calc the number of scale steps }
  592.       CalcScaleSteps;
  593.       Invalidate;
  594.    end;
  595. end;
  597. {-- TMMSpectrogram ------------------------------------------------------}
  598. procedure TMMSpectrogram.SetLogAmp(aValue: Boolean);
  599. begin
  600.    { Toggle linear/logarithmic amplitude axis }
  601.    if (aValue <> FLogAmp) then
  602.    begin
  603.       FLogAmp := aValue;
  604.    end;
  605. end;
  607. {-- TMMSpectrogram ------------------------------------------------------}
  608. procedure TMMSpectrogram.SetEnabled(aValue: Boolean);
  609. begin
  610.    if (aValue <> FEnabled) then
  611.    begin
  612.       FEnabled := aValue;
  613.       { inherited Enabled := Value }
  614.       Invalidate;
  615.    end;
  616. end;
  618. {-- TMMSpectrogram ------------------------------------------------------}
  619. procedure TMMSpectrogram.SetBarWidth(aValue: integer);
  620. begin
  621.    if (aValue <> FBarWidth) then
  622.    begin
  623.       FBarWidth := Max(aValue,0);
  624.       Invalidate;
  625.    end;
  626.    {$IFDEF WIN32}
  627.    {$IFDEF TRIAL}
  628.    {$DEFINE _HACK2}
  629.    {$I MMHACK.INC}
  630.    {$ENDIF}
  631.    {$ENDIF}
  632. end;
  634. {-- TMMSpectrogram ------------------------------------------------------}
  635. procedure TMMSpectrogram.SetSaveData(aValue: Boolean);
  636. begin
  637.    if (aValue <> FSaveData) then
  638.    begin
  639.       if (FSaveBuffer <> nil) then
  640.           GlobalFreeMem(Pointer(FSaveBuffer));
  642.       FSaveData := aValue;
  644.       if FSaveData then
  645.          FSaveBuffer := GlobalAllocMem((MAX_FFTLEN div 2) * sizeOf(Long)*FWidth);
  646.    end;
  647. end;
  649. {-- TMMSpectrogram ------------------------------------------------------}
  650. procedure TMMSpectrogram.Loaded;
  651. begin
  652.    inherited Loaded;
  654.    SetupYScale;
  655.    SetPalMode(FPalMode);
  656.    FastDraw(DrawSpectrogram,True);
  657. end;
  659. {-- TMMSpectrogram ------------------------------------------------------}
  660. procedure TMMSpectrogram.AdjustSize(var W, H: Integer);
  661. begin
  662.    if FDrawScale then
  663.       W := Max(W,2*SCALEWIDTH+2*BevelExtend+5)
  664.    else
  665.       W := Max(W,2*BevelExtend+5);
  667.    H := Max(H,2*BevelExtend+5);
  668. end;
  670. {-- TMMSpectrogram ------------------------------------------------------}
  671. procedure TMMSpectrogram.AdjustBounds;
  672. var
  673.   W, H: Integer;
  675. begin
  676.    W := Width;
  677.    H := Height;
  678.    AdjustSize(W, H);
  679.    if (W <> Width) or (H <> Height) then SetBounds(Left, Top, W, H)
  680.    else Changed;
  681. end;
  683. {-- TMMSpectrogram ------------------------------------------------------}
  684. procedure TMMSpectrogram.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  685. var
  686.   W, H: Integer;
  688. begin
  689.    W := aWidth;
  690.    H := aHeight;
  691.    AdjustSize (W, H);
  692.    inherited SetBounds(aLeft, aTop, W, H);
  693.    Changed;
  694. end;
  696. {-- TMMSpectrogram ------------------------------------------------------}
  697. procedure TMMSpectrogram.Changed;
  698. begin
  699.    FClientRect := Rect(0,0,Width,Height);
  701.    if FDrawScale then
  702.    begin
  703.       { make place for the scale }
  704.       InflateRect(FClientRect, -SCALEWIDTH,0);
  705.    end;
  706.    { and now for the bevel }
  707.    InflateRect(FClientRect, -Bevel.BevelExtend, -Bevel.BevelExtend);
  709.    { save the real height and width }
  710.    FWidth  := Max(FClientRect.Right - FClientRect.Left,4);
  711.    FHeight := Max(FClientRect.Bottom - FClientRect.Top,4);
  713.    FreeArrays;                               { adjust the dyn.array size }
  714.    CreateArrays(FHeight);
  716.    DIBCanvas.SetBounds(0,0,FWidth,FHeight);
  718.    if (FSaveBuffer <> nil) then
  719.    begin
  720.       GlobalFreeMem(Pointer(FSaveBuffer));
  721.       FSaveBuffer := GlobalAllocMem((MAX_FFTLEN div 2) * sizeOf(Long)*FWidth);
  722.    end;
  724.    SetBytesPerSpectrogram;        { calc the new bytes per Scope }
  725.    SetupYScale;                   { recalc the scalings }
  726.    CalcScaleSteps;
  728.    ResetData;
  730.    inherited Changed;
  731. end;
  733. {-- TMMSpectrogram ------------------------------------------------------}
  734. procedure TMMSpectrogram.SetBytesPerSpectrogram;
  735. begin
  736.    FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FFTLen;
  737. end;
  739. {-- TMMSpectrogram ------------------------------------------------------}
  740. Procedure TMMSpectrogram.SetPCMWaveFormat(wf: TPCMWaveFormat);
  741. var
  742.    pwfx: PWaveFormatEx;
  744. begin
  745.    pwfx := @wf;
  746.    if not pcmIsValidFormat(pwfx) then
  747.       raise EMMSpectrogramError.Create(LoadResStr(IDS_INVALIDFORMAT));
  749.    SampleRate := pwfx^.nSamplesPerSec;
  750.    BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
  751.    Mode := TMMMode(pwfx^.nChannels-1);
  752. end;
  754. {-- TMMSpectrogram ------------------------------------------------------}
  755. function TMMSpectrogram.GetPCMWaveFormat: TPCMWaveFormat;
  756. var
  757.    wfx: TWaveFormatEx;
  758. begin
  759.    pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
  760.    Result := PPCMWaveFormat(@wfx)^;
  761. end;
  763. {-- TMMSpectrogram ------------------------------------------------------}
  764. Procedure TMMSpectrogram.SetBits(aValue: TMMBits);
  765. begin
  766.    if (aValue <> FBits) then
  767.    begin
  768.       FBits := aValue;
  769.       SetBytesPerSpectrogram;
  770.       Invalidate;
  771.    end;
  772.    {$IFDEF WIN32}
  773.    {$IFDEF TRIAL}
  774.    {$DEFINE _HACK3}
  775.    {$I MMHACK.INC}
  776.    {$ENDIF}
  777.    {$ENDIF}
  778. end;
  780. {-- TMMSpectrogram ------------------------------------------------------}
  781. Procedure TMMSpectrogram.SetChannel(aValue: TMMChannel);
  782. begin
  783.    if (aValue <> FChannel) then
  784.    begin
  785.       FChannel := aValue;
  786.       SetBytesPerSpectrogram;
  787.       Invalidate;
  788.    end;
  789. end;
  791. {-- TMMSpectrogram ------------------------------------------------------}
  792. Procedure TMMSpectrogram.SetMode(aValue: TMMMode);
  793. begin
  794.    if (aValue <> FMode) then
  795.    begin
  796.       FMode := aValue;
  797.       SetBytesPerSpectrogram;
  798.       Invalidate;
  799.    end;
  800. end;
  802. {-- TMMSpectrogram ------------------------------------------------------}
  803. procedure TMMSpectrogram.SetGain(aValue: TMMSpectrogramGain);
  804. begin
  805.    if (aValue <> FGain) then
  806.    begin
  807.       FGain := aValue;
  808.    end;
  809. end;
  811. {-- TMMSpectrogram ------------------------------------------------------}
  812. procedure TMMSpectrogram.Select(sStart, sEnd: Longint; Redraw: Boolean);
  813. var
  814.    oldStart,oldEnd: Longint;
  815. begin
  816.    oldStart:= FSelectStart;
  817.    oldEnd := FSElectEnd;
  819.    if (sStart <> FSelectStart) then
  820.    begin
  821.       if (sStart < 0) then sStart := -1;
  822.       if (sStart > FWidth) then sStart := FWidth;
  823.       FSelectStart := sStart;
  824.    end;
  826.    if (sEnd <> FSelectEnd) then
  827.    begin
  828.       if (sEnd < 0) then sEnd := -1;
  829.       if (sEnd > FWidth) then sEnd := FWidth;
  830.       FSelectEnd := sEnd;
  831.    end;
  833.    if (FSelectStart > FSelectEnd) then
  834.    begin
  835.       SwapLong(FSelectStart,FSelectEnd);
  836.    end;
  838.    if (FSelectEnd - FSelectStart <= 0) then
  839.    begin
  840.       FSelectStart := -1;
  841.       FSelectEnd := -1;
  842.    end;
  844.    if Redraw and ((oldStart <> FSelectStart) or (oldEnd <> FSelectEnd)) then
  845.       Refresh;
  846. end;
  848. {-- TMMSpectrogram ------------------------------------------------------}
  849. procedure TMMSpectrogram.SetLocator(aValue: Longint);
  850. var
  851.    oldLoc: Longint;
  852. begin
  853.    oldLoc := FLocator;
  855.    if (aValue <> FLocator) then
  856.    begin
  857.       if (aValue < 0) then aValue := -1;
  858.       if (aValue > FWidth) then aValue := FWidth;
  859.       FLocator := aValue;
  860.    end;
  862.    if (oldLoc <> FLocator) then
  863.       Refresh;
  864. end;
  866. {-- TMMSpectrogram ------------------------------------------------------}
  867. procedure TMMSpectrogram.SetAmplitudeScale;
  868. begin
  869.    { Change the amplitude scale factor }
  870.    aValue := MinMax(aValue, 0, 1000);
  871.    if (aValue <> GetAmplitudeScale) then
  872.    begin
  873.       FAmpScale := 0.01*aValue;
  874.    end;
  875. end;
  877. {-- TMMSpectrogram ------------------------------------------------------}
  878. function TMMSpectrogram.GetAmplitudeScale: integer;
  879. begin
  880.    Result := Round(FAmpScale/0.01);
  881. end;
  883. {-- TMMSpectrogram ------------------------------------------------------}
  884. procedure TMMSpectrogram.SetFreqScale(aValue: integer);
  885. begin
  886.    aValue := MinMax(aValue,1,16);
  887.    if (aValue <> Trunc(FFreqScaleFactor)) then
  888.    begin
  889.       FFreqScaleFactor := aValue;
  890.       { Re-initialize the display }
  891.       SetupYScale;
  892.       { calc the number of scale steps }
  893.       CalcScaleSteps;
  894.       Invalidate;
  895.    end;
  896. end;
  898. {-- TMMSpectrogram ------------------------------------------------------}
  899. function TMMSpectrogram.GetFreqScale: integer;
  900. begin
  901.    Result := Trunc(FFreqScaleFactor);
  902. end;
  904. {-- TMMSpectrogram ------------------------------------------------------}
  905. procedure TMMSpectrogram.SetFreqBase(aValue: integer);
  906. begin
  907.    aValue := Max(aValue,0);
  909.    if (aValue <> Trunc(FFreqBase)) then
  910.    begin
  911.       FFreqBase := aValue;
  912.       { Re-initialize the display }
  913.       SetupYScale;
  914.       { calc the number of scale steps }
  915.       CalcScaleSteps;
  916.       Invalidate;
  917.    end;
  918. end;
  920. {-- TMMSpectrogram ------------------------------------------------------}
  921. function TMMSpectrogram.GetFreqBase: integer;
  922. begin
  923.    Result := Trunc(FFreqBase);
  924. end;
  926. {-- TMMSpectrogram ------------------------------------------------------}
  927. procedure TMMSpectrogram.SetSensitivy(aValue: integer);
  928. begin
  929.    aValue := MinMax(aValue, -90, -9);
  930.    if (aValue <> FSensitivy) then
  931.    begin
  932.       FSensitivy := aValue;
  933.    end;
  934. end;
  936. {-- TMMSpectrogram ------------------------------------------------------}
  937. procedure TMMSpectrogram.SetDrawScale(aValue: Boolean);
  938. begin
  939.    if (aValue <> FDrawScale) then
  940.    begin
  941.       FDrawScale := aValue;
  942.       AdjustBounds;
  943.       Invalidate;
  944.    end;
  945.    {$IFDEF WIN32}
  946.    {$IFDEF TRIAL}
  947.    {$DEFINE _HACK2}
  948.    {$I MMHACK.INC}
  949.    {$ENDIF}
  950.    {$ENDIF}
  951. end;
  953. {-- TMMSpectrogram ------------------------------------------------------}
  954. procedure TMMSpectrogram.SetAccelerate(aValue: Boolean);
  955. begin
  956.    if (aValue <> FAccelerate) then
  957.    begin
  958.       FAccelerate := aValue;
  959.       if not FAccelerate and FScroll then Invalidate;
  960.    end;
  961. end;
  963. {-- TMMSpectrogram ------------------------------------------------------}
  964. procedure TMMSpectrogram.SetEmbossed(aValue: Boolean);
  965. begin
  966.    if (aValue <> FEmbossed) then
  967.    begin
  968.       FEmbossed := aValue;
  969.       Invalidate;
  970.    end;
  971. end;
  973. {-- TMMSpectrogram ------------------------------------------------------}
  974. Procedure TMMSpectrogram.SetScroll(aValue: Boolean);
  975. begin
  976.    if (aValue <> FScroll) then
  977.    begin
  978.       FScroll := aValue;
  979.       Invalidate;
  980.    end;
  981. end;
  983. {-- TMMSpectrogram ------------------------------------------------------}
  984. Procedure TMMSpectrogram.SetColors(Index: Integer; Value: TColor);
  985. begin
  986.    case Index of
  987.         0: if FScaleTextColor = Value then exit else FScaleTextColor := Value;
  988.         1: if FScaleLineColor = Value then exit else FScaleLineColor := Value;
  989.         2: if FBarColor = Value then exit else FBarColor := Value;
  990.         3: if FBarTickColor = Value then exit else FBarTickColor := Value;
  991.         4: if FScaleBackColor = Value then exit else FScaleBackColor := Value;
  992.         5: if FSelectColor = Value then exit else FSelectColor := Value;
  993.         6: if FSelectDotColor = Value then exit else FSelectDotColor := Value;
  994.         7: if FLocatorColor = Value then exit else FLocatorColor := Value;
  995.    end;
  996.    Invalidate;
  997.    {$IFDEF WIN32}
  998.    {$IFDEF TRIAL}
  999.    {$DEFINE _HACK1}
  1000.    {$I MMHACK.INC}
  1001.    {$ENDIF}
  1002.    {$ENDIF}
  1003. end;
  1005. {-- TMMSpectrogram ------------------------------------------------------}
  1006. procedure TMMSpectrogram.SetPalette(LogPal: PLogPalette);
  1007. begin
  1008.    Refresh;
  1009.    DIBCanvas.SetLogPalette(LogPal);
  1010.    Invalidate;
  1011. end;
  1013. {-- TMMSpectrogram ------------------------------------------------------}
  1014. procedure TMMSpectrogram.SetPalMode(aValue: TMMSpectrogramPalette);
  1015. type
  1016.    { Logical Palette }
  1017.    TLogPal = packed record
  1018.     palVersion: Word;
  1019.     palNumEntries: Word;
  1020.     palEntry: array[0..255] of TPaletteEntry;
  1021.   end;
  1023. var
  1024.    i,clr: Longint;
  1025.    LogPal: TLogPal;
  1027. begin
  1028.    FPalMode := aValue;
  1030.    if not (csLoading in ComponentState) and
  1031.       not (csReading in ComponentState) then
  1032.    begin
  1033.       FillChar(LogPal, sizeOf(LogPal),0);
  1034.       with LogPal do
  1035.       begin
  1036.          palVersion := $300;
  1037.          palNumEntries := 256;
  1039.          for i := MIN_COLOR to MIN_COLOR+NUM_COLORS-1 do
  1040.          begin
  1041.             clr := (i-MIN_COLOR)*256 div NUM_COLORS;
  1042.             case FPalMode of
  1043.               spHSV:
  1044.               begin
  1045.                  if (clr < 64) then
  1046.                  begin
  1047.                     palEntry[i].peRed := 0;
  1048.                     palEntry[i].peGreen := clr*4;
  1049.                     palEntry[i].peBlue := 255;
  1050.                  end
  1051.                  else if (clr < 128) then
  1052.                  begin
  1053.                     palEntry[i].peRed := 0;
  1054.                     palEntry[i].peGreen := 255;
  1055.                     palEntry[i].peBlue := 510-clr*4;
  1056.                  end
  1057.                  else if (clr < 192) then
  1058.                  begin
  1059.                     palEntry[i].peRed := clr*4-510;
  1060.                     palEntry[i].peGreen := 255;
  1061.                     palEntry[i].peBlue := 0;
  1062.                  end
  1063.                  else
  1064.                  begin
  1065.                     palEntry[i].peRed := 255;
  1066.                     palEntry[i].peGreen := 1020-clr*4;
  1067.                     palEntry[i].peBlue := 0;
  1068.                  end;
  1069.               end;
  1070.               spThreshold:
  1071.               begin
  1072.                  if (clr < 16) then
  1073.                  begin
  1074.                     palEntry[i].peRed := 0;
  1075.                     palEntry[i].peGreen := 0;
  1076.                     palEntry[i].peBlue := 0;
  1077.                  end
  1078.                  else if (clr < 64) then
  1079.                  begin
  1080.                     palEntry[i].peRed := 0;
  1081.                     palEntry[i].peGreen := clr*4;
  1082.                     palEntry[i].peBlue := 255;
  1083.                  end
  1084.                  else if (clr < 128) then
  1085.                  begin
  1086.                     palEntry[i].peRed := 0;
  1087.                     palEntry[i].peGreen := 255;
  1088.                     palEntry[i].peBlue := 510-clr*4;
  1089.                  end
  1090.                  else if (clr < 192) then
  1091.                  begin
  1092.                     palEntry[i].peRed := clr*4-510;
  1093.                     palEntry[i].peGreen := 255;
  1094.                     palEntry[i].peBlue := 0;
  1095.                  end
  1096.                  else
  1097.                  begin
  1098.                     palEntry[i].peRed := 255;
  1099.                     palEntry[i].peGreen := 1020-clr*4;
  1100.                     palEntry[i].peBlue := 0;
  1101.                  end;
  1102.               end;
  1103.               spCool:
  1104.               begin
  1105.                  palEntry[i].peRed := clr;
  1106.                  palEntry[i].peGreen := 255-clr;
  1107.                  palEntry[i].peBlue := 255;
  1108.               end;
  1109.               spHot:
  1110.               begin
  1111.                  if (clr < 96) then
  1112.                  begin
  1113.                     palEntry[i].peRed := Trunc(clr*2.66667+0.5);
  1114.                     palEntry[i].peGreen := 0;
  1115.                     palEntry[i].peBlue := 0;
  1116.                  end
  1117.                  else if (clr < 192) then
  1118.                  begin
  1119.                     palEntry[i].peRed := 255;
  1120.                     palEntry[i].peGreen := Trunc(clr*2.66667-254);
  1121.                     palEntry[i].peBlue := 0;
  1122.                  end
  1123.                  else
  1124.                  begin
  1125.                     palEntry[i].peRed := 255;
  1126.                     palEntry[i].peGreen := 255;
  1127.                     palEntry[i].peBlue := Trunc(clr*4.0-766.0);
  1128.                  end;
  1129.               end;
  1130.               spBone:
  1131.               begin
  1132.                  if (clr < 96) then
  1133.                  begin
  1134.                     palEntry[i].peRed := Trunc(clr*0.88889);
  1135.                     palEntry[i].peGreen := Trunc(clr*0.88889);
  1136.                     palEntry[i].peBlue := Trunc(clr*1.20000);
  1137.                  end
  1138.                  else if (clr < 192) then
  1139.                  begin
  1140.                     palEntry[i].peRed := Trunc(clr*0.88889);
  1141.                     palEntry[i].peGreen := Trunc(clr*1.20000-29);
  1142.                     palEntry[i].peBlue := Trunc(clr*0.88889+29);
  1143.                  end
  1144.                  else
  1145.                  begin
  1146.                     palEntry[i].peRed := Trunc(clr*1.20000-60);
  1147.                     palEntry[i].peGreen := Trunc(clr*0.88889+29);
  1148.                     palEntry[i].peBlue := Trunc(clr*0.88889+29);
  1149.                  end;
  1150.               end;
  1151.               spCopper:
  1152.               begin
  1153.                  if (clr < 208) then
  1154.                  begin
  1155.                     palEntry[i].peRed := Trunc(clr*1.23);
  1156.                     palEntry[i].peGreen := Trunc(clr*0.78);
  1157.                     palEntry[i].peBlue := Trunc(clr*0.5);
  1158.                  end
  1159.                  else
  1160.                  begin
  1161.                     palEntry[i].peRed := 255;
  1162.                     palEntry[i].peGreen := Trunc(clr*0.78);
  1163.                     palEntry[i].peBlue := Trunc(clr*0.5);
  1164.                  end;
  1165.               end;
  1166.               spBlackWhite:
  1167.               begin
  1168.                  palEntry[i].peRed := clr;
  1169.                  palEntry[i].peGreen := clr;
  1170.                  palEntry[i].peBlue := clr;
  1171.               end;
  1172.               spWhiteBlack:
  1173.               begin
  1174.                  palEntry[i].peRed := 255-clr;
  1175.                  palEntry[i].peGreen := 255-clr;
  1176.                  palEntry[i].peBlue := 255-clr;
  1177.               end;
  1178.             end;
  1179.          end;
  1180.       end;
  1181.       SetPalette(@LogPal);
  1182.    end;
  1183. end;
  1185. {-- TMMSpectrogram ------------------------------------------------------}
  1186. procedure TMMSpectrogram.SetupYScale;
  1187. var
  1188.    i,ival: Long;
  1189.    FFTBase: Float;
  1191. begin
  1192.    { Setup Y axis }
  1193.    if not(csLoading in ComponentState) then
  1194.    begin
  1195.       { Do some range checking on the base and scale factors }
  1196.       FFreqBase := MinMaxR(FFreqBase,0,FSampleRate/2-1000);
  1197.       if FFreqBase+(FSampleRate/2-FFreqScaleFactor*FFreqBase)/FFreqScaleFactor > FSampleRate/2 then
  1198.  FFreqBase := FSampleRate/2-(FSampleRate/2-FFreqScaleFactor*FFreqBase)/FFreqScaleFactor-1000;
  1200.       FFTBase := FFreqBase/FSampleRate*FFTLen;
  1202.       { Initialize graph y scale (linear or logarithmic).
  1203.         This array points to the bin to be plotted on a given row.}
  1204.       for i := 0 to FHeight-1 do
  1205.       begin
  1206.          ival := Floor(0.01+FFTBase+(i/FHeight*
  1207.                         (FFTLen/2-FFreqScaleFactor*FFTBase))/FFreqScaleFactor);
  1208.          ival := MinMax(ival,0,FFTLen div 2-1);
  1210.          Fy1^[i] := ival;
  1211.          if (i > 0) then Fy2^[i-1] := ival;
  1212.       end;
  1214.       { Compute the ending locations for lines holding multiple bins }
  1215.       for i := 0 to FHeight-1 do
  1216.           if (Fy2^[i] <= (Fy1^[i]+1)) then Fy2^[i] := 0;
  1218.       { if lines are repeated on the screen, flag this so that we don't
  1219.         have to recompute the y values. }
  1220.       for i := FHeight-1 downTo 1 do
  1221.       begin
  1222.          if (Fy1^[i] = Fy1^[i-1]) then
  1223.          begin
  1224.            Fy1^[i] := -1;
  1225.     Fy2^[i]:= 0;
  1226.          end;
  1227.       end;
  1228.    end;
  1229. end;
  1231. {-- TMMSpectrogram ------------------------------------------------------}
  1232. procedure TMMSpectrogram.RefreshPCMData(PCMData: Pointer);
  1233. var
  1234.    Value: Longint;
  1235.    i: Integer;
  1236.    ReIndex: integer;
  1237.    Back1, Back2: Long;                       { Variables for differencing }
  1238.    {$IFDEF WIN32}
  1239.    fTemp: array[0..MAX_FFTLEN] of Float;
  1240.    {$ELSE}
  1241.    fTemp: array[0..MAX_FFTLEN] of Smallint;
  1242.    {$ENDIF}
  1244. begin
  1245.    if FEnabled and Visible and not FShowInfoHint then
  1246.    begin
  1247.       ReIndex := Ord(FChannel)-1;
  1248.       if (FGain = sgrNone) then
  1249.       begin
  1250.          { perform windowing on sample Data from PCMData to FFFTData }
  1251.          if (FBits = b8bit) then
  1252.             if (FMode = mMono) then
  1253.             for i := 0 to FFTLen-1 do
  1254.             begin
  1255.                Value := PByteArray(PCMData)^[i];
  1256.                if Value >= 255 then PcmOverflow;
  1257.                fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  1258.             end
  1259.             else if (FChannel = chBoth) then
  1260.             for i := 0 to FFTLen-1 do
  1261.             begin
  1262.                Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  1263.                if Value >= 255 then PcmOverflow;
  1264.                fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  1265.             end
  1266.             else
  1267.             for i := 0 to FFTLen-1 do
  1268.             begin
  1269.                Value := PByteArray(PCMData)^[i+i+ReIndex];
  1270.                if Value >= 255 then PcmOverflow;
  1271.                fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  1272.             end
  1273.          else
  1274.             if (FMode = mMono) then
  1275.             for i := 0 to FFTLen-1 do
  1276.             begin
  1277.                Value := PSmallArray(PCMData)^[i];
  1278.                if Value >= 32767 then PcmOverflow;
  1279.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  1280.             end
  1281.             else if (FChannel = chBoth) then
  1282.             for i := 0 to FFTLen-1 do
  1283.             begin
  1284.                Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  1285.                if Value >= 32766 then PcmOverflow;
  1286.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  1287.             end
  1288.             else
  1289.             for i := 0 to FFTLen-1 do
  1290.             begin
  1291.                Value := PSmallArray(PCMData)^[i+i+ReIndex];
  1292.                if Value >= 32767 then PcmOverflow;
  1293.                fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  1294.             end;
  1295.       end
  1296.       else if (FGain = sgr6db) then
  1297.       begin
  1298.          { perform windowing on sample Data from PCMData to FFFTData }
  1299.          if (FBits = b8bit) then
  1300.          begin
  1301.             if (FMode = mMono) then
  1302.             begin
  1303.                Back1 := PByteArray(PCMData)^[0];
  1304.                for i := 0 to FFTLen-1 do
  1305.                begin
  1306.                   Value := PByteArray(PCMData)^[i];
  1307.                   if Value >= 255 then PcmOverflow;
  1308.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  1309.                   Back1 := Value;
  1310.                end;
  1311.             end
  1312.             else if (FChannel = chBoth) then
  1313.             begin
  1314.                Back1 := PByteArray(PCMData)^[0];
  1315.                for i := 0 to FFTLen-1 do
  1316.                begin
  1317.                   Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  1318.                   if Value >= 255 then PcmOverflow;
  1319.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  1320.                   Back1 := Value;
  1321.                end;
  1322.             end
  1323.             else
  1324.             begin
  1325.                Back1 := PByteArray(PCMData)^[ReIndex];
  1326.                for i := 0 to FFTLen-1 do
  1327.                begin
  1328.                   Value := PByteArray(PCMData)^[i+i+ReIndex];
  1329.                   if Value >= 255 then PcmOverflow;
  1330.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
  1331.                   Back1 := Value;
  1332.                end;
  1333.             end;
  1334.          end
  1335.          else
  1336.          begin
  1337.             if (FMode = mMono) then
  1338.             begin
  1339.                Back1 := PSmallArray(PCMData)^[0];
  1340.                for i := 0 to FFTLen-1 do
  1341.                begin
  1342.                   Value := PSmallArray(PCMData)^[i];
  1343.                   if Value >= 32767 then PcmOverflow;
  1344.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  1345.                   Back1 := Value;
  1346.                end;
  1347.             end
  1348.             else if (FChannel = chBoth) then
  1349.             begin
  1350.                Back1 := PSmallArray(PCMData)^[0];
  1351.                for i := 0 to FFTLen-1 do
  1352.                begin
  1353.                   Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  1354.                   if Value >= 32766 then PcmOverflow;
  1355.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  1356.                   Back1 := Value;
  1357.                end;
  1358.             end
  1359.             else
  1360.             begin
  1361.                Back1 := PSmallArray(PCMData)^[ReIndex];
  1362.                for i := 0 to FFTLen-1 do
  1363.                begin
  1364.                   Value := PSmallArray(PCMData)^[i+i+ReIndex];
  1365.                   if Value >= 32767 then PcmOverflow;
  1366.                   fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
  1367.                   Back1 := Value;
  1368.                end;
  1369.             end;
  1370.          end;
  1371.       end
  1372.       else { Deriv = 2 }
  1373.       begin
  1374.          { perform windowing on sample Data from PCMData to FFFTData }
  1375.          if (FBits = b8bit) then
  1376.          begin
  1377.             if (FMode = mMono) then
  1378.             begin
  1379.                Back1 := PByteArray(PCMData)^[0];
  1380.                Back2 := Back1;
  1381.                for i := 0 to FFTLen-1 do
  1382.                begin
  1383.                   Value := PByteArray(PCMData)^[i];
  1384.                   if Value >= 255 then PcmOverflow;
  1385.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  1386.                   Back2 := Back1;
  1387.                   Back1 := Value;
  1388.                end;
  1389.             end
  1390.             else if (FChannel = chBoth) then
  1391.             begin
  1392.                Back1 := PByteArray(PCMData)^[0];
  1393.                Back2 := Back1;
  1394.                for i := 0 to FFTLen-1 do
  1395.                begin
  1396.                   Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  1397.                   if Value >= 255 then PcmOverflow;
  1398.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  1399.                   Back2 := Back1;
  1400.                   Back1 := Value;
  1401.                end;
  1402.             end
  1403.             else
  1404.             begin
  1405.                Back1 := PByteArray(PCMData)^[ReIndex];
  1406.                Back2 := Back1;
  1407.                for i := 0 to FFTLen-1 do
  1408.                begin
  1409.                   Value := PByteArray(PCMData)^[i+i+ReIndex];
  1410.                   if Value >= 255 then PcmOverflow;
  1411.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
  1412.                   Back2 := Back1;
  1413.                   Back1 := Value;
  1414.                end;
  1415.             end;
  1416.          end
  1417.          else
  1418.          begin
  1419.             if (FMode = mMono) then
  1420.             begin
  1421.                Back1 := PSmallArray(PCMData)^[0];
  1422.                Back2 := Back1;
  1423.                for i := 0 to FFTLen-1 do
  1424.                begin
  1425.                   Value := PSmallArray(PCMData)^[i];
  1426.                   if Value >= 32767 then PcmOverflow;
  1427.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  1428.                   Back2 := Back1;
  1429.                   Back1 := Value;
  1430.                end;
  1431.             end
  1432.             else if (FChannel = chBoth) then
  1433.             begin
  1434.                Back1 := PSmallArray(PCMData)^[0];
  1435.                Back2 := Back1;
  1436.                for i := 0 to FFTLen-1 do
  1437.                begin
  1438.                   Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  1439.                   if Value >= 32767 then PcmOverflow;
  1440.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  1441.                   Back2 := Back1;
  1442.                   Back1 := Value;
  1443.                end;
  1444.             end
  1445.             else
  1446.             begin
  1447.                Back1 := PSmallArray(PCMData)^[ReIndex];
  1448.                Back2 := Back1;
  1449.                for i := 0 to FFTLen-1 do
  1450.                begin
  1451.                   Value := PSmallArray(PCMData)^[i+i+ReIndex];
  1452.                   if Value >= 32767 then PcmOverflow;
  1453.                   fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
  1454.                   Back2 := Back1;
  1455.                   Back1 := Value;
  1456.                end;
  1457.             end;
  1458.          end;
  1459.       end;
  1461.       fTemp[FFTLen] := 0;
  1463.       { calc the FFT }
  1464.       {$IFDEF WIN32}
  1465.       DoRealFFT(FpFFT,@fTemp,1);
  1466.       for i := 0 to FFTLen do FFFTData^[i] := Trunc(fTemp[i]/(FFTLen div 2));
  1467.       {$ELSE}
  1468.       for i := 0 to FFTLen do FFFTData^[i] := fTemp[i];
  1469.       FFT.CalcFFT(Pointer(FFFTData));
  1470.       {$ENDIF}
  1472.       { calc the magnitude }
  1473.       CalcMagnitude(False);
  1474.       { next, put this data up on the display }
  1475.       FastDraw(DrawSpectrogram,False);
  1476.    end;
  1477. end;
  1479. {-- TMMSpectrogram ------------------------------------------------------}
  1480. procedure TMMSpectrogram.RefreshFFTData(FFTData: Pointer);
  1481. begin
  1482.    Move(PByte(FFTData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
  1483.    { calc the magnitude }
  1484.    CalcMagnitude(False);
  1485.    { next, put this data up on the display }
  1486.    FastDraw(DrawSpectrogram,False);
  1487. end;
  1489. {-- TMMSpectrogram ------------------------------------------------------}
  1490. procedure TMMSpectrogram.RefreshMagnitudeData(MagData: Pointer);
  1491. begin
  1492.    Move(PByte(MagData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
  1493.    { calc display values }
  1494.    CalcMagnitude(True);
  1495.    { next, put this data up on the display }
  1496.    FastDraw(DrawSpectrogram,False);
  1497. end;
  1499. {-- TMMSpectrogram ------------------------------------------------------}
  1500. procedure TMMSpectrogram.CalcMagnitude(MagnitudeForm: Boolean);
  1501. var
  1502.    i: integer;
  1503.    re,im: Long;
  1504.    a2: Longint;
  1505.    pSave: PLongArray;
  1507. begin
  1508.    { go through the data set and convert it to magnitude form }
  1509.    if FSaveData then
  1510.       pSave := Pointer(PChar(FSaveBuffer) + Fx2*(FFTLen div 2)*sizeof(Long))
  1511.    else
  1512.       pSave := nil;
  1514.    if not FLogAmp then
  1515.    begin
  1516.       { Use sqrt(a2) in linear-amplitude mode }
  1517.       for i := 0 to (FFTLen div 2)-1 do
  1518.       begin
  1519.          if MagnitudeForm then
  1520.          begin
  1521.             a2 := PLongArray(FFFTData)^[i];
  1522.          end
  1523.          else
  1524.          begin
  1525.             { Compute the magnitude }
  1526.             {$IFDEF WIN32}
  1527.             re := FFFTData^[i+i];
  1528.             im := FFFTData^[i+i+1];
  1529.             {$ELSE}
  1530.             re := FFFTData^[FFT.BitReversed^[i]];
  1531.             im := FFFTData^[FFT.BitReversed^[i]+1];
  1532.             {$ENDIF}
  1533.             a2 := re*re+im*im;
  1534.          end;
  1536.          { Watch for possible overflow }
  1537.          if a2 < 0 then a2 := 0;
  1538.          FDisplayVal^[i] := Trunc((FAmpScale*sqrt(a2))+(-90-FSensitivy))+MIN_COLOR;
  1539.          if (pSave <> nil) then
  1540.              pSave[i] := FDisplayVal^[i];
  1541.       end;
  1542.    end
  1543.    else
  1544.    begin { log-amplitude mode }
  1545.       for i := 0 to (FFTLen div 2)-1 do
  1546.       begin
  1547.          if MagnitudeForm then
  1548.          begin
  1549.             a2 := PLongArray(FFFTData)^[i];
  1550.          end
  1551.          else
  1552.          begin
  1553.             { Compute the magnitude }
  1554.             {$IFDEF WIN32}
  1555.             re := FFFTData^[i+i];
  1556.             im := FFFTData^[i+i+1];
  1557.             {$ELSE}
  1558.             re := FFFTData^[FFT.BitReversed^[i]];
  1559.             im := FFFTData^[FFT.BitReversed^[i]+1];
  1560.             {$ENDIF}
  1561.             a2 := re*re+im*im;
  1562.          end;
  1564.          { Watch for possible overflow }
  1565.          if a2 < 1 then a2 := 1;
  1566.          FDisplayVal^[i] := Trunc((20*FAmpScale*Log(a2))+2*(-90-FSensitivy))+MIN_COLOR;
  1567.          if (pSave <> nil) then
  1568.              pSave[i] := FDisplayVal^[i];
  1569.       end;
  1570.    end;
  1571. end;
  1573. {.$DEFINE COLORTEST}
  1575. {-- TMMSpectrogram ------------------------------------------------------}
  1576. procedure TMMSpectrogram.DrawData(pDispData: PLongArray);
  1577. var
  1578.    i, j, y, index, repcount: integer;
  1579.    val,val2: Long;
  1580.    oldData: PSmallInt;
  1581.    LastVal: integer;
  1583.    {$IFDEF COLRTEST}
  1584.    clr: integer;
  1585.    {$ENDIF}
  1587. begin
  1588.    val := 0;
  1589.    i := 0;
  1590.    y := FHeight-1;
  1591.    oldData := Pointer(FOldData);
  1592.    LastVal := MIN_COLOR;
  1593.    repcount := 0;
  1594.    {$IFDEF COLORTEST}
  1595.    clr := MIN_COLOR+NUM_COLORS;
  1596.    {$ENDIF}
  1597.    while i < FHeight do
  1598.    begin
  1599.       { If this line is the same as the previous one, just use the previous
  1600.         Y value. Else go ahead and compute the value. }
  1601.       index := Fy1^[i];
  1602.       if (index <> -1) or (i = FHeight-1) then
  1603.       begin
  1604.          if i > 0 then
  1605.          begin
  1606.             if (FEmbossed) then
  1607.             begin
  1608.                { Get difference with offset }
  1609.                val2 := OldData^ - val + (NUM_COLORS div 2);
  1610.                Olddata^ := LastVal;
  1611.                inc(OldData);
  1612.                LastVal := val;
  1613.                val := val2;
  1614.             end;
  1616.             val := MinMax(val,MIN_COLOR,MIN_COLOR+NUM_COLORS-1);
  1618.             for j := 0 to repcount-1 do
  1619.             begin
  1620.                if y >= 0 then FColorValues^[y] := val;
  1621.                dec(y);
  1622.             end;
  1624.             if (i = FHeight-1) then
  1625.             begin
  1626.                while y > -1 do
  1627.                begin
  1628.                   FColorValues^[y] := val;
  1629.                   dec(y);
  1630.                end;
  1631.                break;
  1632.             end;
  1633.          end;
  1634.          repcount := 0;
  1636.          {$IFDEF COLORTEST}
  1637.          dec(Clr);
  1638.          val:= Clr;
  1639.          {$ELSE}
  1640.          val := pDispData^[index];
  1641.  if (Fy2^[i] > 0) then { Take the maximum of a set of bins }
  1642.  begin
  1643.     while (index < Fy2^[i]) do
  1644.             begin
  1645.        if (pDispData^[index] > val) then
  1646.                    val := pDispData^[index];
  1647.                inc(index);
  1648.             end;
  1649.          end;
  1650.          {$ENDIF}
  1651.       end;
  1652.       inc(repcount);
  1653.       inc(i);
  1654.    end;
  1656.    DIBCanvas.DIB_VLineMultiColor(Fx1, 0, PByte(FColorValues), FHeight);
  1657.   { for i := 0 to FHeight-1 do DIBCanvas.DIB_SetPixel(Fx1,i,FColorValues^[i]);}
  1658. end;
  1660. {-- TMMSpectrogram ------------------------------------------------------}
  1661. function TMMSpectrogram.GetFrequency(Pos: TPoint): Float;
  1662. begin
  1663.    Result := 0;
  1664.    if PtInRect(FClientRect,Pos) then
  1665.    begin
  1666.       dec(Pos.Y,FClientRect.Top);
  1667.       Result := FFreqBase+(FSampleRate/2-FFreqScaleFactor*FFReqBase)*(FHeight-Pos.Y-1)/(FHeight-1)/FFreqScaleFactor;
  1668.    end;
  1669. end;
  1671. {-- TMMSpectrogram ------------------------------------------------------}
  1672. procedure TMMSpectrogram.CalcScaleSteps;
  1673. begin
  1674.    { calc the number of steps required }
  1675.    FNumScaleSteps := Trunc(FSampleRate/2/1000*FFreqScaleFactor);
  1676.    while (FHeight div FNumScaleSteps < SCALEFONTSIZE) do
  1677.    begin
  1678.       FNumScaleSteps := FNumScaleSteps div 2;
  1679.       if FNumScaleSteps <= 1 then break;
  1680.    end;
  1681. end;
  1683. {-- TMMSpectrogram ------------------------------------------------------}
  1684. function TMMSpectrogram.GetScaleBackColor: TColor;
  1685. begin
  1686.    {$IFNDEF BUILD_ACTIVEX}
  1687.    Result := TForm(Parent).Color;
  1688.    {$ELSE}
  1689.    Result := FScaleBackColor;
  1690.    {$ENDIF}
  1691. end;
  1693. {-- TMMSpectrogram ------------------------------------------------------}
  1694. procedure TMMSpectrogram.DrawFrequencyScale;
  1695. var
  1696.    aBitmap: TBitmap;
  1697.    i, X, Y: integer;
  1698.    Text: String;
  1699.    Step: Float;
  1701. begin
  1702.    { put up the frequency scale }
  1703.    if FDrawScale then
  1704.    begin
  1705.       aBitmap := TBitmap.Create;
  1706.       try
  1707.          aBitmap.Width := SCALEWIDTH;
  1708.          aBitmap.Height := Height;
  1709.          aBitmap.Canvas.Font.Color := FScaleTextColor;
  1710.          aBitmap.Canvas.Pen.Color := FScaleLineColor;
  1711.          aBitmap.Canvas.Brush.Color := GetScaleBackColor;
  1712.          with aBitmap.Canvas do
  1713.          begin
  1714.             { Put up the frequency scale. }
  1715.             Step := (FSampleRate/2-FFreqScaleFactor*FFReqBase)/FNumScaleSteps/FFreqScaleFactor/1000;
  1717.             { draw the left side }
  1718.             FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  1719.             X := SCALEWIDTH-1;
  1720.             MoveTo(X, Height-BevelExtend-1);
  1721.             for i := 0 to FNumScaleSteps do
  1722.             begin
  1723.                Y := Height - BevelExtend - Trunc(i * (FHeight-1)/FNumScaleSteps)-1;
  1724.                LineTo(X, Y);
  1725.                LineTo(X-3, Y);
  1726.                MoveTo(X, Y);
  1727.                if (FFreqBase > 0) or (FFreqScaleFactor > 1) then
  1728.                   Text := Format('%4.2f',[FFreqBase/1000+i*step])
  1729.                else
  1730.           Text := IntToStr(Round(FFreqBase/1000+i*step-0.05));
  1731.                TextOutAligned(aBitmap.Canvas, X-5, Y, Text,SCALEFONT,SCALEFONTSIZE,1);{ right text }
  1732.             end;
  1733.             { write right scale text }
  1734.             if (FFreqBase = 0) and (FFreqScaleFactor = 1) then
  1735.                TextOutAligned(aBitmap.Canvas, 2, Height-5,
  1736.                              'KHz', SCALEFONT,SCALEFONTSIZE,0);
  1737.             { copy to screen }
  1738.             Canvas.Draw(-3, 0, aBitmap);
  1740.             { draw the right side }
  1741.             FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
  1742.             X := 0;
  1743.             MoveTo(X, Height-BevelExtend-1);
  1744.             for i := 0 to FNumScaleSteps do
  1745.             begin
  1746.                Y := Height - BevelExtend - Trunc(i * (FHeight-1)/FNumScaleSteps)-1;
  1747.                LineTo(X, Y);
  1748.                LineTo(X+3, Y);
  1749.                MoveTo(X, Y);
  1750.                if (FFreqBase > 0) or (FFreqScaleFactor > 1) then
  1751.                   Text := Format('%4.2f',[FFreqBase/1000+i*step])
  1752.                else
  1753.           Text := IntToStr(Round(FFreqBase/1000+i*step-0.05));
  1754.                TextOutAligned(aBitmap.Canvas, X+6, Y, Text, SCALEFONT,SCALEFONTSIZE,0);{ left text }
  1755.             end;
  1756.             { write right scale text }
  1757.             if (FFreqBase = 0) and (FFreqScaleFactor = 1) then
  1758.                TextOutAligned(aBitmap.Canvas, SCALEWIDTH-19, Height-5,
  1759.                               'KHz', SCALEFONT,SCALEFONTSIZE,0);
  1760.             { copy to screen }
  1761.             Canvas.Draw((Width - SCALEWIDTH)+3, 0, aBitmap);
  1762.          end;
  1764.       finally
  1765.          aBitmap.Free;
  1766.       end;
  1767.    end;
  1768. end;
  1770. {-- TMMSpectrogram ------------------------------------------------------}
  1771. procedure TMMSpectrogram.DrawBar;
  1772. var
  1773.    i,Y: integer;
  1774.    aRect: TRect;
  1776. begin
  1777.    if (FBarWidth > 0) then
  1778.    begin
  1779.       if FAccelerate then
  1780.       with Canvas do
  1781.       begin
  1782.          Pen.Mode := pmCopy;
  1783.          Pen.Color := FBarColor;
  1784.          Pen.Width := 1;
  1785.          aRect := Rect(FClientRect.Left+Fx2,FClientRect.Top,
  1786.                        FClientRect.Left+Fx2,FClientRect.Bottom);
  1787.          MoveTo(aRect.Left, aRect.Top);
  1788.          LineTo(aRect.Left, aRect.Bottom);
  1789.          for i := 0 to FNumScaleSteps do
  1790.          begin
  1791.             Y := (BevelExtend+FHeight)-Trunc(i * (FHeight-1)/FNumScaleSteps)-1;
  1792.             SetPixel(Handle,aRect.Left, Y, FBarTickColor);
  1793.          end;
  1794.       end
  1795.       else
  1796.       with DIBCanvas do
  1797.       begin
  1798.          Pen.Mode := pmCopy;
  1799.          Brush.Color := FBarColor;
  1800.          if Fx2 > Fx1 then
  1801.          begin
  1802.             aRect := Rect(Fx1+1,0,Fx2+1,FHeight);
  1803.             FillRect(aRect);
  1804.          end
  1805.          else
  1806.          begin
  1807.             aRect := Rect(0,0,Fx2+1,FHeight);
  1808.             FillRect(aRect);
  1809.          end;
  1810.          Pen.Color := FBarTickColor;
  1811.          for i := 0 to FNumScaleSteps do
  1812.          begin
  1813.             Y := FHeight - Trunc(i * (FHeight-1)/FNumScaleSteps)-1;
  1814.             MoveTo(aRect.Left,Y);
  1815.             LineTo(aRect.Right,Y);
  1816.          end;
  1817.       end;
  1818.    end;
  1819. end;
  1821. {-- TMMSpectrogram ------------------------------------------------------}
  1822. procedure TMMSpectrogram.DrawSelection(aCanvas: TMMDIBCanvas; sStart, sEnd: Longint;
  1823.                                   sColor: TColor; Solid: Boolean);
  1824. var
  1825.    rColor: Longint;
  1826. begin
  1827.    if (sStart >= 0) and (sEnd >= 0) then
  1828.    begin
  1829.       with aCanvas do
  1830.       begin
  1831.          DIB_SetTColor(sColor);
  1832.          if Solid then
  1833.          begin
  1834.             DIB_FillRectXor(Rect(sStart,0,sEnd+1,Height));
  1835.          end
  1836.          else
  1837.          begin
  1838.             DIB_SetTColor(sColor);
  1839.             DIB_HLineDashed(sStart,sEnd+1,0);
  1840.             DIB_HLineDashed(sStart,sEnd+1,Height-1);
  1841.             DIB_VLineDashed(sStart,0,Height-1);
  1842.             DIB_VLineDashed(sEnd,0,Height-1);
  1843.          end;
  1844.       end;
  1845.    end;
  1846. end;
  1848. {-- TMMSpectrogram ------------------------------------------------------}
  1849. procedure TMMSpectrogram.DrawLocator(aCanvas: TMMDIBCanvas; aPos: Longint; aColor: TColor);
  1850. begin
  1851.    with aCanvas do
  1852.    begin
  1853.       DIB_SetTColor(aColor);
  1855.       DIB_MoveTo(aPos,0);
  1856.       DIB_LineTo(aPos,FHeight);
  1857.    end;
  1858. end;
  1860. {$IFDEF WIN32}
  1861. {-- TMMSpectrogram ------------------------------------------------------}
  1862. procedure TMMSpectrogram.DrawInfo(Pos: TPoint);
  1863. var
  1864.    Text: String;
  1865.    aRect: TRect;
  1866.    Buf: array[0..255] of Char;
  1867.    DC: HDC;
  1868.    WindowHandle: HWND;
  1870. begin
  1871.    if FShowInfoHint then
  1872.    with DIBCanvas do
  1873.    begin
  1874.       if PtInRect(FClientRect,Pos) then
  1875.       begin
  1876.          Text := Format('%2.3f KHz', [GetFrequency(Pos)/1000]);
  1877.          Font.Name := 'MS Sans Serif';
  1878.          Font.Size := 8;
  1879.          Font.Style := [];
  1880.          {$IFDEF WIN32}
  1881.          Font.Color := clInfoText;
  1882.          {$ELSE}
  1883.          Font.Color := clBlack;
  1884.          {$ENDIF}
  1885.          aRect.Left := Pos.X-BevelExtend;
  1886.          if FDrawScale then dec(aRect.Left, SCALEWIDTH);
  1887.          aRect.Top := Pos.Y-BevelExtend+15;
  1888.          aRect.Right := aRect.Left + TextWidth(Text)+4;
  1889.          aRect.Bottom := aRect.Top + TextHeight(Text)+2;
  1890.          if (aRect.Bottom > FHeight) then OffsetRect(aRect,0,-40);
  1891.          if (aRect.Right > FWidth) then OffsetRect(aRect,FWidth-aRect.Right,0);
  1892.          if (aRect.Top < 0) then
  1893.          begin
  1894.             aRect.Top := 0;
  1895.             aRect.Bottom := TextHeight(Text)+2;
  1896.          end;
  1898.          {$IFDEF TRIAL}
  1899.          {$DEFINE _HACK3}
  1900.          {$I MMHACK.INC}
  1901.          {$ENDIF}
  1903.          if (SaveDC = 0) then
  1904.          begin
  1905.             { create memory DC for save bitmap }
  1906.             SaveDC := CreateCompatibleDC(DIBCanvas.Handle);
  1907.             { create bitmap to store background }
  1908.             SaveWidth := 10*TextWidth('W')+4;
  1909.             SaveHeight := TextHeight('W')+2;
  1910.             SaveBitmap := CreateCompatibleBitmap(DIBCanvas.Handle,SaveWidth,SaveHeight);
  1911.             OldBitmap := SelectObject(SaveDC, SaveBitmap);
  1912.             OldPalette := SelectPalette(SaveDC, DIBCanvas.Palette, False);
  1913.          end
  1914.          else
  1915.             { restore background }
  1916.             BitBlt(DIBCanvas.Handle,SaveInfoPos.X,
  1917.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  1918.                    SaveDC, 0,0,SRCCOPY);
  1920.          { save background }
  1921.          BitBlt(SaveDC,0,0,SaveWidth,SaveHeight,
  1922.                 DIBCanvas.Handle,aRect.Left,aRect.Top,SRCCOPY);
  1924.          SaveInfoPos := aRect.TopLeft;
  1926.          Brush.Color := INFOCOLOR;
  1927.          Brush.Style := bsSolid;
  1928.          Pen.Color := clBlack;
  1929.          Rectangle(aRect.Left,aRect.Top,aRect.Right,aRect.Bottom);
  1931.          Brush.Style := bsClear;
  1932.          DrawText(Handle, StrPCopy(Buf, Text), -1, aRect,
  1933.                   DT_SINGLELINE  or DT_VCENTER or DT_CENTER or DT_NOPREFIX);
  1934.          Brush.Style := bsSolid;
  1935.       end
  1936.       else if (SaveDC <> 0) then
  1937.       begin
  1938.          { restore background }
  1939.          BitBlt(DIBCanvas.Handle,SaveInfoPos.X,
  1940.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  1941.                    SaveDC,0,0,SRCCOPY);
  1942.       end;
  1943.       DIB_InitDrawing;                                  { copy to screen }
  1944.       DC := GetDeviceContext(WindowHandle);
  1945.       DIBCanvas.DIB_BitBlt(DC, FClientRect,0,0);
  1946.       ReleaseDC(WindowHandle, DC);
  1947.       DIB_DoneDrawing;
  1948.    end;
  1949. end;
  1950. {$ELSE}
  1951. {-- TMMSpectrogram ------------------------------------------------------}
  1952. procedure TMMSpectrogram.DrawInfo(Pos: TPoint);
  1953. var
  1954.    Text: String;
  1955.    aRect: TRect;
  1956.    Buf: array[0..255] of Char;
  1957.    Border: integer;
  1959. begin
  1960.    if FShowInfoHint then
  1961.    with Canvas do
  1962.    begin
  1963.       if PtInRect(FClientRect,Pos) then
  1964.       begin
  1965.          Text := Format('%2.3f KHz', [GetFrequency(Pos)/1000]);
  1966.          Font.Name := 'MS Sans Serif';
  1967.          Font.Size := 8;
  1968.          Font.Style := [];
  1969.          {$IFDEF WIN32}
  1970.          Font.Color := clInfoText;
  1971.          {$ELSE}
  1972.          Font.Color := clBlack;
  1973.          {$ENDIF}
  1974.          aRect.Left := Pos.X;
  1975.          aRect.Top := Pos.Y+15;
  1976.          aRect.Right := aRect.Left + TextWidth(Text)+4;
  1977.          aRect.Bottom := aRect.Top + TextHeight(Text)+2;
  1978.          if (aRect.Bottom > Height-BevelExtend) then OffsetRect(aRect,0,-40);
  1979.          Border := BevelExtend;
  1980.          if FDrawScale then inc(Border,SCALEWIDTH);
  1981.          if (aRect.Right > Width-Border) then
  1982.              OffsetRect(aRect,Width-Border-aRect.Right,0);
  1983.          if (aRect.Top < 0) then
  1984.          begin
  1985.             aRect.Top := 0;
  1986.             aRect.Bottom := TextHeight(Text)+2;
  1987.          end;
  1989.          if (SaveDC = 0) then
  1990.          begin
  1991.             { create memory DC for save bitmap }
  1992.             SaveDC := CreateCompatibleDC(Canvas.Handle);
  1993.             { create bitmap to store background }
  1994.             SaveWidth := 10*TextWidth('W')+4;
  1995.             SaveHeight := TextHeight('W')+2;
  1996.             SaveBitmap := CreateCompatibleBitmap(Canvas.Handle,SaveWidth,SaveHeight);
  1997.             OldBitmap := SelectObject(SaveDC, SaveBitmap);
  1998.             OldPalette := SelectPalette(SaveDC, DIBCanvas.Palette, False);
  1999.          end
  2000.          else
  2001.             { restore background }
  2002.             BitBlt(Canvas.Handle,SaveInfoPos.X,
  2003.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  2004.                    SaveDC,0,0,SRCCOPY);
  2006.          { save background }
  2007.          BitBlt(SaveDC,0,0,SaveWidth,SaveHeight,
  2008.                 Canvas.Handle,aRect.Left,aRect.Top,SRCCOPY);
  2010.          SaveInfoPos := aRect.TopLeft;
  2012.          Brush.Color := INFOCOLOR;
  2013.          Brush.Style := bsSolid;
  2014.          Pen.Color := clBlack;
  2015.          Rectangle(aRect.Left,aRect.Top,aRect.Right,aRect.Bottom);
  2017.          Brush.Style := bsClear;
  2018.          DrawText(Handle, StrPCopy(Buf, Text), -1, aRect,
  2019.                   DT_SINGLELINE  or DT_VCENTER or DT_CENTER or DT_NOPREFIX);
  2020.          Brush.Style := bsSolid;
  2021.       end
  2022.       else if (SaveDC <> 0) then
  2023.       begin
  2024.          { restore background }
  2025.          BitBlt(Canvas.Handle,SaveInfoPos.X,
  2026.                    SaveInfoPos.Y,SaveWidth,SaveHeight,
  2027.                    SaveDC,0,0,SRCCOPY);
  2028.       end;
  2029.    end;
  2030. end;
  2031. {$ENDIF}
  2033. {-- TMMSpectrogram ------------------------------------------------------}
  2034. procedure TMMSpectrogram.DrawSpectrogram(ClearBackGround: Boolean);
  2035. var
  2036.    i: integer;
  2037.    aRect: TRect;
  2038. begin
  2039. //   ClearBackGround := False;
  2040. //   FNeedReset := False;
  2042.    DIBCanvas.DIB_InitDrawing;
  2043.                                                    { clear background }
  2044.    if ClearBackGround or FNeedReset then
  2045.    begin
  2046.       if FEmbossed then
  2047.          DIBCanvas.DIB_SetColor((MIN_COLOR+NUM_COLORS) div 2)
  2048.       else
  2049.          DIBCanvas.DIB_SetColor(MIN_COLOR);
  2051.       DIBCanvas.DIB_Clear;
  2053.       Fx1 := -FBarWidth;//Max(-FBarWidth,0);
  2054.       Fx2 := 0;
  2056.       if ClearBackGround and FSaveData then
  2057.       begin
  2058.          //DB_WriteStrLn(0,'Restoring Data...');
  2059.          for i := 0 to FWidth-1 do
  2060.          begin
  2061.             DrawData(Pointer(PChar(FSaveBuffer) + Fx2*(FFTLen div 2)*sizeof(Long)));
  2062.             inc(Fx1);
  2063.             if (Fx1 = FWidth) then Fx1 := 0;
  2064.             inc(Fx2);
  2065.             if (Fx2 = FWidth) then Fx2 := 0;
  2066.          end;
  2067.       end;
  2069.       if not FNeedReset and not FSaveData then
  2070.          ResetSpectrograms(Self);
  2071.    end
  2072.    else
  2073.    begin
  2074.       { now plot the data }
  2075.       DrawData(FDisplayVal);
  2076.    end;
  2078.    { copy to screen }
  2079.    if ClearBackGround or FNeedReset {or FSaveData} or not FAccelerate then
  2080.    begin
  2081.       if not FScroll or (Fx2 < FWidth) then DrawBar;
  2083.       { draw solid Selection }
  2084.       DrawSelection(DIBCanvas,FSelectStart,FSelectEnd,FSelectColor,True);
  2086.       { draw doted Selection }
  2087.       DrawSelection(DIBCanvas,FSelectStart,FSelectEnd,FSelectDotColor,False);
  2089.       { draw the locator }
  2090.       DrawLocator(DIBCanvas,FLocator,FLocatorColor);
  2092.       DIBCanvas.DIB_BitBlt(Canvas.Handle, FClientRect,0,0);
  2093.       FNeedReset := False;
  2094.    end
  2095.    else
  2096.    begin
  2097.       aRect := FClientRect;
  2098.       aRect.Left := FClientRect.Left + Fx1;
  2099.       aRect.Right := 1;
  2100.       DIBCanvas.DIB_BitBlt(Canvas.Handle,aRect,Fx1,0);
  2101.    end;
  2103.    { move the bar }
  2104.    if FScroll then
  2105.    begin
  2106.       if (Fx2 < FWidth) then
  2107.       begin
  2108.          if Accelerate then DrawBar;
  2109.          inc(Fx1);
  2110.          inc(Fx2);
  2111.       end
  2112.       else
  2113.       begin
  2114.          if Accelerate then
  2115.          begin
  2116.             {$IFNDEF BUILD_ACTIVEX}
  2117.             aRect:= BoundsRect;
  2118.             {$ELSE}
  2119.             aRect:= ClientRect;
  2120.             {$ENDIf}
  2121.             InflateRect(aRect, -BevelExtend, -BevelExtend);
  2122.             if FDrawScale then InflateRect(aRect, -SCALEWIDTH, 0);
  2123.             dec(aRect.Right,Max(FBarWidth-1,0));
  2124.             {$IFNDEF BUILD_ACTIVEX}
  2125.             ScrollWindowEx(Parent.Handle,-1,0,@aRect,@aRect,0,nil,0);
  2126.             {$ELSE}
  2127.             ScrollWindowEx(Handle,-1,0,@aRect,@aRect,0,nil,0);
  2128.             {$ENDIF}
  2129.          end
  2130.          else DIBCanvas.DIB_CopyDIBBits(biSurface,0,0,FWidth-1,FHeight,1,0);
  2131.       end;
  2132.    end
  2133.    else if not FSaveData or not ClearBackGround then
  2134.    begin
  2135.       if FAccelerate then DrawBar;
  2136.       inc(Fx1);
  2137.       if (Fx1 = FWidth) then Fx1 := 0;
  2138.       inc(Fx2);
  2139.       if (Fx2 = FWidth) then Fx2 := 0;
  2140.    end;
  2141.    DIBCanvas.DIB_DoneDrawing;
  2142. end;
  2144. {-- TMMSpectrogram ------------------------------------------------------}
  2145. Procedure TMMSpectrogram.Paint;
  2146. var
  2147.    aRect: TRect;
  2149. begin
  2150.    with Canvas do
  2151.    begin
  2152.       if FDrawScale then
  2153.       begin
  2154.          { clear the space between the scales only, to eliminate flicker }
  2155.          Brush.Color := GetScaleBackColor;
  2156.          Brush.Style := bsSolid;
  2157.          aRect := Rect(0,0,SCALEWIDTH,Height);
  2158.          aRect := Rect(SCALEWIDTH-3,0,SCALEWIDTH,Height);
  2159.          FillRect(aRect);
  2160.          aRect:= Rect(Width-SCALEWIDTH,0,Width-SCALEWIDTH+3,Height);
  2161.          FillRect(aRect);
  2162.          { make place for the scale }
  2163.          aRect := GetClientRect;
  2164.          InflateRect(aRect,-SCALEWIDTH,0);
  2165.       end
  2166.       else aRect := GetClientRect;
  2168.       { draw the Bevel }
  2169.       aRect := Bevel.PaintBevel(Canvas, aRect, True);
  2170.    end;
  2171.    { now draw the scales and the spectrogram }
  2172.    DrawFrequencyScale;
  2173.    if (csDesigning in ComponentState) {$IFDEF WIN32}or (csPaintCopy in ControlState){$ENDIF} then
  2174.        DrawSpectrogram(True)
  2175.    else
  2176.        FastDraw(DrawSpectrogram,True);
  2178.    {$IFDEF BUILD_ACTIVEX}
  2179.    if Selected then
  2180.    begin
  2181.       Canvas.Brush.Style := bsClear;
  2182.       Canvas.Pen.Color   := clRed;
  2183.       Canvas.Rectangle(0,0,Width,Height);
  2184.       Canvas.Brush.Style := bsSolid;
  2185.    end;
  2186.    {$ENDIF}
  2187. end;
  2189. {-- TMMSpectrogram ------------------------------------------------------}
  2190. procedure TMMSpectrogram.Selecting(Min, Max: Longint);
  2191. begin
  2192.    Select(Min,Max,True);
  2193.    if assigned(FOnSelecting) then FOnSelecting(Self,Min,Max);
  2194. end;
  2196. {-- TMMSpectrogram ------------------------------------------------------}
  2197. procedure TMMSpectrogram.SelectEnd(Min, Max: Longint);
  2198. begin
  2199.    Select(Min,Max,False);
  2200.    if assigned(FOnSelectEnd)then FOnSelectEnd(Self,Min,Max);
  2201. end;
  2203. {-- TMMSpectrogram ------------------------------------------------------}
  2204. function TMMSpectrogram.IsLocator(X: integer): Boolean;
  2205. begin
  2206.    Result := (FLocator >= 0) and
  2207.              (X >= (FLocator+BevelExtend)-3) and
  2208.              (X <= (FLocator+BevelExtend)+3) and
  2209.              (X >= 0) and (X <= Width);
  2210. end;
  2212. {-- TMMSpectrogram ------------------------------------------------------}
  2213. function TMMSpectrogram.IsSelectStart(X: integer): Boolean;
  2214. begin
  2215.    Result := (FSelectStart >= 0) and
  2216.              (X >= (FSelectStart+BevelExtend)-3) and
  2217.              (X <= (FSelectStart+BevelExtend)+2) and
  2218.              (X >= 0) and (X <= Width);
  2219. end;
  2221. {-- TMMSpectrogram ------------------------------------------------------}
  2222. function TMMSpectrogram.IsSelectEnd(X: integer): Boolean;
  2223. begin
  2224.    Result := (FSelectEnd >= 0) and
  2225.              (X >= (FSelectEnd+BevelExtend)-2) and
  2226.              (X <= (FSelectEnd+BevelExtend)+3) and
  2227.              (X >= 0) and (X <= Width);
  2228. end;
  2230. {-- TMMSpectrogram ------------------------------------------------------}
  2231. function TMMSpectrogram.IsInSelection(X: integer): Boolean;
  2232. begin
  2233.    Result := (FSelectStart >= 0) and (FSelectEnd >= 0) and
  2234.              (X >= (FSelectStart+BevelExtend)) and
  2235.              (X <= (FSelectEnd+BevelExtend)) and
  2236.              (X >= 0) and (X <= Width);
  2237. end;
  2239. var
  2240.    StartOrigin,Origin,
  2241.    MinShift,
  2242.    MaxShift: Longint;
  2243.    Moving  : Boolean;
  2245. {-- TMMSpectrogram ------------------------------------------------------}
  2246. procedure TMMSpectrogram.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2247. var
  2248.    aRect: TRect;
  2249. begin
  2250.    if not (csDesigning in ComponentState) and Enabled then
  2251.    begin
  2252.       if (Button = mbLeft) and FShowInfo then
  2253.       begin
  2254.          aRect.TopLeft := ClientToScreen(FClientRect.TopLeft);
  2255.          aRect.BottomRight := ClientToScreen(FClientRect.BottomRight);
  2256.          ClipCursor(@aRect);
  2258.          FShowInfoHint := True;
  2260.          { maybe there is a hint, hide it }
  2261.          if ShowHint then
  2262.          begin
  2263.             FOldShowHint := ShowHint;
  2264.             ShowHint := False;
  2265.             Application.CancelHint;
  2266.             Update;
  2267.          end
  2268.          else FOldShowHint := False;
  2270.          {$IFDEF WIN32}
  2271.          { we must save the screen in our bitmap }
  2272.          DIBCanvas.CopyRect(Rect(0,0,FWidth,FHeight),Canvas,FClientRect);
  2273.          {$ENDIF}
  2274.          DrawInfo(Point(X,Y));
  2275.       end
  2276.       else if (Button = mbRight) and FUseSelection and not FLocked and not FDrawing then
  2277.       begin
  2278.          aRect := BeveledRect;
  2280.          if PtInRect(aRect,Point(X,Y)) then
  2281.          begin
  2282.             FDrawing := True;
  2283.             Moving := False;
  2285.             MouseCapture := True;
  2287.             if IsSelectStart(X) then
  2288.             begin
  2289.                Origin := FSelectEnd;
  2290.             end
  2291.             else if IsSelectEnd(X) then
  2292.             begin
  2293.                Origin := FSelectStart;
  2294.             end
  2295.             else if IsInSelection(X) then
  2296.             begin
  2297.                Windows.SetCursor(Screen.Cursors[crsHand4]);
  2298.                Moving := True;
  2299.                Origin := X-BevelExtend;
  2301.                MinShift := -(FSelectStart);
  2302.                MaxShift := (FWidth-1)-FSelectEnd;
  2303.             end
  2304.             else
  2305.             begin
  2306.                Windows.SetCursor(Screen.Cursors[crSizeWE]);
  2307.                Origin := X-BevelExtend;
  2309.                { clear old selection }
  2310.                Selecting(-1,-1);
  2311.                Selecting(Origin,Origin+1);
  2312.             end;
  2313.             StartOrigin := Origin;
  2314.          end;
  2315.       end;
  2316.    end;
  2318.    inherited MouseDown(Button, Shift, X, Y);
  2319. end;
  2321. {-- TMMSpectrogram ------------------------------------------------------}
  2322. procedure TMMSpectrogram.MouseMove(Shift: TShiftState; X, Y: Integer);
  2323. var
  2324.    NewPos,Diff: Longint;
  2325. begin
  2326.    if FShowInfo and FShowInfoHint then
  2327.    begin
  2328.       inherited MouseMove(Shift, X, Y);
  2330.       DrawInfo(Point(X,Y));
  2331.    end
  2332.       else if FUseSelection and not FLocked and FDrawing then
  2333.    begin
  2334.       X := Limit(X,BevelExtend,(Width-BevelExtend)-1);
  2336.       if Moving then
  2337.       begin
  2338.          Diff := Limit((X-BevelExtend)-Origin,MinShift,MaxShift);
  2340.          Selecting(FSelectStart+Diff,FSelectEnd+Diff);
  2341.          Origin := Origin + Diff;
  2342.          MinShift := MinShift - Diff;
  2343.          MaxShift := MaxShift - Diff;
  2344.       end
  2345.       else
  2346.       begin
  2347.          NewPos := Limit(X-BevelExtend,0,Width-2*BevelExtend);
  2348.          Selecting(Origin,NewPos);
  2349.       end;
  2351.       inherited MouseMove(Shift, X, Y);
  2352.    end
  2353.    else if FUseSelection and not FLocked then
  2354.    begin
  2355.       inherited MouseMove(Shift, X, Y);
  2357.       if IsSelectStart(X) or IsSelectEnd(X) then
  2358.          Cursor := crSizeWE
  2359.       else if IsInSelection(X) then
  2360.          Cursor := crsHand3
  2361.       else if (Cursor=crSizeWE)or(Cursor=crsHand3)or(Cursor=crsZoom1) then
  2362.          Cursor := crDefault;
  2363.    end
  2364.    else
  2365.    begin
  2366.       inherited MouseMove(Shift, X, Y);
  2368.       if (Cursor <> crCross) and (Cursor <> crHourGlass) then
  2369.           Cursor := crDefault;
  2370.    end;
  2371. end;
  2373. {-- TMMSpectrogram ------------------------------------------------------}
  2374. procedure TMMSpectrogram.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2375. var
  2376.    P: TPoint;
  2377. begin
  2378.    if (Button = mbLeft) and FShowInfoHint then
  2379.    begin
  2380.       { restore background }
  2381.       if FEnabled then DrawInfo(Point(-1,-1));
  2382.       if (SaveDC <> 0) then
  2383.       begin
  2384.          SelectObject(SaveDC, OldBitmap);
  2385.          DeleteObject(SaveBitmap);
  2386.          SelectObject(SaveDC, OldPalette);
  2387.          SaveBitmap := 0;
  2388.          DeleteDC(SaveDC);
  2389.          SaveDC := 0;
  2390.       end;
  2391.       FShowInfoHint := False;
  2392.       ClipCursor(nil);
  2393.       ShowHint := FOldShowHint;
  2394.    end
  2395.    else if (Button = mbRight) and FDrawing then
  2396.    begin
  2397.       FDrawing := False;
  2398.       MouseCapture := False;
  2400.       if (FSelectEnd = FSelectStart+1) or (FSelectEnd = FSelectStart-1) then
  2401.       begin
  2402.          Selecting(-1,-1);
  2403.       end;
  2405.       SelectEnd(FSelectStart,FSelectEnd);
  2406.    end;
  2408.    inherited MouseUp(Button, Shift, X, Y);
  2409. end;
  2411. end.