mmoscope.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/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: 12.04.98 - 23:06:25 $                                        =}
{========================================================================}
Unit MMOscope;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    ExtCtrls,
    Menus,
    MMUtils,
    MMString,
    MMObj,
    MMSystem,
    MMRegs,
    MMPCMSup,
    MMWaveIO,
    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;
    INFOCOLOR       : TCOLOR = clWhite;
    EFFECTLIMIT     : integer = 3;

    {$IFDEF CBUILDER3} {$EXTERNALSYM MAX_FFTLEN} {$ENDIF}
    MAX_FFTLEN      = 4096; { Define the maximum FFT buffer length. }

type
    EMMOscopeError   = class(Exception);
    TMMOscopeKind    = (okDots,okConLines,okVertLines,okMirLines,okSpikes);
    TMMOscopeEffect  = (efNone,efPeak,efSplit);
    TMMOscopeDrawLine= procedure(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; Data: PSmallArray)of object;
    TMMOscopeSelect  = procedure(Sender: TObject; Min, Max: Longint) of object;

    {-- TMMOscope --------------------------------------------------------}
    TMMOscope = class(TMMDIBGraphicControl)
    private
      FEnabled       : Boolean;        { Enable or disable Scope         }
      FForeColor     : TColor;         { foreground color                }
      FInactColor    : TColor;         { color for unmarked regions      }
      FOffColor      : TColor;         { foreColor if disabled           }
      FEffectColor   : TColor;         { color for the effects           }
      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 scale      }
      FSelectColor   : TColor;         { color for selected range        }
      FSelectDotColor: TColor;         { border color for selected range }
      FLocatorColor  : TColor;         { locator color                   }
      FEffect        : TMMOscopeEffect;{ differrent color effects        }
      FSampleRate    : Longint;        { A/D sampling rate               }
      FBits          : TMMBits;        { bit8 or bit16                   }
      FChannel       : TMMChannel;     { chBoth, chLeft or chRigth       }
      FMode          : TMMMode;        { mMono, mStereo                  }
      FBytes         : Longint;        { calculated data bytes per scope }
      FKind          : TMMOscopeKind;  { scope drawing modes             }
      FSteps         : Integer;        { plot every 'steps' samples      }
      FZoom          : Integer;        { the actual zoom factor          }
      FGain          : Integer;        { the linear gain for the pcm data}
      FData          : PSmallArray;    { sample data buffer              }
      FWidth         : integer;        { calculated width without border }
      FHeight        : integer;        { calculated height without border}
      FMiddle        : integer;        { calculated middleline           }
      FClientRect    : TRect;          { calculated beveled Rect         }
      FOldShowHint   : Boolean;        { saved ShowHint propertie        }
      FShowInfo      : Boolean;        { show the amp/time info or not   }
      FShowInfoHint  : Boolean;        { mouse is down, show the info    }
      FDrawMidLine   : Boolean;        { draw a midline with inactive clr}
      FDrawAmpScale  : Boolean;        { draw the amp scale or not       }
      FDrawTimeScale : Boolean;        { draw the time scale or not      }
      FDrawGrid      : Boolean;        { draw the grid or not            }
      FMarkBegin     : integer;        { start pos for marked region     }
      FMarkEnd       : integer;        { end pos for marked region       }
      FSelectStart   : Longint;        { start pos for selected region   }
      FSelectEnd     : Longint;        { end pos for selected region     }
      FLocator       : Longint;        { current locator position        }
      FFTLen         : integer;        { Number of points for FFT (dummy)}
      Fx1            : integer;        { horiz. pos. counter for display }
      Fx2            : integer;        { horiz. pos. counter for bar     }
      FNumScaleSteps : integer;        { pre-calc. 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 bar  }
      FNeedReset     : Boolean;        { the oscope needs a reset        }
      FAccelerate    : Boolean;        { accelerate the display refresh  }
      FScroll        : Boolean;        { scroll the display or not       }
      FRange         : Longint;
      FCenter        : Longint;
      FEffectTop     : integer;
      FEffectBottom  : integer;
      FLowPass       : Boolean;
      FDrawing       : Boolean;
      FLocked        : Boolean;
      FUseSelection  : Boolean;
      
      { Events }
      FOnGainOverflow: TNotifyEvent;
      FOnPcmOverflow : TNotifyEvent;
      FOnPostPaint   : TNotifyEvent;
      FOnDrawLine    : TMMOscopeDrawLine;
      FOnSelecting   : TMMOscopeSelect;
      FOnSelectEnd   : TMMOscopeSelect;

      procedure CreateDataBuffers(Length: Cardinal);
      procedure FreeDataBuffers;
      procedure SetBytesPerScope;
      procedure InitializeData;
      procedure CalcScaleSteps;
      procedure DrawAmplitudeScale;
      procedure DrawTimeScales;
      procedure DrawGrids;
      procedure DrawBar;
      procedure DrawInfo(Pos: TPoint);
      procedure DrawInactive;
      procedure DrawAsDots;
      procedure DrawAsSpikes;
      procedure DrawAsConLines;
      procedure DrawAsVertLines;
      procedure DrawAsMirLines;
      procedure DrawSelection(aCanvas: TMMDIBCanvas; sStart, sEnd: Longint;
                              sColor: TColor; Solid: Boolean);
      procedure DrawLocator(aCanvas: TMMDIBCanvas; aPos: Longint; aColor: TColor);
      procedure DrawOscope(ClearBackGround: Boolean);

      procedure AdjustSize(var W, H: Integer);
      procedure AdjustBounds;
      procedure SetEnabled(Value: Boolean);
      procedure SetColors(Index: Integer; aValue: TColor);
      procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
      function  GetPCMWaveFormat: TPCMWaveFormat;
      procedure SetBits(aValue: TMMBits);
      procedure SetChannel(aValue: TMMChannel);
      procedure SetMode(aValue: TMMMode);
      procedure SetSampleRate(aValue: Longint);
      procedure SetSteps(aValue: Integer);
      procedure SetZoom(aValue: Integer);
      procedure SetGain(aValue: Integer);
      function  GetGain: integer;
      procedure SetEffect(aValue: TMMOscopeEffect);
      procedure SetEffectLimits;
      procedure SetKind(aValue: TMMOscopeKind);
      procedure SetDrawMidLine(aValue: Boolean);
      procedure SetDrawAmpScale(aValue: Boolean);
      procedure SetDrawTimeScale(aValue: Boolean);
      procedure SetDrawGrid(aValue: Boolean);
      procedure SetBarWidth(aValue: integer);
      procedure SetFFTLen(aLength: integer);
      procedure SetAccelerate(aValue: Boolean);
      procedure SetScroll(aValue: Boolean);
      function  GetScaleBackColor: TColor;
      procedure SetLocator(aValue: Longint);

    protected
      procedure ChangeDesigning(aValue: Boolean); override;
      procedure Paint; override;
      procedure GainOverflow; dynamic;
      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;

      procedure   RefreshPCMData(PCMData: Pointer);
      procedure   SetData(lpData: PSmallArray);
      procedure   ResetData;
      function    GetAmplitude(Pos: TPoint): Float;
      function    GetTime(Pos: TPoint): Float;

      property    BytesPerScope: Longint read FBytes;
      property    PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;

      procedure   Marked(mkBegin, mkEnd: integer; Redraw: Boolean);
      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;

    published
      { Events }
      property OnClick;
      property OnDblClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnStartDrag;
      property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
      property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
      property OnDrawLine: TMMOscopeDrawLine read FOnDrawLine write FOnDrawLine;
      property OnPostPaint: TNotifyEvent read FOnPostPaint write FOnPostPaint;
      property OnSelecting: TMMOscopeSelect read FOnSelecting write FOnSelecting;
      property OnSelectEnd: TMMOscopeSelect read FOnSelectEnd write FOnSelectEnd;

      property Align;
      property Bevel;
      property PopupMenu;
      property BackGroundDIB;
      property UseBackGroundDIB;
      property PaletteRealize;
      property PaletteMapped;
      property Color default clBlack;
      property Cursor default crCross;
      property ParentShowHint;
      property ParentColor default False;
      property Visible;
      property ShowHint;
      property ShowInfo: Boolean read FShowInfo write FShowInfo default True;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      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 DrawMidLine: Boolean read FDrawMidLine write SetDrawMidLine default False;
      property Kind: TMMOscopeKind read FKind write SetKind default okDots;
      property ForegroundColor: TColor index 0 read FForeColor write SetColors default clAqua;
      property InactiveColor: TColor index 1 read FInactColor write SetColors default clTeal;
      property EffectColor: TColor index 2 read FEffectColor write SetColors default clRed;
      property DisabledColor: TColor index 3 read FOffColor write SetColors default clGray;
      Property ScaleTextColor: TColor index 4 read FScaleTextColor write SetColors default clBlack;
      Property ScaleLineColor: TColor index 5 read FScaleLineColor write SetColors default clBlack;
      Property GridColor: TColor index 6 read FGridColor write SetColors default clGray;
      property BarColor: TColor index 7 read FBarColor write SetColors default clGray;
      property BarTickColor: TColor index 8 read FBarTickColor write SetColors default clWhite;
      {$IFDEF BUILD_ACTIVEX}
      property ScaleBackColor: TColor index 9 read FScaleBackColor write SetColors default clBtnFace;
      {$ENDIF}
      property SelectionColor: TColor index 10 read FSelectColor write SetColors default clRed;
      property SelectionDotColor: TColor index 11 read FSelectDotColor write SetColors default clRed;
      property LocatorColor: TColor index 12 read FLocatorColor write SetColors default clYellow;
      property BarWidth: integer read FBarWidth write SetBarWidth default 5;
      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 Mode: TMMMode read FMode write SetMode default mMono;
      property Steps: Integer read FSteps write SetSteps default 1;
      property Zoom: Integer read FZoom write SetZoom default 1;
      property Gain: Integer read GetGain write SetGain default 0;
      property Effect: TMMOscopeEffect read FEffect write SetEffect default efNone;
      property DrawAmpScale: Boolean read FDrawAmpScale write SetDrawAmpScale default False;
      property DrawTimeScale: Boolean read FDrawTimeScale write SetDrawTimeScale default False;
      property DrawGrid: Boolean read FDrawGrid write SetDrawGrid default False;
      property FFTLength: integer read FFTLen write SetFFTLen default 128;
      property LowPass: Boolean read FLowPass write FLowPass default False;
      property Locked: Boolean read FLocked write FLocked default False;
      property UseSelection: Boolean read FUseSelection write FUseSelection default False;
    end;

implementation

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;
   OldDrawPos  : TPoint  = (X:0;Y:0);

{------------------------------------------------------------------------}
procedure AddOscope(Oscope: TMMOscope);
begin
   inc(CreateCount);
   if (CreateCount = 1) then
   begin
      ControlList := TList.Create;
   end;
   if ControlList.IndexOf(Oscope) = -1 then
      ControlList.Add(Oscope);
end;

{------------------------------------------------------------------------}
procedure RemoveOscope(Oscope: TMMOscope);
begin
   ControlList.Remove(Oscope);
   ControlList.Pack;
   dec(CreateCount);
   if (CreateCount = 0) then
   begin
      ControlList.Free;
      ControlList := nil;
   end;
end;

{------------------------------------------------------------------------}
procedure ResetOscope(Oscope: TMMOscope);
var
   i: integer;
begin
   if (ControlList <> nil) and (ControlList.Count > 0) then
   begin
      if Oscope.FScroll then
      for i := 0 to ControlList.Count-1 do
          if (ControlList.Items[i] <> Oscope) then
             TMMOscope(ControlList.Items[i]).FNeedReset := True;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
constructor TMMOscope.Create(AOwner: TComponent);
begin
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);

   inherited Create(AOwner);

   FData := Nil;
   FRange := $FFFF;
   FCenter := $7FFF;
   FMarkBegin := 0;
   FMarkEnd := Width;
   FSelectStart := -1;
   FSelectEnd := -1;
   FLocator := -1;
   FEnabled := True;
   Color := clBlack;
   FForeColor := clAqua;
   FInactColor := clTeal;
   FOffColor  := clGray;