MMSPECTR.INT 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202
  1. {========================================================================}
  2. {= (c) 1995-98 SwiftSoft Ronald Dittrich =}
  3. {========================================================================}
  4. {= All Rights Reserved =}
  5. {========================================================================}
  6. {= D 01099 Dresden = Tel.: +0351-8012255 =}
  7. {= Loewenstr.7a = info@swiftsoft.de =}
  8. {========================================================================}
  9. {= Actual versions on http://www.swiftsoft.de/mmtools.html =}
  10. {========================================================================}
  11. {= This code is for reference purposes only and may not be copied or =}
  12. {= distributed in any format electronic or otherwise except one copy =}
  13. {= for backup purposes. =}
  14. {= =}
  15. {= No Delphi Component Kit or Component individually or in a collection=}
  16. {= subclassed or otherwise from the code in this unit, or associated =}
  17. {= .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed =}
  18. {= without express permission from SwiftSoft. =}
  19. {= =}
  20. {= For more licence informations please refer to the associated =}
  21. {= HelpFile. =}
  22. {========================================================================}
  23. {= $Date: 20.01.1998 - 18:00:00 $ =}
  24. {========================================================================}
  25. Unit MMSpectr;
  26. {$C FIXED PRELOAD PERMANENT}
  27. {$I COMPILER.INC}
  28. interface
  29. uses
  30. {$IFDEF WIN32}
  31. Windows,
  32. {$ELSE}
  33. WinTypes,
  34. WinProcs,
  35. {$ENDIF}
  36. SysUtils,
  37. Messages,
  38. Classes,
  39. Graphics,
  40. Controls,
  41. Forms,
  42. Menus,
  43. DsgnIntf,
  44. MMSystem,
  45. MMUtils,
  46. MMObj,
  47. MMTimer,
  48. MMString,
  49. MMMath,
  50. MMMulDiv,
  51. MMFFT,
  52. MMRegs,
  53. MMPCMSup,
  54. MMDIBCv;
  55. const
  56. SCALEHEIGHT = 40;
  57. SCALEWIDTH = 32;
  58. SCALEFONT = 'ARIAL';
  59. SCALEFONTSIZE : integer = 10;
  60. SCROLLDISTANCE : integer = 2;
  61. INFOCOLOR : TCOLOR = clWhite;
  62. MAX_FFTLEN = 4096; { Define the maximum FFT buffer length. }
  63. MAXDECAYCOUNT = 32; { Maximum amount of temporal averaging allowed }
  64. type
  65. EMMSpectrumError = class(Exception);
  66. TMMSpectrumKind = (skDots, skLines, skVLines, skBars, skPeaks, skScroll);
  67. TMMSpectrumGain = (sgNone,sg3db,sg6db,sg9db,sg12db);
  68. TMMSpectrumDrawBar = procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; Value,Peak: integer) of object;
  69. { array for uniform decay mode values }
  70. PDataBuf = ^TDataBuf;
  71. TDataBuf = array[0..MAXDECAYCOUNT-1] of PLongArray;
  72. TPeak = record { record for peak values }
  73. Freq : Float;
  74. Amp : Float;
  75. db : Float;
  76. { !! internal for peak display, do not use !! }
  77. Amplitude: Long; { peak amplitude found }
  78. Index : integer; { bin number of the peak amplitude }
  79. X : integer; { the X value for the Peak }
  80. end;
  81. TDrawVal = record { record for display values to draw }
  82. Left : integer; { left X1 for this set of bin's }
  83. Right : integer; { right X2 for this set of bin's }
  84. Value : Longint; { the (Y) value for this set of bin's }
  85. Peak : integer; { the peak value for this set of bin's }
  86. PeakCnt : integer; { internal peak counter for timing }
  87. end;
  88. PDrawArray = ^TDrawArray;
  89. TDrawArray = array[0..Count] of TDrawVal;
  90. {-- TMMSpectrum -----------------------------------------------------}
  91. TMMSpectrum = class(TMMDIBGraphicControl)
  92. public
  93. constructor Create(AOwner: TComponent); override;
  94. destructor Destroy; override;
  95. function GetOptimalWidth(aWidth: integer): integer;
  96. function GetFrequency(Pos: TPoint): Float;
  97. function GetAmplitude(Pos: TPoint): Float;
  98. procedure RefreshPCMData(PCMData: Pointer);
  99. procedure RefreshFFTData(FFTData: Pointer);
  100. procedure RefreshMagnitudeData(MagData: Pointer);
  101. procedure ResetData;
  102. property Peak: TPeak read GetPeak;
  103. property BytesPerSpectrum: Longint read FBytes;
  104. property PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
  105. published
  106. { Events }
  107. property OnClick;
  108. property OnDblClick;
  109. property OnMouseDown;
  110. property OnMouseMove;
  111. property OnMouseUp;
  112. property OnNeedData: TNotifyEvent read FOnNeedData write FOnNeedData;
  113. property OnDrawBar: TMMSpectrumDrawBar read FOnDrawBar write SetOnDrawBar;
  114. property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
  115. property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  116. property Align;
  117. property Bevel;
  118. property BackGroundDIB;
  119. property UseBackGroundDIB;
  120. property PaletteRealize;
  121. property Color default clBlack;
  122. property Cursor default crCross;
  123. property ParentShowHint;
  124. property ParentColor default False;
  125. property PopupMenu;
  126. property Visible;
  127. property ShowHint;
  128. property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
  129. property Enabled: Boolean read FEnabled write SetEnabled default True;
  130. property DrawFreqScale: Boolean read FDrawFreqScale write SetDrawFreqScale default False;
  131. property DrawAmpScale: Boolean read FDrawAmpScale write SetDrawAmpScale default False;
  132. property DrawGrid: Boolean read FDrawGrid write SetDrawGrid default False;
  133. property Height default 89;
  134. property Width default 194;
  135. Property Space: integer read FSpace write SetSpace default 1;
  136. Property SpotSpace: integer read FSpotSpace write SetSpotSpace default 1;
  137. Property SpotHeight: integer read FSpotHeight write SetSpotHeight default 1;
  138. Property Bar1Color: TColor index 0 read FBar1Color write SetColors default clAqua;
  139. Property Bar2Color: TColor index 1 read FBar2Color write SetColors default clAqua;
  140. Property Bar3Color: TColor index 2 read FBar3Color write SetColors default clRed;
  141. Property Inactive1Color: TColor index 3 read FInact1Color write SetColors default clTeal;
  142. Property Inactive2Color: TColor index 4 read FInact2Color write SetColors default clTeal;
  143. Property Inactive3Color: TColor index 5 read FInact3Color write SetColors default clMaroon;
  144. Property ScaleTextColor: TColor index 6 read FScaleTextColor write SetColors default clBlack;
  145. Property ScaleLineColor: TColor index 7 read FScaleLineColor write SetColors default clBlack;
  146. Property GridColor: TColor index 8 read FGridColor write SetColors default clGray;
  147. Property Point1: integer index 0 read FPoint1 write SetPoints default 50;
  148. Property Point2: integer index 1 read FPoint2 write SetPoints default 85;
  149. Property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
  150. Property InactiveDoted: Boolean read FInactiveDoted write SetInactiveDoted default False;
  151. Property ActiveDoted: Boolean read FActiveDoted write SetActiveDoted default False;
  152. property Mode: TMMMode read FMode write SetMode default mMono;
  153. property BitLength: TMMBits read FBits write SetBits default b8bit;
  154. property Channel: TMMChannel read FChannel write SetChannel default chBoth;
  155. property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
  156. property RefFreq: integer read FRefFreq write SetRefFreq default 1000;
  157. property Gain: TMMSpectrumGain read FGain write SetGain default sgNone;
  158. property FFTLength: integer read FFTLen write SetFFTLen default 128;
  159. property LogFreq: Boolean read FLogFreq write SetLogFreq default False;
  160. property LogAmp: Boolean read FLogAmp write SetLogAmp default False;
  161. property Kind: TMMSpectrumKind read FKind write SetKind default skBars;
  162. property Window: TMMFFTWindow read FWindow write SetWindow default fwHamming;
  163. property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default dmNone;
  164. property Decay: integer read FDecay write SetDecay default 1;
  165. property VerticalScale: integer read GetVertScale write SetVertScale default 100;
  166. property FrequencyScale: integer read GetFreqScale write SetFreqScale default 1;
  167. property NumPeaks: integer read FNumPeaks write SetNumPeaks default 1;
  168. property PeakDelay: integer read FPeakDelay write SetPeakDelay default 20;
  169. property PeakSpeed: integer read FPeakSpeed write SetPeakSpeed default 0;
  170. property DisplayPeak: Boolean read FDisplayPeak write SetDisplayPeak default False;
  171. end;
  172. {-- TMMSpectrumEditor -----------------------------------------------}
  173. TMMSpectrumEditor = class(TComponentEditor)
  174. public
  175. procedure ExecuteVerb(Index: Integer); override;
  176. function GetVerb(Index: Integer): string; override;
  177. function GetVerbCount: Integer; override;
  178. end;
  179. implementation