mmmeter.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: 01.09.98 - 16:46:46 $                                        =}
{========================================================================}
Unit MMMeter;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

Interface

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

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM PEAKTIMERELAPSE} {$ENDIF}
    PEAKTIMERELAPSE = 25;  { Peak timer Timer intervals                   }
    {$IFDEF CBUILDER3} {$EXTERNALSYM MAXDECAYCOUNT} {$ENDIF}
    MAXDECAYCOUNT   = 32;  { Maximum amount of temporal averaging allowed }
    {$IFDEF CBUILDER3} {$EXTERNALSYM VALUERANGE} {$ENDIF}
    VALUERANGE      = 100; { Range for SetValue/GetValue, here 0..100%    }

type
    EMMMeterError = class(Exception);
    { array for uniform decay mode values }
    TDataBuf  = array[0..MAXDECAYCOUNT-1] of Long;

    TMMScaleOrigin = (soInner,soOuter);

    {-- TMMCustomMeter --------------------------------------------------}
    {$IFDEF BUILD_ACTIVEX}
    TMMCustomMeter = class(TMMCustomControl)
    {$ELSE}
    TMMCustomMeter = class(TMMGraphicControl)
    {$ENDIF}
    private
      FTimerID      : Longint;      { timer for peak handling              }
      FEnabled      : Boolean;      { Enable or disable                    }
      FScale1Color  : TColor;       { Farbe f黵 die Punkte im 1. Abschnitt }
      FScale2Color  : TColor;       { Farbe f黵 die Punkte im 2. Abschnitt }
      FScale3Color  : TColor;       { Farbe f黵 die Punkte im 3. Abschnitt }
      FPeakColor    : TColor;       { peak needle color                    }
      FNeedleColor  : TColor;       { the needle color                     }
      FNeedleOffset : integer;      { adjust the needle origin             }
      FNeedleWidth  : integer;      { the width for the needle             }
      FDrawScale    : Boolean;      { draw the scale or not                }
      FScaleOrigin  : TMMScaleOrigin;{ soInner or soOuter                  }
      FScaleHeight1 : integer;      { the height for the short scale lines }
      FScaleHeight2 : integer;      { the height for the large scale lines }
      FScaleAngle   : integer;      { Angle between 45% and 180%           }
      FScaleTicks   : integer;      { number of lines for scale            }
      FLargeTicks   : integer;      { draw every FLargeTicks a large line  }
      FTextTicks    : integer;      { draw every FTextTicks a volume string}
      FTopSpace     : integer;      { room for needle at top               }
      FPoint1       : integer;      { Schwelle von 1. zu 2. Abschnitt %    }
      FPoint2       : integer;      { Schwelle von 2. zu 3. Abschnitt %    }
      FBits         : TMMBits;      { bit8 or bit16                        }
      FChannel      : TMMChannel;   { chBoth, chLeft or chRigth            }
      FMode         : TMMMode;      { mMono or mStereo                     }
      FBytes        : Longint;      { calculated data bytes per meter      }
      FGain         : Integer;      { the linear gain for the pcm data     }
      FSamples      : integer;      { number of samples for calculation    }
      FSensitivy    : integer;      { here starts the display (db) scaling }
      FLogAmp       : Boolean;      { set to True for log-based amp. scale }
      FData         : integer;      { the current data for the meter       }
      FDataBuf      : TDataBuf;     { Memory for averaging mode            }
      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 num of bins averaged so far    }
      FDecayPtr     : integer;      { Index for averaging buffer location  }
      FLastVal_F    : Float;        { Lastvalue for exp decay mode         }
      FLastVal      : Longint;      { Lastvalue for uniform averaging      }
      FShowPeak     : Boolean;      { Show the peak needle or not          }
      FPeakValue    : integer;      { the actual sample Peak Value         }
      FPeak         : integer;      { the actual Peak Value                }
      FPeakDelay    : integer;      { the delay for the peak               }
      FPeakSpeed    : integer;      { the decrease speed for the peak      }
      FPeakCounter  : integer;      { internal Peak delay counter          }
      FWidth        : integer;      { calculated width without border      }
      FHeight       : integer;      { calculated height without border     }
      FClientRect   : TRect;        { calculated beveled Rect              }
      FRange        : Longint;      { pcm input dynamic range              }
      FRefresh      : Boolean;      { needs the peak a refresh ?           }
      FDCOffsetL    : integer;
      FDCOffsetR    : integer;

      FOffBitmap    : TBitmap;
      FSaveBitmap   : TBitmap;
      FBackBitmap   : TBitmap;

      { Events }
      FOnGainOverflow: TNotifyEvent;
      FOnPcmOverflow : TNotifyEvent;
      FOnPostPaint   : TNotifyEvent;

      procedure ResetDecayBuffers;
      procedure SetBytesPerMeter;
      procedure ComputeNeedleEnd(var pt: TPoint; Value, Radius: integer);
      procedure DrawText;
      procedure DrawBackGround;
      procedure DrawNeedle;
      procedure DrawMeter(FastDraw: Boolean);
      procedure FastDraw;

      procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

      procedure SetBackGround(aValue: TBitmap);
      procedure SetEnabled(aValue: Boolean);
      procedure SetColors(Index: Integer; aValue: TColor);
      procedure SetNeedleOffset(aValue: integer);
      procedure SetNeedleWidth(aValue: integer);
      procedure SetScaleOrigin(aValue: TMMScaleOrigin);
      procedure SetScaleHeight(Index: integer; aValue: integer);
      procedure SetScaleAngle(aValue: integer);
      procedure SetScaleTicks(aValue: integer);
      procedure SetLargeTicks(aValue: integer);
      procedure SetTextTicks(aValue: integer);
      procedure SetDrawScale(aValue: Boolean);
      procedure SetTopSpace(aValue: integer);
      procedure SetPoints(Index, aValue: integer);
      procedure SetShowPeak(aValue: Boolean);
      procedure SetPeakDelay(aValue: integer);
      procedure SetPeakSpeed(aValue: integer);
      procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
      function  GetPCMWaveFormat: TPCMWaveFormat;
      procedure SetBits(aValue: TMMBits);
      procedure SetChannel(aValue: TMMChannel);
      procedure SetMode(aValue: TMMMode);
      procedure SetGain(aValue: Integer);
      function  GetGain: integer;
      procedure SetSamples(aValue: integer);
      procedure SetDecayMode(aValue: TMMDecayMode);
      procedure SetDecay(aValue: integer);
      procedure SetSensitivy(aValue: integer);
      procedure SetLogAmp(aValue: Boolean);
      procedure SetValue(aValue: integer);
      function  GetValue: integer;
      procedure SetDCOffset(Index, aValue: integer);
      function  GetDCOffset(Index: integer): integer;

    protected
      procedure ChangeDesigning(aValue: Boolean); override;
      function  GetPalette: HPALETTE; override;
      procedure Paint; override;
      procedure GainOverflow; dynamic;
      procedure PcmOverflow; dynamic;
      procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
      procedure Changed; override;

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

      procedure   RefreshPCMData(PCMData: Pointer);
      procedure   SetData(SampleValue: integer);
      procedure   ResetData;
      property    BytesPerMeter: Longint read FBytes;
      property    PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;

      property    Peak: integer read FPeakValue;

    protected
      { Events }
      property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
      property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
      property OnPostPaint: TNotifyEvent read FOnPostPaint write FOnPostPaint;

      property ParentColor default False;
      property ParentFont default False;
      property Color default clBlack;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      property Height default 90;
      property Width default 170;
      Property Scale1Color: TColor index 0 read FScale1Color write SetColors default clGreen;
      Property Scale2Color: TColor index 1 read FScale2Color write SetColors default clYellow;
      Property Scale3Color: TColor index 2 read FScale3Color write SetColors default clRed;
      Property NeedleColor: TColor index 3 read FNeedleColor write SetColors default clWhite;
      Property PeakColor: TColor index 4 read FPeakColor write SetColors default clRed;
      Property NeedleOffset: integer read FNeedleOffset write SetNeedleOffset default 30;
      Property NeedleWidth: integer read FNeedleWidth write SetNeedleWidth default 1;
      Property ScaleOrigin: TMMScaleOrigin read FScaleOrigin write SetScaleOrigin default soInner;
      Property ScaleHeight1: integer index 0 read FScaleHeight1 write SetScaleHeight default 4;
      Property ScaleHeight2: integer index 1 read FScaleHeight2 write SetScaleHeight default 8;
      Property ScaleAngle: integer read FScaleAngle write SetScaleAngle default 90;
      Property ScaleTicks: integer read FScaleTicks write SetScaleTicks default 41;
      Property ScaleTicksEnlargeEvery: integer read FLargeTicks write SetLargeTicks default 4;
      Property ScaleTicksTextEvery: integer read FTextTicks write SetTextTicks default 8;
      Property DrawScale: Boolean read FDrawScale write SetDrawScale default True;
      Property TopSpace: integer read FTopSpace write SetTopSpace default 14;
      Property Point1: integer index 0 Read FPoint1 write SetPoints default 60;
      Property Point2: integer index 1 Read FPoint2 write SetPoints default 80;
      property BitLength: TMMBits read FBits write setBits default b8bit;
      property Channel: TMMChannel read FChannel write setChannel default chBoth;
      property Mode: TMMMode read FMode write SetMode default mMono;
      property Gain: Integer read getGain write setGain default 0;
      property Samples: integer read FSamples write SetSamples default 50;
      property Sensitivy: integer read FSensitivy write SetSensitivy default -50;
      property LogAmp: Boolean read FLogAmp write SetLogAmp default True;
      property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default dmNone;
      property Decay: integer read FDecay write SetDecay default 1;
      property ShowPeak: Boolean read FShowPeak write SetShowPeak default True;
      property PeakDelay: integer read FPeakDelay write SetPeakDelay default 20;
      property PeakSpeed: integer read FPeakSpeed write SetPeakSpeed default 0;
      property BackGroundDIB: TBitmap read FBackBitmap write SetBackGround;
      property Value: integer read GetValue write SetValue stored False default 0;
      property DCOffsetL: integer index 0 read GetDCOffset write SetDCOffset default 0;
      property DCOffsetR: integer index 1 read GetDCOffset write SetDCOffset default 0;
    end;

    TMMMeter = class(TMMCustomMeter)
    published
      { Events }
      property OnClick;
      property OnDblClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnStartDrag;
      property OnGainOverflow;
      property OnPcmOverflow;
      property OnPostPaint;

      property Align;
      property Bevel;
      property ParentShowHint;
      property ParentColor;
      property ParentFont;
      property PopupMenu;
      property ShowHint;
      property Visible;
      property Color;
      property Caption;
      property Font;
      property Enabled;
      property Height;
      property Width;
      Property Scale1Color;
      Property Scale2Color;
      Property Scale3Color;
      Property NeedleColor;
      Property PeakColor;
      Property NeedleOffset;
      Property NeedleWidth;
      Property ScaleOrigin;
      Property ScaleHeight1;
      Property ScaleHeight2;
      Property ScaleAngle;
      Property ScaleTicks;
      Property ScaleTicksEnlargeEvery;
      Property ScaleTicksTextEvery;
      Property DrawScale;
      Property TopSpace;
      Property Point1;
      Property Point2;
      property BitLength;
      property Channel;
      property Mode;
      property Gain;
      property Samples;
      property Sensitivy;
      property LogAmp;
      property DecayMode;
      property Decay;
      property ShowPeak;
      property PeakSpeed;
      property PeakDelay;
      property BackGroundDIB;
      property Value;
      property DCOffsetL;
      property DCOffsetR;
    end;

Implementation

{------------------------------------------------------------------------}
procedure TimeCallBack(uTimerID,dwUser: Longint); export;
begin
  if (dwUser <> 0) then
  with TMMMeter(dwUser) do
  begin
     if (FPeak > 0 ) then
     begin
        dec(FPeakCounter);
        if FPeakCounter <= 0 then
        begin
           if (FPeakSpeed = 0) then
           begin
              FPeak := FData;                  { clear the peak hold value }
              FPeakCounter := 0;
           end
           else
           begin
              FPeak := Max(FPeak-500,FData);          { dec the peak value }
              FPeakCounter := FPeakSpeed;
           end;
           FRefresh := True;
        end;
     end;
  end;
end;

{== TMMCustomMeter ======================================================}
constructor TMMCustomMeter.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FBackBitmap := TBitmap.Create;
   FOffBitmap  := TBitmap.Create;
   FSaveBitmap := TBitmap.Create;

   FTimerID := 0;
   FRange := $7FFF;                                { 32768 - 16 bit (abs) }
   FEnabled := True;
   FScale1Color := clGreen;
   FScale2Color := clYellow;
   FScale3Color := clRed;
   FPeakColor := clRed;
   FNeedleColor := clWhite;
   FNeedleOffset:= 30;
   FNeedleWidth := 1;
   FScaleOrigin := soInner;
   FScaleHeight1 := 4;
   FScaleHeight2 := 8;
   FScaleAngle := 90;
   FScaleTicks := 41;
   FLargeTicks := 4;
   FTextTicks := 8;
   FDrawScale := True;
   FTopSpace := 14;
   FBits := b8Bit;
   FChannel := chBoth;
   FMode := mMono;
   FShowPeak := True;
   FPeakValue := 0;
   FPeakDelay := 20;
   FPeakSpeed := 0;
   FPeakCounter := 0;
   FPeak := 0;
   FData := 0;
   FDecay := 1;
   FDecayMode := dmNone;
   FDecayFactor := 0.0001;
   FDecayCount := 1;
   FDecayCntAct := 0;
   FDecayPtr := 0;
   FGain := 8;                                    { no Gain = 8 div 8 = 1 }
   FSamples := 50;
   FPoint1 := 60;
   FPoint2 := 80;
   FSensitivy := -50;
   FLogAmp := True;
   FDCOffsetL := 0;
   FDCOffsetR := 0;
   Height := 90;
   Width := 170;
   Color := clBlack;
   Caption := 'dB';
   SetBytesPerMeter;
   ParentFont := False;
   Font.Color := clSilver;
   Font.Style := [fsBold];

   if not (csDesigning in ComponentState) then
   begin
      { create the peak timer }
      FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
   end;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMCustomMeter ------------------------------------------------------}
Destructor TMMCustomMeter.Destroy;
begin
   if not (csDesigning in ComponentState) then
   begin
      { destroy the peak timer }
      MMTimeKillEvent(FTimerID);
   end;

   FSaveBitmap.Free;
   FOffBitmap.Free;
   FBackBitmap.Free;

   inherited Destroy;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.ChangeDesigning(aValue: Boolean);