| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202 |
- {========================================================================}
- {= (c) 1995-98 SwiftSoft Ronald Dittrich =}
- {========================================================================}
- {= All Rights Reserved =}
- {========================================================================}
- {= D 01099 Dresden = Tel.: +0351-8012255 =}
- {= Loewenstr.7a = info@swiftsoft.de =}
- {========================================================================}
- {= Actual versions on http://www.swiftsoft.de/mmtools.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: 20.01.1998 - 18:00:00 $ =}
- {========================================================================}
- 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,
- DsgnIntf,
- MMSystem,
- MMUtils,
- MMObj,
- MMTimer,
- MMString,
- MMMath,
- MMMulDiv,
- MMFFT,
- MMRegs,
- MMPCMSup,
- MMDIBCv;
- const
- SCALEHEIGHT = 40;
- SCALEWIDTH = 32;
- SCALEFONT = 'ARIAL';
- SCALEFONTSIZE : integer = 10;
- SCROLLDISTANCE : integer = 2;
- INFOCOLOR : TCOLOR = clWhite;
- MAX_FFTLEN = 4096; { Define the maximum FFT buffer length. }
- 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; Value,Peak: integer) 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..Count] of TDrawVal;
- {-- TMMSpectrum -----------------------------------------------------}
- TMMSpectrum = class(TMMDIBGraphicControl)
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function GetOptimalWidth(aWidth: integer): integer;
- function GetFrequency(Pos: TPoint): Float;
- function GetAmplitude(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;
- published
- { Events }
- property OnClick;
- property OnDblClick;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnNeedData: TNotifyEvent read FOnNeedData write FOnNeedData;
- property OnDrawBar: TMMSpectrumDrawBar read FOnDrawBar write SetOnDrawBar;
- 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;
- 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;
- {-- TMMSpectrumEditor -----------------------------------------------}
- TMMSpectrumEditor = class(TComponentEditor)
- public
- procedure ExecuteVerb(Index: Integer); override;
- function GetVerb(Index: Integer): string; override;
- function GetVerbCount: Integer; override;
- end;
- implementation
|