mmspectr.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 19.11.98 - 22:31:13 $                                        =}
{========================================================================}
Unit MMSpectr;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Menus,
    MMSystem,
    MMUtils,
    MMObj,
    MMTimer,
    MMString,
    MMMath,
    MMMulDiv,
    MMFFT,
    MMRegs,
    MMPCMSup,
    MMDIBCv;

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEHEIGHT} {$ENDIF}
    SCALEHEIGHT     = 40;
    {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEWIDTH} {$ENDIF}
    SCALEWIDTH      = 32;
    {$IFDEF CBUILDER3} {$EXTERNALSYM SCALEFONT} {$ENDIF}
    SCALEFONT       = 'ARIAL';

    SCALEFONTSIZE   : integer = 10;
    SCROLLDISTANCE  : integer = 2;

    INFOCOLOR       : TCOLOR = clWhite;

    {$IFDEF CBUILDER3} {$EXTERNALSYM MAX_FFTLEN} {$ENDIF}
    MAX_FFTLEN      = 4096; { Define the maximum FFT buffer length.        }
    {$IFDEF CBUILDER3} {$EXTERNALSYM MAXDECAYCOUNT} {$ENDIF}
    MAXDECAYCOUNT   = 32;   { Maximum amount of temporal averaging allowed }

type
    EMMSpectrumError     = class(Exception);
    TMMSpectrumKind      = (skDots, skLines, skVLines, skBars, skPeaks, skScroll);
    TMMSpectrumGain      = (sgNone,sg3db,sg6db,sg9db,sg12db);
    TMMSpectrumDrawBar   = procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; nSpots,Peak: integer) of object;
    TMMSpectrumClear     = procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect) of object;
    TMMSpectrumGetXScale = procedure(Sender: TObject; pX1,pX2: PIntArray) of object;

    { array for uniform decay mode values }
    PDataBuf       = ^TDataBuf;
    TDataBuf       = array[0..MAXDECAYCOUNT-1] of PLongArray;

    TPeak     = record          { record for peak values                  }
      Freq     : Float;
      Amp      : Float;
      db       : Float;
      { !! internal for peak display, do not use !!                }
      Amplitude: Long;          { peak amplitude found             }
      Index    : integer;       { bin number of the peak amplitude }
      X        : integer;       { the X value for the Peak         }
    end;

    TDrawVal = record           { record for display values to draw    }
      Left     : integer;       { left X1 for this set of bin's        }
      Right    : integer;       { right X2 for this set of bin's       }
      Value    : Longint;       { the (Y) value for this set of bin's  }
      Peak     : integer;       { the peak value for this set of bin's }
      PeakCnt  : integer;       { internal peak counter for timing     }
    end;
    PDrawArray = ^TDrawArray;
    TDrawArray = array[0..DebugCount] of TDrawVal;

    {-- TMMSpectrum -----------------------------------------------------}
    TMMSpectrum = class(TMMDIBGraphicControl)
    private
      FTimerID    : Longint;    { timer for peak handling                }
      FBarDIB     : TMMDIBCanvas;{ bitmap for inactive bars              }
      {$IFDEF WIN32}
      FpFFT       : PFFTReal;   { the instance for the FFT               }
      {$ELSE}
      FFT         : TMMFFT;     { the object that performs the FFT       }
      {$ENDIF}
      FFFTData    : PSmallArray;{ Array for FFT data                     }
      FWinBuf     : PIntArray;  { Array storing windowing function       }
      FDataBuf    : PDataBuf;   { Memory for averaging mode              }
      FYBase      : PLongArray; { Scaling offset for log calculations    }
      FLastVal_F  : PFloatArray;{ Last value buffer for exp decay mode   }
      FLastVal    : PLongArray; { Last value buffer for uniform averaging}
      FDisplayVal : PLongArray; { Array storing display values           }
      Fx1         : PIntArray;  { Array of bin #'s displayed             }
      Fx2         : PIntArray;  { Array of terminal bin #'s              }
      FYScale     : PIntArray;  { scaling factors                        }
      FDrawVal    : PDrawArray; { array with the rect's / points to draw }

      FFTLen      : integer;    { Number of points for FFT               }
      FSampleRate : Longint;    { A/D sampling rate                      }
      FLogFreq    : Boolean;    { true for log-based frequency scale     }
      FLogAmp     : Boolean;    { true for log-based amplitude scale     }
      Fys         : Float;      { set for max of y-axis                  }
      FLogBase    : integer;    { base of log scale (default=6 = -60db)  }
      FLogs       : integer;    { for max of log scale (default=0 = 0db) }
      FGain3db    : integer;    { indicating 3db/octave scale factor gain}
      FDeriv      : integer;    { doing differencing for 6db/octave gain }
      FRefFreq    : integer;    { ref. frequency for n db/octave gains   }

      FPeak         : TPeak;    { the current peak value over all frequ. }
      FWindow       : TMMFFTWindow;{ selected window function            }
      FDecay        : integer;  { the current Decay value                }
      FDecayMode    : TMMDecayMode;{ indicating decay mode on/off        }
      FDecayFactor  : Float;    { Geometric decay factor                 }
      FDecayCount   : integer;  { Temporal averaging parameter           }
      FDecayCntAct  : integer;  { Total number of bins averaged so far   }
      FMaxDecayCount: integer;  { Maximum value for the decay count      }
      FDecayPtr     : integer;  { index for cur. averag. buffer location }

      FShift           : integer;{ Number of bits for gain shift         }
      FLogScaleFactor  : Float;  { Scaling factor for log values         }
      FDispScaleFactor : Float;  { Display scalefactor for log values    }
      FFreqScaleFactor : Float;  { Scalefactor for inc. the horiz. scale }
      FFreqBase        : Float;  { Base frequency for the display        }

      FKind          : TMMSpectrumKind;{ draw as dots,bars,lines,vlines  }
      FEnabled       : Boolean;  { Enable or disable Spectrum            }
      FBar1Color     : TColor;   { Farbe f黵 die Punkte im 1. Abschnitt  }
      FBar2Color     : TColor;   { Farbe f黵 die Punkte im 2. Abschnitt  }
      FBar3Color     : TColor;   { Farbe f黵 die Punkte im 3. Abschnitt  }
      FInact1Color   : TColor;   { foreColor for inactive spots 1        }
      FInact2Color   : TColor;   { foreColor for inactive spots 2        }
      FInact3Color   : TColor;   { foreColor for inactive spots 3        }
      FScaleTextColor: TColor;   { the text color for the scale          }
      FScaleLineColor: TColor;   { the line color for the scale          }
      FGridColor     : TColor;   { the grid color                        }
      FScaleBackColor: TColor;   { background color for the scale        }
      FInactiveDoted : Boolean;  { draw the inactive spots doted         }
      FActiveDoted   : Boolean;  { draw the active spots doted           }
      FPoint1        : integer;  { Schwelle von 1. zu 2. Abschnitt %     }
      FPoint2        : integer;  { Schwelle von 2. zu 3. Abschnitt %     }
      FPoint1Spot    : integer;  { on which spot begins next color       }
      FPoint2Spot    : integer;  { on which spot begins next color       }
      FSpotSpace     : integer;  { vertical space between spots          }
      FSpotHeight    : integer;  { the spot height in pixel              }
      FSpace         : integer;  { horizontal between the bars           }
      FFirstSpace    : integer;  { the space before the first spot       }
      FNumSpots      : integer;  { number of Spots                       }
      FNumPeaks      : integer;  { number of spots displayed as peak     }
      FPeakDelay     : integer;  { the delay for the peak spots          }
      FPeakSpeed     : integer;  { the decrease speed for the peak spots }
      FDisplayPeak   : Boolean;  { show the highest frequency or not     }
      FDrawInactive  : Boolean;  { draw the inactive spots or not        }
      FBits          : TMMBits;  { bit8 or bit16                         }
      FChannel       : TMMChannel;{ chBoth, chLeft or chRigth            }
      FMode          : TMMMode;  { mMono, mStereo or mQuadro             }
      FBytes         : Longint;  { calculated data bytes per spectrum    }
      FGain          : TMMSpectrumGain;{ Amount of db/octave gain        }
      FOldShowHint   : Boolean;  { saved ShowHint propertie              }
      FShowInfo      : Boolean;  { show the freq/amp info or not         }
      FShowInfoHint  : Boolean;  { mouse is down, show the info          }
      FDrawFreqScale : Boolean;  { draw the horiz scale or not          }
      FDrawAmpScale  : Boolean;  { draw the vert scale or not            }
      FDrawGrid      : Boolean;  { draw the grid or not                  }
      FWidth         : integer;  { calculated width without border       }
      FHeight        : integer;  { calculated height without border      }
      FClientRect    : TRect;    { calculated beveled Rect               }

      { Events }
      FOnNeedData       : TNotifyEvent;
      FOnGainOverflow   : TNotifyEvent;
      FOnPcmOverflow    : TNotifyEvent;
      FOnDrawBar        : TMMSpectrumDrawBar;
      FOnClearBackground: TMMSpectrumClear;
      FOnGetXScale      : TMMSpectrumGetXScale;

      procedure CreateDataBuffers(Length: integer);
      procedure FreeDataBuffers;
      procedure CreateArrays(Size: integer);
      procedure FreeArrays;
      procedure ResetDecayBuffers;
      procedure ResetPeakValues;
      procedure XRangeCheck;
      procedure SetupXScale;
      procedure SetupLogScales;
      procedure SetupLinScales;
      procedure CalcNumSpots;
      procedure CalcMagnitude(MagnitudeForm: Boolean);
      procedure CalcDisplayValues;
      procedure SetBytesPerSpectrum;
      procedure InitializeData;
      procedure NeedData;
      procedure DrawFrequencyScale(Dummy: Boolean);
      procedure DrawAmplitudeScale;
      procedure SetLocalVariables(DIB: TMMDIBCanvas);
      procedure InitLocalVariables;
      procedure DrawPeakValue;
      {$IFDEF USEASM}
      procedure DrawBar(X1,X2,nSpots,Peak: integer);{$IFDEF WIN32}pascal;{$ENDIF}
      procedure DrawBarPeak(X1,X2,nSpots,Peak: integer);{$IFDEF WIN32}pascal;{$ENDIF}
      procedure PointedLineTo(X,Y: integer; Pointed: Boolean);{$IFDEF WIN32}pascal;{$ENDIF}
      {$ENDIF}
      procedure DrawBar_Native(X1,X2,nSpots,Peak: integer);
      procedure DrawBarPeak_Native(X1,X2,nSpots,Peak: integer);
      procedure DrawGrids;
      procedure DrawInfo(Pos: TPoint);
      procedure DrawAsDots;
      procedure DrawAsLines;
      procedure DrawAsVLines;
      procedure DrawAsBars;
      procedure DrawInactiveSpots;
      procedure DrawSpectrum(Clear: Boolean);

      procedure SetOnDrawBar(aValue: TMMSpectrumDrawBar);
      procedure AdjustSize(var W, H: Integer);
      procedure AdjustBounds;
      procedure SetFFTLen(aLength: integer);
      procedure SetWindow(aValue: TMMFFTWindow);
      procedure SetLogFreq(aValue: Boolean);
      procedure SetLogAmp(aValue: Boolean);
      procedure SetKind(aValue: TMMSpectrumKind);
      procedure SetDecayMode(aValue: TMMDecayMode);
      procedure SetDecay(aValue: integer);
      procedure SetVertScale(aValue: integer);
      function  GetVertScale: integer;
      procedure SetFreqScale(aValue: integer);
      function  GetFreqScale: integer;
      procedure SetDrawFreqScale(aValue: Boolean);
      procedure SetDrawAmpScale(aValue: Boolean);
      procedure SetDrawGrid(aValue: Boolean);
      procedure SetEnabled(aValue: Boolean);
      procedure SetColors(Index: Integer; Value: TColor);
      procedure SetPoints(Index, aValue: integer);
      procedure SetSpotSpace(aValue: integer);
      procedure SetSpotHeight(aValue: integer);
      procedure SetSpace(aValue: integer);
      procedure SetNumPeaks(aValue: integer);
      procedure SetPeakDelay(aValue: integer);
      procedure SetPeakSpeed(aValue: integer);
      procedure SetDisplayPeak(aValue: Boolean);
      procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
      function  GetPCMWaveFormat: TPCMWaveFormat;
      procedure SetBits(aValue: TMMBits);
      procedure SetChannel(aValue: TMMChannel);
      procedure SetMode(aValue: TMMMode);
      procedure SetSampleRate(aValue: Longint);
      procedure SetRefFreq(aValue: integer);
      procedure SetGain(aValue: TMMSpectrumGain);
      procedure SetDrawInactive(aValue: Boolean);
      procedure SetInactiveDoted(aValue: Boolean);
      procedure SetActiveDoted(aValue: Boolean);
      function  GetScaleBackColor: TColor;
      function  GetPeak: TPeak;

      procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;

    protected
      procedure ChangeDesigning(aValue: Boolean); override;
      procedure SetBPP(aValue: integer); override;
      procedure Paint; override;
      procedure Loaded; override;
      procedure GainOverflow; dynamic;
      procedure PcmOverflow; dynamic;
      procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
      procedure Changed; override;
      procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
      procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
      procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;

      function  GetOptimalWidth(aWidth: integer): integer;

      procedure ForceRescale;

      function  GetFrequencyAtPos(Pos: TPoint): Float;
      function  GetAmplitudeAtPos(Pos: TPoint): Float;

      procedure RefreshPCMData(PCMData: Pointer);
      procedure RefreshFFTData(FFTData: Pointer);
      procedure RefreshMagnitudeData(MagData: Pointer);
      procedure ResetData;

      property  Peak: TPeak read GetPeak;
      property  BytesPerSpectrum: Longint read FBytes;
      property  PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
      property  FFTData: PSmallArray read FFFTData;

    published
      { Events }
      property OnClick;
      property OnDblClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnStartDrag;
      property OnGetXScale: TMMSpectrumGetXScale read FOnGetXScale write FOnGetXScale;
      property OnNeedData: TNotifyEvent read FOnNeedData write FOnNeedData;
      property OnDrawBar: TMMSpectrumDrawBar read FOnDrawBar write SetOnDrawBar;
      property OnClearBackground: TMMSpectrumClear read FOnClearBackground write FOnClearBackground;
      property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
      property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;

      property Align;
      property Bevel;
      property BackGroundDIB;
      property UseBackGroundDIB;
      property PaletteRealize;
      property Color default clBlack;
      property Cursor default crCross;
      property ParentShowHint;
      property ParentColor default False;
      property PopupMenu;
      property Visible;
      property ShowHint;
      property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      property DrawFreqScale: Boolean read FDrawFreqScale write SetDrawFreqScale default False;
      property DrawAmpScale: Boolean read FDrawAmpScale write SetDrawAmpScale default False;
      property DrawGrid: Boolean read FDrawGrid write SetDrawGrid default False;
      property Height default 89;
      property Width default 194;
      property Space: integer read FSpace write SetSpace default 1;
      property SpotSpace: integer read FSpotSpace write SetSpotSpace default 1;
      property SpotHeight: integer read FSpotHeight write SetSpotHeight default 1;
      property Bar1Color: TColor index 0 read FBar1Color write SetColors default clAqua;
      property Bar2Color: TColor index 1 read FBar2Color write SetColors default clAqua;
      property Bar3Color: TColor index 2 read FBar3Color write SetColors default clRed;
      property Inactive1Color: TColor index 3 read FInact1Color write SetColors default clTeal;
      property Inactive2Color: TColor index 4 read FInact2Color write SetColors default clTeal;
      property Inactive3Color: TColor index 5 read FInact3Color write SetColors default clMaroon;
      property ScaleTextColor: TColor index 6 read FScaleTextColor write SetColors default clBlack;
      property ScaleLineColor: TColor index 7 read FScaleLineColor write SetColors default clBlack;
      property GridColor: TColor index 8 read FGridColor write SetColors default clGray;
      {$IFDEF BUILD_ACTIVEX}
      property ScaleBackColor: TColor index 9 read FScaleBackColor write SetColors default clBtnFace;
      {$ENDIF}
      property Point1: integer index 0 read FPoint1 write SetPoints default 50;
      property Point2: integer index 1 read FPoint2 write SetPoints default 85;
      property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
      property InactiveDoted: Boolean read FInactiveDoted write SetInactiveDoted default False;
      property ActiveDoted: Boolean read FActiveDoted write SetActiveDoted default False;
      property Mode: TMMMode read FMode write SetMode default mMono;
      property BitLength: TMMBits read FBits write SetBits default b8bit;
      property Channel: TMMChannel read FChannel write SetChannel default chBoth;
      property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
      property RefFreq: integer read FRefFreq write SetRefFreq default 1000;
      property Gain: TMMSpectrumGain read FGain write SetGain default sgNone;
      property FFTLength: integer read FFTLen write SetFFTLen default 128;
      property LogFreq: Boolean read FLogFreq write SetLogFreq default False;
      property LogAmp: Boolean read FLogAmp write SetLogAmp default False;
      property Kind: TMMSpectrumKind read FKind write SetKind default skBars;
      property Window: TMMFFTWindow read FWindow write SetWindow default fwHamming;
      property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default dmNone;
      property Decay: integer read FDecay write SetDecay default 1;
      property VerticalScale: integer read GetVertScale write SetVertScale default 100;
      property FrequencyScale: integer read GetFreqScale write SetFreqScale default 1;
      property NumPeaks: integer read FNumPeaks write SetNumPeaks default 1;
      property PeakDelay: integer read FPeakDelay write SetPeakDelay default 20;
      property PeakSpeed: integer read FPeakSpeed write SetPeakSpeed default 0;
      property DisplayPeak: Boolean read FDisplayPeak write SetDisplayPeak default False;
    end;

implementation

uses Consts;

{.$DEFINE USE_INTEGER_CODE}

{$IFDEF USE_INTEGER_CODE}
const
    { Table for approximating the logarithm.