📄 mmspgram.pas
字号:
{========================================================================}
{= (c) 1995-98 SwiftSoft Ronald Dittrich =}
{========================================================================}
{= All Rights Reserved =}
{========================================================================}
{= D 01099 Dresden = Fax.: +49(0)351-8037944 =}
{= Loewenstr.7a = info@swiftsoft.de =}
{========================================================================}
{= 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: 05.10.98 - 15:53:33 $ =}
{========================================================================}
Unit MMSpGram;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
Windows,
{$ELSE}
WinTypes,
WinProcs,
{$ENDIF}
SysUtils,
Messages,
Classes,
Graphics,
Controls,
Forms,
Menus,
MMSystem,
MMUtils,
MMObj,
MMString,
MMMath,
MMMulDiv,
MMFFT,
MMRegs,
MMPCMSup,
MMDIBCv;
const
{$IFDEF CBUILDER3} {$EXTERNALSYM SCALEWIDTH} {$ENDIF}
SCALEWIDTH = 32;
{$IFDEF CBUILDER3} {$EXTERNALSYM SCALEFONT} {$ENDIF}
SCALEFONT = 'ARIAL';
SCALEFONTSIZE : integer = 10;
INFOCOLOR : TCOLOR = clWhite;
{$IFDEF CBUILDER3} {$EXTERNALSYM MIN_COLOR} {$ENDIF}
MIN_COLOR : Word = 10;
{$IFDEF CBUILDER3} {$EXTERNALSYM NUM_COLORS} {$ENDIF}
NUM_COLORS : Word = 236;
{$IFDEF CBUILDER3} {$EXTERNALSYM MAX_FFTLEN} {$ENDIF}
MAX_FFTLEN = 4096; { Define the maximum FFT buffer length. }
type
EMMSpectrogramError = class(Exception);
TMMSpectrogramGain = (sgrNone,sgr6db,sgr12db);
TMMSpectrogramPalette= (spHSV,spThreshold,spBlackWhite,spWhiteBlack,spBone,spCopper,spCool,spHot);
TMMSpectrogramSelect = procedure(Sender: TObject; Min, Max: Longint) of object;
PMMSaveBuffer = ^TMMSaveBuffer;
TMMSaveBuffer = array[0..0,0..0] of integer;
{-- TMMSpectrogram --------------------------------------------------}
TMMSpectrogram = class(TMMDIBGraphicControl)
private
{$IFDEF WIN32}
FpFFT : PFFTReal; { the instance for the FFT calculation}
{$ELSE}
FFT : TMMFFT; { the object that performs the FFT }
{$ENDIF}
FFFTData : PSmallArray;{ Array for FFT data }
FOldData : PSmallArray;{ Storage for embossed mode }
FWinBuf : PIntArray; { Array storing windowing function }
FDisplayVal : PLongArray; { Array storing display values }
FColorValues : PByteArray; { Array holding color values }
Fy1 : PIntArray; { Array of bin #'s displayed }
Fy2 : PIntArray; { Array of terminal bin #'s }
FFTLen : integer; { Number of points for FFT }
FSampleRate : Longint; { A/D sampling rate }
FFreqScaleFactor: Float; { Scalefactor for the horiz. scale }
FFreqBase : Float; { Base frequency for the display }
FAmpScale : Float; { scaling factor for amplitude scaling}
FLogAmp : Boolean; { true for log-based amplitude scale }
FSensitivy : integer; { here starts the display (db) scaling}
FWindow : TMMFFTWindow;{ selected window function }
FEmbossed : Boolean; { enable/disable embossed palette mode}
FEnabled : Boolean; { Enable or disable Spectrogram }
FScaleTextColor : TColor; { the text color for the scale }
FScaleLineColor : TColor; { the line color for the scale }
FScaleBackColor : TColor; { background color for the scale }
FSelectColor : TColor; { color for selected range }
FSelectDotColor : TColor; { border color for selected range }
FLocatorColor : TColor; { locator color }
FPalMode : TMMSpectrogramPalette;
FBits : TMMBits; { b8bit or b16bit }
FChannel : TMMChannel; { chBoth, chLeft or chRigth }
FMode : TMMMode; { mMono, mStereo or mQuadro }
FBytes : Longint; { calculated data bytes p. spectrogram}
FGain : TMMSpectrogramGain;{ Amount of db/octave gain }
FOldShowHint : Boolean; { save ShowHint propertie }
FShowInfo : Boolean; { show the freq info or not }
FShowInfoHint : Boolean; { mouse is down, show the info hint }
FDrawScale : Boolean; { draw the scale or not }
FWidth : integer; { calculated width without border }
FHeight : integer; { calculated height without border }
FClientRect : TRect; { calculated beveled Rect }
Fx1 : integer; { horiz. position counter for display }
Fx2 : integer; { horizontal position counter for bar }
FNumScaleSteps : integer; { pre-calculated number of scale steps}
FBarWidth : integer; { width for the moving bar }
FBarColor : TColor; { the color for the moving bar }
FBarTickColor : TColor; { the color for the ticks on the bar }
FNeedReset : Boolean; { the spectrum needs a reset }
FAccelerate : Boolean; { accelerate the display refresh }
FScroll : Boolean; { scroll the display or not }
FSaveData : Boolean; { save the actual spectrum data }
FSaveBuffer : PMMSaveBuffer;
FSelectStart : Longint; { start pos for selected region }
FSelectEnd : Longint; { end pos for selected region }
FLocator : Longint; { current locator position }
FDrawing : Boolean;
FOldCursor : TCursor;
FOrigin : TRect;
FMoveRect : TRect;
FLocked : Boolean;
FUseSelection : Boolean;
{ Events }
FOnPcmOverflow : TNotifyEvent;
FOnSelecting : TMMSpectrogramSelect;
FOnSelectEnd : TMMSpectrogramSelect;
procedure CreateDataBuffers(Length: Cardinal);
procedure FreeDataBuffers;
procedure CreateArrays(Size: Cardinal);
procedure FreeArrays;
procedure SetBytesPerSpectrogram;
procedure SetupYScale;
procedure CalcScaleSteps;
procedure CalcMagnitude(MagnitudeForm: Boolean);
procedure DrawInfo(Pos: TPoint);
procedure DrawFrequencyScale;
procedure DrawData(pDispData: PLongArray);
procedure DrawBar;
procedure DrawSelection(aCanvas: TMMDIBCanvas; sStart, sEnd: Longint;
sColor: TColor; Solid: Boolean);
procedure DrawLocator(aCanvas: TMMDIBCanvas; aPos: Longint; aColor: TColor);
procedure DrawSpectrogram(ClearBackGround: Boolean);
procedure AdjustSize(var W, H: Integer);
procedure AdjustBounds;
procedure SetFFTLen(aLength: integer);
procedure SetWindow(aValue: TMMFFTWindow);
procedure SetPalMode(aValue: TMMSpectrogramPalette);
procedure SetEmbossed(aValue: Boolean);
procedure SetLogAmp(aValue: Boolean);
procedure SetFreqScale(aValue: integer);
function GetFreqScale: integer;
procedure SetFreqBase(aValue: integer);
function GetFreqBase: integer;
procedure SetAmplitudeScale(aValue: integer);
function GetAmplitudeScale: integer;
procedure SetAccelerate(aValue: Boolean);
procedure SetDrawScale(aValue: Boolean);
procedure SetEnabled(aValue: Boolean);
procedure SetColors(Index: Integer; Value: TColor);
procedure SetBarWidth(aValue: integer);
procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
function GetPCMWaveFormat: TPCMWaveFormat;
procedure SetBits(aValue: TMMBits);
procedure SetChannel(aValue: TMMChannel);
procedure SetMode(aValue: TMMMode);
procedure SetSampleRate(aValue: Longint);
procedure SetGain(aValue: TMMSpectrogramGain);
procedure SetSensitivy(aValue: integer);
procedure SetScroll(aValue: Boolean);
function GetScaleBackColor: TColor;
procedure SetLocator(aValue: Longint);
procedure SetSaveData(aValue: Boolean);
protected
procedure ChangeDesigning(aValue: Boolean); override;
procedure Paint; override;
procedure Loaded; override;
procedure PcmOverflow; dynamic;
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
procedure Changed; override;
procedure Selecting(Min, Max: Longint); dynamic;
procedure SelectEnd(Min, Max: Longint); dynamic;
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 GetFrequency(Pos: TPoint): Float;
procedure SetPalette(LogPal: PLogPalette);
procedure RefreshPCMData(PCMData: Pointer);
procedure RefreshFFTData(FFTData: Pointer);
procedure RefreshMagnitudeData(MagData: Pointer);
procedure ResetData;
property ColorValues: PByteArray read FColorValues;
property BytesPerSpectrogram: Longint read FBytes;
property PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
property FFTData: PSmallArray read FFFTData;
procedure Select(sStart, sEnd: Longint; Redraw: Boolean);
property SelectionStart: Longint read FSelectStart;
property SelectionEnd: Longint read FSelectEnd;
property Locator: Longint read Flocator write SetLocator default -1;
function IsLocator(X: integer): Boolean;
function IsSelectStart(X: integer): Boolean;
function IsSelectEnd(X: integer): Boolean;
function IsInSelection(X: integer): Boolean;
property SaveData: Boolean read FSaveData write SetSaveData default False;
published
{ Events }
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnStartDrag;
property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
property OnSelecting: TMMSpectrogramSelect read FOnSelecting write FOnSelecting;
property OnSelectEnd: TMMSpectrogramSelect read FOnSelectEnd write FOnSelectEnd;
property Align;
property Bevel;
property PopupMenu;
property ParentShowHint;
property ShowHint;
property Visible;
property Cursor default crCross;
property PaletteRealize default True;
property PaletteMapped;
property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
property Enabled: Boolean read FEnabled write SetEnabled default True;
property DrawScale: Boolean read FDrawScale write SetDrawScale default False;
property Height default 90;
property Width default 194;
property Accelerate: Boolean read FAccelerate write SetAccelerate default True;
property Scroll: Boolean read FScroll write SetScroll default False;
property ScaleTextColor: TColor index 0 read FScaleTextColor write SetColors default clBlack;
property ScaleLineColor: TColor index 1 read FScaleLineColor write SetColors default clBlack;
property BarColor: TColor index 2 read FBarColor write SetColors default clGray;
property BarTickColor: TColor index 3 read FBarTickColor write SetColors default clWhite;
{$IFDEF BUILD_ACTIVEX}
property ScaleBackColor: TColor index 4 read FScaleBackColor write SetColors default clBtnface;
{$ENDIF}
property SelectionColor: TColor index 5 read FSelectColor write SetColors default clRed;
property SelectionDotColor: TColor index 6 read FSelectDotColor write SetColors default clRed;
property LocatorColor: TColor index 7 read FLocatorColor write SetColors default clYellow;
property BarWidth: integer read FBarWidth write SetBarWidth default 5;
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 Gain: TMMSpectrogramGain read FGain write SetGain default sgrNone;
property FFTLength: integer read FFTLen write SetFFTLen default 128;
property Window: TMMFFTWindow read FWindow write SetWindow default fwHamming;
property LogAmp: Boolean read FLogAmp write SetLogAmp default False;
property Embossed: Boolean read FEmbossed write SetEmbossed default False;
property AmplitudeScale: integer read GetAmplitudeScale write SetAmplitudeScale default 100;
property FrequencyBase: integer read GetFreqBase write SetFreqBase default 0;
property FrequencyScale: integer read GetFreqScale write SetFreqScale default 1;
property Sensitivy: integer read FSensitivy write SetSensitivy default -90;
property PaletteTyp: TMMSpectrogramPalette read FPalMode write SetPalMode default spThreshold;
property Locked: Boolean read FLocked write FLocked default False;
property UseSelection: Boolean read FUseSelection write FUseSelection default False;
end;
implementation
uses consts;
const
CreateCount: Longint = 0;
ControlList: TList = nil;
SaveDC : HDC = 0;
SaveBitmap : HBitmap = 0;
SaveWidth : integer = 0;
SaveHeight : integer = 0;
SaveInfoPos: TPoint = (X:0;Y:0);
OldBitmap : HBitmap = 0;
OldPalette : HPalette= 0;
{------------------------------------------------------------------------}
procedure AddSpectrogram(Spectrogram: TMMSpectrogram);
begin
inc(CreateCount);
if (CreateCount = 1) then
begin
ControlList := TList.Create;
end;
if ControlList.IndexOf(Spectrogram) = -1 then
ControlList.Add(Spectrogram);
end;
{------------------------------------------------------------------------}
procedure RemoveSpectrogram(Spectrogram: TMMSpectrogram);
begin
ControlList.Remove(Spectrogram);
ControlList.Pack;
dec(CreateCount);
if (CreateCount = 0) then
begin
ControlList.Free;
ControlList := nil;
end;
end;
{------------------------------------------------------------------------}
procedure ResetSpectrograms(Spectrogram: TMMSpectrogram);
var
i: integer;
begin
if (ControlList <> nil) and (ControlList.Count > 0) then
begin
for i := 0 to ControlList.Count-1 do
if (ControlList.Items[i] <> Spectrogram) then
TMMSpectrogram(ControlList.Items[i]).FNeedReset := True;
end;
end;
{-- TMMSpectrogram ------------------------------------------------------}
constructor TMMSpectrogram.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CreateDataBuffers(MAX_FFTLEN);
PaletteRealize := True;
{$IFDEF WIN32}
FpFFT := InitRealFFT(8);
{$ELSE}
FFT := TMMFFT.Create;
{$ENDIF}
FFTLen := 8;
FAccelerate := True;
FSampleRate := 11025;
FChannel := chBoth;
FBits := b8bit;
FMode := mMono;
FGain := sgrNone;
FEmbossed := False;
FWindow := fwHamming;
FFreqScaleFactor := 1.0;
FFreqBase := 0;
FAmpScale := 1.0;
FLogAmp := False;
FSensitivy := -90;
FEnabled := True;
FPalMode := spThreshold;
Color := clBlack;
FScaleTextColor := clBlack;
FScaleLineColor:= clBlack;
FScaleBackColor := clBtnFace;
FBarWidth := 5;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -