开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMLevel.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：64k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMLevel.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.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: 10.01.99 - 15:45:43 $                                        =}
  24. {========================================================================}
  25. Unit MMLevel;
  27. {$C FIXED PRELOAD PERMANENT}
  29. {$I COMPILER.INC}
  31. Interface
  33. Uses
  34. {$IFDEF WIN32}
  35.     Windows,
  36. {$ELSE}
  37.     WinTypes,
  38.     WinProcs,
  39. {$ENDIF}
  40.     SysUtils,
  41.     Messages,
  42.     Classes,
  43.     Graphics,
  44.     Controls,
  45.     Forms,
  46.     Dialogs,
  47.     Menus,
  48.     MMSystem,
  49.     MMUtils,
  50.     MMString,
  51.     MMObj,
  52.     MMTimer,
  53.     MMMulDiv,
  54.     MMMath,
  55.     MMRegs,
  56.     MMPCMSup,
  57.     MMWaveIO,
  58.     MMDIBCv,
  59.     MMScale;
  61. const
  62.     {$IFDEF CBUILDER3} {$EXTERNALSYM MAXDECAYCOUNT} {$ENDIF}
  63.     MAXDECAYCOUNT   = 32;  { Maximum amount of temporal averaging allowed }
  64.     {$IFDEF CBUILDER3} {$EXTERNALSYM VALUERANGE} {$ENDIF}
  65.     VALUERANGE      = 100; { Range for SetValue/GetValue, here 0..100%    }
  67.     SYNCBARS : integer = 2;
  69. type
  70.     EMMLevelError     = class(Exception);
  71.     TMMLevelKind      = (lkHorizontal, lkVertical);
  72.     TMMLevelDirection = (dirNormal, dirReversed,dirSymetric);
  74.     TMMLevelDrawBar   = procedure(Sender: TObject; DIB: TMMDIBCanvas;
  75.                                   Rect: TRect; nSpots, Peak: integer) of object;
  77.     { array for uniform decay mode values }
  78.     TDataBuf  = array[0..MAXDECAYCOUNT-1] of Long;
  80.     {-- TMMCustomLevel ---------------------------------------------------------}
  81.     TMMCustomLevel = class(TMMDIBGraphicControl)
  82.     private
  83.       FTimerID      : Longint;      { timer for peak handling              }
  84.       FBarDIB       : TMMDIBCanvas; { bitmap for inactive spots            }
  85.       FEnabled      : Boolean;      { Enable or disable Level              }
  86.       FKind         : TMMLevelKind; { draw horizontal / vertikal bars      }
  87.       FBar1Color    : TColor;       { Farbe f黵 die Punkte im 1. Abschnitt }
  88.       FBar2Color    : TColor;       { Farbe f黵 die Punkte im 2. Abschnitt }
  89.       FBar3Color    : TColor;       { Farbe f黵 die Punkte im 3. Abschnitt }
  90.       FInact1Color  : TColor;       { foreColor for inactive spots 1       }
  91.       FInact2Color  : TColor;       { foreColor for inactive spots 2       }
  92.       FInact3Color  : TColor;       { foreColor for inactive spots 3       }
  93.       FInactiveDoted: Boolean;      { draw the inactive spots doted        }
  94.       FActiveDoted  : Boolean;      { draw the active spots doted          }
  95.       FPoint1       : integer;      { Schwelle von 1. zu 2. Abschnitt %    }
  96.       FPoint2       : integer;      { Schwelle von 2. zu 3. Abschnitt %    }
  97.       FPoint1Spot   : integer;      { on which spot begins next color      }
  98.       FPoint2Spot   : integer;      { on which spot begins next color      }
  99.       FSpotSpace    : integer;      { Horizontal space between spots       }
  100.       FSpotWidth    : integer;      { the spot width in pixel              }
  101.       FFirstSpace   : integer;      { the space before the first spot      }
  102.       FNumSpots     : integer;      { number of Spots                      }
  103.       FDirection    : TMMLevelDirection;{ draw direction, forward/backward }
  104.       FBits         : TMMBits;      { bit8 or bit16                        }
  105.       FChannel      : TMMChannel;   { chBoth, chLeft or chRigth            }
  106.       FMode         : TMMMode;      { mMono or mStereo                     }
  107.       FBytes        : Longint;      { calculated data bytes per level      }
  108.       FGain         : Integer;      { the linear gain for the pcm data     }
  109.       FSamples      : integer;      { number of samples for calculation    }
  110.       FSensitivy    : integer;      { here starts the display (db) scaling }
  111.       FLogAmp       : Boolean;      { set to True for log-based amp. scale }
  112.       FData         : integer;      { the current data for the level       }
  113.       FDataBuf      : TDataBuf;     { Memory for averaging mode            }
  114.       FDecay        : integer;      { the current Decay value              }
  115.       FDecayMode    : TMMDecayMode; { indicating decay mode on/off         }
  116.       FDecayFactor  : Float;        { Geometric decay factor               }
  117.       FDecayCount   : integer;      { Temporal averaging parameter         }
  118.       FDecayCntAct  : integer;      { Total num of bins averaged so far    }
  119.       FDecayPtr     : integer;      { Index for averaging buffer location  }
  120.       FLastVal_F    : Float;        { Lastvalue for exp decay mode         }
  121.       FLastVal      : Longint;      { Lastvalue for uniform averaging      }
  122.       FNumPeaks     : integer;      { number of spots displayed as peak    }
  123.       FDrawScale    : Boolean;      { draw the scale or not                }
  124.       FCurPeak      : integer;      { the actual sample Peak Value         }
  125.       FPeak         : integer;      { the actual Peak Value for the display}
  126.       FPeakDelay    : integer;      { the delay for the peak spot          }
  127.       FPeakSpeed    : integer;      { the decrease speed for the peak spot }
  128.       FPeakCounter  : integer;      { internal Peak delay counter          }
  129.       FWidth        : integer;      { calculated width without border      }
  130.       FHeight       : integer;      { calculated height without border     }
  131.       FClientRect   : TRect;        { calculated beveled Rect              }
  132.       FRange        : Longint;      { pcm input dynamic range              }
  133.       FRefresh      : Boolean;      { needs the peak a refresh ?           }
  134.       FDCOffsetL    : integer;
  135.       FDCOffsetR    : integer;
  136.       FDrawReversed : Boolean;
  138.       { Events }
  139.       FOnPaint       : TNotifyEvent;
  140.       FOnGainOverflow: TNotifyEvent;
  141.       FOnPcmOverflow : TNotifyEvent;
  142.       FOnDrawBar     : TMMLevelDrawBar;
  144.       procedure ResetDecayBuffers;
  145.       procedure CalcNumSpots;
  146.       procedure SetBytesPerLevel;
  147.       procedure DrawInactiveSpots;
  148.       procedure DrawLevelHorizontal(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
  149.       procedure DrawLevelVertical(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
  150.       procedure DrawLevel(Dummy: Boolean);
  152.       procedure SetOnDrawBar(aValue: TMMLevelDrawBar);
  153.       procedure SetEnabled(aValue: Boolean);
  154.       procedure SetKind(aValue: TMMLevelKind);
  155.       Procedure SetColors(Index: Integer; aValue: TColor);
  156.       procedure SetPoints(Index, aValue: integer);
  157.       procedure SetSpotSpace(aValue: integer);
  158.       procedure SetSpotWidth(aValue: integer);
  159.       procedure SetDirection(aValue: TMMLevelDirection);
  160.       procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
  161.       function  GetPCMWaveFormat: TPCMWaveFormat;
  162.       procedure SetBits(aValue: TMMBits);
  163.       procedure SetChannel(aValue: TMMChannel);
  164.       procedure SetMode(aValue: TMMMode);
  165.       procedure SetGain(aValue: Integer);
  166.       function  GetGain: integer;
  167.       procedure SetSamples(aValue: integer);
  168.       procedure SetDecayMode(aValue: TMMDecayMode);
  169.       procedure SetDecay(aValue: integer);
  170.       procedure SetNumPeaks(aValue: integer);
  171.       procedure SetPeakDelay(aValue: integer);
  172.       procedure SetPeakSpeed(aValue: integer);
  173.       procedure SetInactiveDoted(aValue: Boolean);
  174.       procedure SetActiveDoted(aValue: Boolean);
  175.       procedure SetSensitivy(aValue: integer);
  176.       procedure SetLogAmp(aValue: Boolean);
  177.       procedure SetValue(aValue: integer);
  178.       function  GetValue: integer;
  179.       function  GetPeak: integer;
  180.       function  GetPeakValue: integer;
  181.       procedure SetDCOffset(Index, aValue: integer);
  182.       function  GetDCOffset(Index: integer): integer;
  184.       procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  186.     protected
  187.       procedure SetBPP(aValue: integer); override;
  188.       procedure Paint; override;
  189.       procedure Loaded; override;
  190.       procedure GainOverflow; dynamic;
  191.       procedure PcmOverflow; dynamic;
  192.       procedure Changed; override;
  194.     public
  195.       constructor Create(AOwner: TComponent); override;
  196.       destructor  Destroy; override;
  198.       procedure   ChangeDesigning(aValue: Boolean); override;
  199.       procedure   SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  201.       property    DrawReversed: Boolean read FDrawReversed write FDrawReversed;
  203.       procedure   RefreshPCMData(PCMData: Pointer);
  204.       procedure   SetData(SampleValue: integer);
  205.       procedure   ResetData;
  207.       property    BytesPerLevel: Longint read FBytes;
  208.       property    PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
  210.       property    NumSpots: integer read FNumSpots;
  211.       property    Point1Spot: integer read FPoint1Spot;
  212.       property    Point2Spot: integer read FPoint2Spot;
  213.       property    Peak: integer read FCurPeak;
  214.       property    PeakDisplay: integer read GetPeak;
  215.       property    PeakValue: integer read GetPeakValue;
  217.     protected
  218.       { Events }
  219.       property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  220.       property OnDrawBar: TMMLevelDrawBar read FOnDrawBar write SetOnDrawBar;
  221.       property OnGainOverflow: TNotifyEvent read FOnGainOverflow write FOnGainOverflow;
  222.       property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  224.       property ParentColor default False;
  225.       property Color default clBlack;
  226.       property Height default 17;
  227.       property Width default 200;
  228.       property Enabled: Boolean read FEnabled write SetEnabled default True;
  229.       property Kind: TMMLevelKind read FKind write SetKind default lkHorizontal;
  230.       property SpotSpace: integer read FSpotSpace write SetSpotSpace default 1;
  231.       property SpotWidth: integer read FSpotWidth write SetSpotWidth default 1;
  232.       property Bar1Color: TColor index 0 read FBar1Color write SetColors default clAqua;
  233.       property Bar2Color: TColor index 1 read FBar2Color write SetColors default clAqua;
  234.       property Bar3Color: TColor index 2 read FBar3Color write SetColors default clRed;
  235.       property Inactive1Color: TColor index 3 read FInact1Color write SetColors default clTeal;
  236.       property Inactive2Color: TColor index 4 read FInact2Color write SetColors default clTeal;
  237.       property Inactive3Color: TColor index 5 read FInact3Color write SetColors default clMaroon;
  238.       property InactiveDoted: Boolean read FInactiveDoted write SetInactiveDoted default False;
  239.       property ActiveDoted: Boolean read FActiveDoted write SetActiveDoted default False;
  240.       property Point1: integer index 0 Read FPoint1 write SetPoints default 50;
  241.       property Point2: integer index 1 Read FPoint2 write SetPoints default 85;
  242.       property Direction: TMMLevelDirection read FDirection write SetDirection default dirNormal;
  243.       property BitLength: TMMBits read FBits write setBits default b8bit;
  244.       property Channel: TMMChannel read FChannel write setChannel default chBoth;
  245.       property Mode: TMMMode read FMode write SetMode default mMono;
  246.       property Gain: Integer read getGain write setGain default 0;
  247.       property Samples: integer read FSamples write SetSamples default 50;
  248.       property Sensitivy: integer read FSensitivy write SetSensitivy default -35;
  249.       property LogAmp: Boolean read FLogAmp write SetLogAmp default True;
  250.       property NumPeaks: integer read FNumPeaks write SetNumPeaks default 1;
  251.       property PeakDelay: integer read FPeakDelay write SetPeakDelay default 20;
  252.       property PeakSpeed: integer read FPeakSpeed write SetPeakSpeed default 0;
  253.       property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default dmNone;
  254.       property Decay: integer read FDecay write SetDecay default 1;
  255.       property Value: integer read GetValue write SetValue stored False default 0;
  256.       property DCOffsetL: integer index 0 read GetDCOffset write SetDCOffset default 0;
  257.       property DCOffsetR: integer index 1 read GetDCOffset write SetDCOffset default 0;
  258.     end;
  260.     {-- TMMLevel --------------------------------------------------------}
  261.     TMMLevel = class(TMMCustomLevel)
  262.     published
  263.       property OnClick;
  264.       property OnDblClick;
  265.       property OnMouseDown;
  266.       property OnMouseMove;
  267.       property OnMouseUp;
  268.       property OnDrawBar;
  269.       property OnGainOverflow;
  270.       property OnPcmOverflow;
  271.       property OnPaint;
  272.       property OnDragDrop;
  273.       property OnDragOver;
  274.       property OnEndDrag;
  275.       property OnStartDrag;
  277.       property Align;
  278.       property Bevel;
  279.       property PopupMenu;
  280.       property ParentShowHint;
  281.       property ParentColor;
  282.       property ShowHint;
  283.       property Visible;
  284.       property Color;
  285.       property DragCursor;
  286.       property Enabled;
  287.       property Kind;
  288.       property Height;
  289.       property Width;
  290.       property SpotSpace;
  291.       property SpotWidth;
  292.       property Bar1Color;
  293.       property Bar2Color;
  294.       property Bar3Color;
  295.       property Inactive1Color;
  296.       property Inactive2Color;
  297.       property Inactive3Color;
  298.       property InactiveDoted;
  299.       property ActiveDoted;
  300.       property Point1;
  301.       property Point2;
  302.       property Direction;
  303.       property BitLength;
  304.       property Channel;
  305.       property Mode;
  306.       property Gain;
  307.       property Samples;
  308.       property Sensitivy;
  309.       property LogAmp;
  310.       property NumPeaks;
  311.       property PeakDelay;
  312.       property PeakSpeed;
  313.       property DecayMode;
  314.       property Decay;
  315.       property Value;
  316.       property DCOffsetL;
  317.       property DCOffsetR;
  318.     end;
  320.     {-- TMMLevScale -----------------------------------------------------}
  321.     TMMLevScale    = class(TMMCustomScale)
  322.     published
  323.         property Visible default False;
  324.         property TickCount;
  325.         property EnlargeEvery;
  326.         property Size;
  327.         property Origin;
  328.         property Connect;
  329.     end;
  331.     TMMScalePos    = (spAboveOrLeft, spBelowOrRight, spBoth);
  333.     {-- TMMLevelScale ---------------------------------------------------}
  334.     TMMLevelScale  = class(TMMGraphicControl)
  335.     private
  336.        FScaleTicks : integer;   { draw every FScaleTicks a volume string }
  337.        FPoint1     : integer;   { Schwelle von 1. zu 2. Abschnitt %      }
  338.        FPoint2     : integer;   { Schwelle von 2. zu 3. Abschnitt %      }
  339.        FScale1Color: TColor;    { Farbe f黵 die Punkte im 1. Abschnitt   }
  340.        FScale2Color: TColor;    { Farbe f黵 die Punkte im 2. Abschnitt   }
  341.        FScale3Color: TColor;    { Farbe f黵 die Punkte im 3. Abschnitt   }
  342.        FKind       : TMMLevelKind;
  343.        FDirection  : TMMLevelDirection;
  344.        FSensitivy  : integer;
  345.        FLogAmp     : Boolean;
  346.        FScale      : TMMLevScale;
  347.        FScalePos   : TMMScalePos;
  349.        procedure SetScale(Value: TMMLevScale);
  350.        procedure SetScalePos(Value: TMMScalePos);
  351.        procedure ScaleChanged(Sender: TObject);
  352.        procedure SetSensitivy(aValue: integer);
  353.        procedure SetLogAmp(aValue: Boolean);
  354.        procedure SetScaleTicks(aValue: integer);
  355.        procedure SetPoints(Index, aValue: integer);
  356.        procedure SetColors(Index: Integer; aValue: TColor);
  357.        procedure SetKind(aValue: TMMLevelKind);
  358.        procedure SetDirection(aValue: TMMLevelDirection);
  360.     public
  361.        constructor Create(AOwner: TComponent); override;
  362.        destructor  Destroy; override;
  364.        procedure Paint; override;
  366.     published
  367.        { Events }
  368.        property OnClick;
  369.        property OnDblClick;
  370.        property OnMouseDown;
  371.        property OnMouseMove;
  372.        property OnMouseUp;
  374.        property Align;
  375.        property Width default 200;
  376.        property Height default 7;
  377.        property Visible;
  378.        property Enabled;
  379.        property PopupMenu;
  380.        property ParentShowHint;
  381.        property ParentFont default False;
  382.        property Font;
  383.        property Color default clBlack;
  384.        property ScaleTicks: integer read FScaleTicks write SetScaleTicks default 8;
  385.        property Point1: integer index 0 Read FPoint1 write SetPoints default 50;
  386.        property Point2: integer index 1 Read FPoint2 write SetPoints default 85;
  387.        property Scale1Color: TColor index 0 read FScale1Color write SetColors default clWhite;
  388.        property Scale2Color: TColor index 1 read FScale2Color write SetColors default clWhite;
  389.        property Scale3Color: TColor index 2 read FScale3Color write SetColors default clRed;
  390.        property Sensitivy: integer read FSensitivy write SetSensitivy default -35;
  391.        property LogAmp: Boolean read FLogAmp write SetLogAmp default True;
  392.        property Kind: TMMLevelKind read FKind write SetKind default lkHorizontal;
  393.        property Direction: TMMLevelDirection read FDirection write SetDirection default dirNormal;
  394.        property Scale: TMMLevScale read FScale write SetScale;
  395.        property ScalePos: TMMScalePos read FScalePos write SetScalePos default spBoth;
  396.      end;
  398. implementation
  400. {------------------------------------------------------------------------}
  401. procedure TimeCallBack(uTimerID, dwUser: Longint); export;
  402. begin
  403.   if (dwUser <> 0) then
  404.   with TMMCustomLevel(dwUser) do
  405.   begin
  406.      if (FPeak > 0) then
  407.      begin
  408.         dec(FPeakCounter);
  409.         if FPeakCounter <= 0 then
  410.         begin
  411.            if (FPeakSpeed = 0) then
  412.            begin
  413.               FPeak := 0;                          { reset the peak }
  414.               FPeakCounter := 0;
  415.            end
  416.            else
  417.            begin
  418.               dec(FPeak);                          { dec the peak spot }
  419.               FPeakCounter := FPeakSpeed;
  420.            end;
  421.            FRefresh := True;
  422.         end;
  423.      end;
  424.   end;
  425. end;
  427. {-- TMMCustomLevel ------------------------------------------------------}
  428. constructor TMMCustomLevel.Create(AOwner: TComponent);
  429. begin
  430.    inherited Create(AOwner);
  432.    FBarDIB := TMMDIBCanvas.Create(Self);
  433.    FTimerID := 0;
  434.    FRange := $7FFF;                                { 32768 - 16 bit (abs) }
  435.    FEnabled := True;
  436.    FKind := lkHorizontal;
  437.    FDirection := dirNormal;
  438.    FBar1Color := clAqua;
  439.    FBar2Color := clAqua;
  440.    FBar3Color := clRed;
  441.    FInact1Color := clTeal;
  442.    FInact2Color := clTeal;
  443.    FInact3Color := clMaroon;
  444.    FInactiveDoted := False;
  445.    FActiveDoted := False;
  446.    FSpotSpace := 1;
  447.    FSpotWidth := 1;
  448.    FBits := b8Bit;
  449.    FChannel := chBoth;
  450.    FMode := mMono;
  451.    FDrawScale := False;
  452.    FNumPeaks := 1;
  453.    FPeakDelay := 20;
  454.    FPeakSpeed := 0;
  455.    FPeakCounter := 0;
  456.    FData := 0;
  457.    FDecay := 1;
  458.    FDecayMode := dmNone;
  459.    FDecayFactor := 0.0001;
  460.    FDecayCount := 1;
  461.    FDecayCntAct := 0;
  462.    FDecayPtr := 0;
  463.    FCurPeak := 0;
  464.    FPeak := 0;
  465.    FGain := 8;                                    { no Gain = 8 div 8 = 1 }
  466.    FSamples := 50;
  467.    FPoint1 := 50;
  468.    FPoint2 := 85;
  469.    FRefresh := False;
  470.    FSensitivy := -35;
  471.    FLogAmp := True;
  472.    FDCOffsetL := 0;
  473.    FDCOffsetR := 0;
  474.    FDrawReversed := False;
  476.    SetBounds(0,0,200,17);
  478.    Color := clBlack;
  479.    ParentFont := False;
  480.    Font.Name := 'Small Fonts';
  481.    Font.Size := 7;
  483.    SetBytesPerLevel;
  485.    if not (csDesigning in ComponentState) then
  486.    begin
  487.       { create the peak timer }
  488.       FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
  489.    end;
  491.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  492.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  493. end;
  495. {-- TMMCustomLevel ------------------------------------------------------}
  496. Destructor TMMCustomLevel.Destroy;
  497. begin
  498.    if (FTimerID <> 0) then
  499.    begin
  500.       { destroy the peak timer }
  501.       MMTimeKillEvent(FTimerID);
  502.    end;
  503.    FBarDIB.Free;
  505.    inherited Destroy;
  506. end;
  508. {-- TMMCustomLevel ------------------------------------------------------}
  509. procedure TMMCustomLevel.ChangeDesigning(aValue: Boolean);
  510. begin
  511.    inherited ChangeDesigning(aValue);
  513.    if not (csDesigning in ComponentState) then
  514.    begin
  515.       { create the peak timer }
  516.       if (FTimerID = 0) then
  517.           FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
  518.    end;
  519. end;
  521. {-- TMMCustomLevel ------------------------------------------------------}
  522. procedure TMMCustomLevel.SetBPP(aValue: integer);
  523. begin
  524.    if (aValue <> BitsPerPixel) then
  525.    begin
  526.       if (aValue <> 8) and (aValue <> 24) then
  527.          raise EMMDIBError.Create('Bitlength not supported yet');
  529.       FBarDIB.BitsPerPixel := aValue;
  530.       DIBCanvas.BitsPerPixel := aValue;
  531.       DrawInactiveSpots;
  532.       Invalidate;
  533.    end;
  534. end;
  536. {-- TMMCustomLevel ------------------------------------------------------}
  537. procedure TMMCustomLevel.GainOverflow;
  538. begin
  539.    if Assigned(FOnGainOverflow) then FOnGainOverflow(Self);
  540. end;
  542. {-- TMMCustomLevel ------------------------------------------------------}
  543. procedure TMMCustomLevel.PcmOverflow;
  544. begin
  545.    if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
  546. end;
  548. {-- TMMCustomLevel ------------------------------------------------------}
  549. procedure TMMCustomLevel.ResetDecayBuffers;
  550. var
  551.    i: integer;
  553. begin
  554.    FDecayPtr := 0;
  555.    FDecayCntAct := 0;      { Restart the count of number of samples taken }
  556.    FLastVal := 0;
  557.    FLastVal_F := 0;
  558.    for i := 0 to MAXDECAYCOUNT-1 do FDataBuf[i] := 0;
  559. end;
  561. {-- TMMCustomLevel ------------------------------------------------------}
  562. procedure TMMCustomLevel.ResetData;
  563. begin
  564.    FPeak := 0;
  565.    FPeakCounter := 0;
  566.    FData := 0;
  567.    FCurPeak := 0;
  568.    ResetDecayBuffers;
  569.    Refresh;
  570. end;
  572. {-- TMMCustomLevel ------------------------------------------------------}
  573. procedure TMMCustomLevel.SetDecayMode(aValue: TMMDecayMode);
  574. begin
  575.    { Select averaging mode }
  576.    if (aValue <> FDecayMode) then
  577.    begin
  578.       FDecayMode := aValue;
  579.       { Re-initialize the buffers }
  580.       ResetDecayBuffers;
  581.    end;
  582. end;
  584. {-- TMMCustomLevel ------------------------------------------------------}
  585. procedure TMMCustomLevel.SetDecay(aValue: integer);
  586. var
  587.    i: integer;
  589. begin
  590.    aValue := MinMax(aValue,1,16);
  591.    if (aValue <> FDecay) then
  592.    begin
  593.       FDecay := aValue;
  595.       { factor for stepUp and exponential averaging }
  596.       FDecayFactor := 0.0001;
  597.       for i := 0 to FDecay-1 do
  598.           FDecayFactor := sqrt(FDecayFactor);
  600.       { counter for uniform averaging }
  601.       FDecayCount := MinMax(2*(aValue-1),1,MaxDecayCount);
  603.       { Re-initialize the buffers for uniform averaging }
  604.       if (FDecayMode = dmUniform) then ResetDecayBuffers;
  605.    end;
  606.    {$IFDEF WIN32}
  607.    {$IFDEF TRIAL}
  608.    {$DEFINE _HACK1}
  609.    {$I MMHACK.INC}
  610.    {$ENDIF}
  611.    {$ENDIF}
  612. end;
  614. {-- TMMCustomLevel ------------------------------------------------------}
  615. procedure TMMCustomLevel.SetPeakDelay(aValue: integer);
  616. begin
  617.    aValue := MinMax(aValue, 0, 50);
  618.    if (aValue <> FPeakDelay) then
  619.    begin
  620.       FPeakDelay := aValue;
  621.       FPeakCounter := 0;
  622.       Invalidate;
  623.    end;
  624.    {$IFDEF WIN32}
  625.    {$IFDEF TRIAL}
  626.    {$DEFINE _HACK2}
  627.    {$I MMHACK.INC}
  628.    {$ENDIF}
  629.    {$ENDIF}
  630. end;
  632. {-- TMMCustomLevel ------------------------------------------------------}
  633. procedure TMMCustomLevel.SetPeakSpeed(aValue: integer);
  634. begin
  635.    aValue := MinMax(aValue, 0, 50);
  636.    if (aValue <> FPeakSpeed) then
  637.    begin
  638.       FPeakSpeed := aValue;
  639.       FPeakCounter := 0;
  640.       Invalidate;
  641.    end;
  642. end;
  644. {-- TMMCustomLevel ------------------------------------------------------}
  645. procedure TMMCustomLevel.SetNumPeaks(aValue: integer);
  646. begin
  647.    aValue := MinMax(aValue, 0, 5);
  648.    if (aValue <> FNumPeaks) then
  649.    begin
  650.       FNumPeaks := aValue;
  651.       FPeakCounter := 0;
  652.       if (FNumPeaks = 0) then
  653.          MMTimeSuspendEvent(FTimerID)
  654.       else if FEnabled then
  655.          MMTimeResumeEvent(FTimerID);
  657.       Invalidate;
  658.    end;
  659. end;
  661. {-- TMMCustomLevel ------------------------------------------------------}
  662. procedure TMMCustomLevel.SetEnabled(aValue: Boolean);
  663. begin
  664.    if (aValue <> FEnabled) then
  665.    begin
  666.       FEnabled := aValue;
  667.       { inherited Enabled := Value }
  668.       if (not FEnabled) then
  669.       begin
  670.          ResetData;
  671.          MMTimeSuspendEvent(FTimerID);
  672.       end
  673.       else
  674.       begin
  675.          CalcNumSpots;                     { init FData when in designing }
  676.          MMTimeResumeEvent(FTimerID);
  677.       end;
  678.       Invalidate;
  679.    end;
  680. end;
  682. {-- TMMCustomLevel ------------------------------------------------------}
  683. procedure TMMCustomLevel.SetKind(aValue: TMMLevelKind);
  684. var
  685.    Temp: integer;
  686. begin
  687.    if (aValue <> FKind) then
  688.    begin
  689.       FKind := aValue;
  690.       if ((FKind = lkHorizontal) and (Height > Width)) or
  691.          ((FKind = lkVertical) and (Height < Width)) then
  692.       begin
  693.          Temp := Width;
  694.          Width := Height;                        { swap Width and Height }
  695.          Height := Temp;
  696.       end;
  697.       Changed;                                    { recalc the dimension }
  698.       Invalidate;
  699.    end;
  700. end;
  702. {-- TMMCustomLevel ------------------------------------------------------}
  703. procedure TMMCustomLevel.SetDirection(aValue: TMMLevelDirection);
  704. Begin
  705.    if (aValue <> FDirection) then
  706.    begin
  707.       FDirection := aValue;
  708.       DrawInactiveSpots;
  709.       Invalidate;
  710.    end;
  711. end;
  713. {-- TMMCustomLevel ------------------------------------------------------}
  714. procedure TMMCustomLevel.SetSpotSpace(aValue: integer);
  715. begin
  716.    aValue := MinMax(aValue, 0, 10);
  717.    if (aValue <> FSpotSpace) then
  718.    begin
  719.       FSpotSpace := aValue;
  720.       CalcNumSpots;
  721.       Invalidate;
  722.    end;
  723.    {$IFDEF WIN32}
  724.    {$IFDEF TRIAL}
  725.    {$DEFINE _HACK3}
  726.    {$I MMHACK.INC}
  727.    {$ENDIF}
  728.    {$ENDIF}
  729. end;
  731. {-- TMMCustomLevel ------------------------------------------------------}
  732. procedure TMMCustomLevel.SetSpotWidth(aValue: integer);
  733. Var
  734.    Temp: integer;
  736. begin
  737.    Temp := 0;
  738.    case FKind of
  739.       lkHorizontal: Temp := FWidth div 3;
  740.       lkVertical  : Temp := FHeight div 3;
  741.    end;
  743.    aValue := MinMax(aValue, 1, Temp);
  744.    if (aValue <> FSpotWidth) then
  745.    begin
  746.       FSpotWidth := aValue;
  747.       CalcNumSpots;
  748.       Invalidate;
  749.    end;
  750. end;
  752. {-- TMMCustomLevel ------------------------------------------------------}
  753. procedure TMMCustomLevel.SetSensitivy(aValue: integer);
  754. begin
  755.    aValue := MinMax(aValue, -90, -9);
  756.    if (aValue <> FSensitivy) then
  757.    begin
  758.       FSensitivy := aValue;
  759.    end;
  760. end;
  762. {-- TMMCustomLevel ------------------------------------------------------}
  763. procedure TMMCustomLevel.SetLogAmp(aValue: Boolean);
  764. begin
  765.    if (aValue <> FLogAmp) then
  766.    begin
  767.       FLogAmp := aValue;
  768.       Invalidate;
  769.    end;
  770. end;
  772. {-- TMMCustomLevel ------------------------------------------------------}
  773. procedure TMMCustomLevel.CalcNumSpots;
  774. begin
  775.    FSpotWidth := Max(FSpotWidth,1);
  776.    if (FKind = lkHorizontal) then
  777.    begin
  778.       FNumSpots := (FWidth+FSpotSpace) div (FSpotWidth+FSpotSpace);
  779.       FNumSpots := Max(FNumSpots,1);          { fix div by zerro !!! }
  780.       FFirstSpace := (FWidth-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
  781.    end
  782.    else
  783.    begin
  784.       FNumSpots := (FHeight+FSpotSpace)div(FSpotWidth+FSpotSpace);
  785.       FNumSpots := Max(FNumSpots,1);           { fix div by zerro !!! }
  786.       FFirstSpace := (FHeight-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
  787.    end;
  789.    { calc the spot on which the next color starts }
  790.    FPoint1Spot := (FPoint1 * FNumSpots) div 100;
  791.    FPoint2Spot := (FPoint2 * FNumSpots) div 100;
  793.    { redraw background }
  794.    DrawInactiveSpots;
  796.    { we will see anything in designer }
  797.    if (csDesigning in ComponentState) and FEnabled then
  798.    begin
  799.       if (FPoint2Spot < FNumSpots) then
  800.          FData := FPoint2Spot + ((FNumSpots-FPoint2Spot) div 2)
  801.       else if (FPoint1Spot < FNumSpots) then
  802.          FData := FPoint1Spot + ((FNumSpots-FPoint1Spot) div 2)
  803.       else
  804.          FData := FNumSpots - (FNumSpots div 4);
  805.    end
  806.    else
  807.    begin
  808.       FPeak := 0;
  809.       FData := 0;
  810.    end;
  811. end;
  813. {-- TMMCustomLevel ------------------------------------------------------}
  814. procedure TMMCustomLevel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  815. begin
  816.    inherited SetBounds(aLeft, aTop, aWidth, aHeight);
  817.    Changed;
  818. end;
  820. {-- TMMCustomLevel ------------------------------------------------------}
  821. procedure TMMCustomLevel.Loaded;
  822. begin
  823.    inherited Loaded;
  825.    DrawInactiveSpots;
  826.    Invalidate;
  827. end;
  829. {-- TMMCustomLevel ------------------------------------------------------}
  830. procedure TMMCustomLevel.Changed;
  831. begin
  832.    FClientRect := BeveledRect;
  833.    FWidth  := Max(FClientRect.Right - FClientRect.Left,1);
  834.    FHeight := Max(FClientRect.Bottom - FClientRect.Top,1);
  836.    DIBCanvas.SetBounds(0,0,FWidth,FHeight);
  837.    FBarDIB.SetBounds(0,0,FWidth,FHeight);
  839.    { recalculate the number of spots }
  840.    CalcNumSpots;
  842.    inherited Changed;
  843. end;
  845. {-- TMMCustomLevel ------------------------------------------------------}
  846. procedure TMMCustomLevel.SetBytesPerLevel;
  847. begin
  848.    FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FSamples;
  849. end;
  851. {-- TMMCustomLevel ------------------------------------------------------}
  852. procedure TMMCustomLevel.SetSamples(aValue: integer);
  853. begin
  854.    aValue := Max(aValue, 1);
  855.    if (aValue <> FSamples) then
  856.    begin
  857.       FSamples := aValue;
  858.       SetBytesPerLevel;
  859.    end;
  860. end;
  862. {-- TMMCustomLevel ------------------------------------------------------}
  863. procedure TMMCustomLevel.SetPCMWaveFormat(wf: TPCMWaveFormat);
  864. var
  865.    pwfx: PWaveFormatEx;
  867. begin
  868.    pwfx := @wf;
  869.    if not pcmIsValidFormat(pwfx) then
  870.       raise EMMLevelError.Create(LoadResStr(IDS_INVALIDFORMAT));
  872.    BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
  873.    Mode := TMMMode(pwfx^.nChannels-1);
  874. end;
  876. {-- TMMCustomLevel ------------------------------------------------------}
  877. function TMMCustomLevel.GetPCMWaveFormat: TPCMWaveFormat;
  878. var
  879.    wfx: TWaveFormatEx;
  880. begin
  881.    pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, 11025);
  882.    Result := PPCMWaveFormat(@wfx)^;
  883. end;
  885. {-- TMMCustomLevel ------------------------------------------------------}
  886. procedure TMMCustomLevel.SetBits(aValue: TMMBits);
  887. begin
  888.    if (aValue <> FBits) then
  889.    begin
  890.       FBits := aValue;
  891.       SetBytesPerLevel;
  892.       Invalidate;
  893.    end;
  894. end;
  896. {-- TMMCustomLevel ------------------------------------------------------}
  897. procedure TMMCustomLevel.SetChannel(aValue: TMMChannel);
  898. begin
  899.    if (aValue <> FChannel) then
  900.    begin
  901.       FChannel := aValue;
  902.       SetBytesPerLevel;
  903.       Invalidate;
  904.    end;
  905.    {$IFDEF WIN32}
  906.    {$IFDEF TRIAL}
  907.    {$DEFINE _HACK2}
  908.    {$I MMHACK.INC}
  909.    {$ENDIF}
  910.    {$ENDIF}
  911. end;
  913. {-- TMMCustomLevel ------------------------------------------------------}
  914. procedure TMMCustomLevel.SetMode(aValue: TMMMode);
  915. begin
  916.    if (aValue <> FMode) then
  917.    begin
  918.       FMode := aValue;
  919.       SetBytesPerLevel;
  920.       Invalidate;
  921.    end;
  922. end;
  924. {-- TMMCustomLevel ------------------------------------------------------}
  925. procedure TMMCustomLevel.SetGain(aValue: Integer);
  926. begin
  927.    if (aValue <> FGain-8) AND (aValue >= -8) AND (aValue <= 32) then
  928.    begin
  929.       FGain := aValue + 8;
  930.       Invalidate;
  931.    end;
  932. end;
  934. {-- TMMCustomLevel ------------------------------------------------------}
  935. function TMMCustomLevel.GetGain: Integer;
  936. begin
  937.    Result := FGain - 8;
  938. end;
  940. {-- TMMCustomLevel ------------------------------------------------------}
  941. procedure TMMCustomLevel.SetPoints(Index, aValue: integer);
  942. begin
  943.    aValue := MinMax(aValue, 1, 100);
  944.    case Index of
  945.      0: if FPoint1 = aValue then exit else FPoint1 := aValue;
  946.      1: if FPoint2 = aValue then exit else FPoint2 := aValue;
  947.    end;
  948.    CalcNumSpots;
  949.    Invalidate;
  950. end;
  952. {-- TMMCustomLevel ------------------------------------------------------}
  953. procedure TMMCustomLevel.SetColors(Index:Integer; aValue: TColor);
  954. begin
  955.    case Index of
  956.       0: if FBar1Color = aValue then exit else FBar1Color := aValue;
  957.       1: if FBar2Color = aValue then exit else FBar2Color := aValue;
  958.       2: if FBar3Color = aValue then exit else FBar3Color := aValue;
  959.       3: if FInact1Color = aValue then exit else FInact1Color := aValue;
  960.       4: if FInact2Color = aValue then exit else FInact2Color := aValue;
  961.       5: if FInact3Color = aValue then exit else FInact3Color := aValue;
  962.    end;
  963.    DrawInactiveSpots;
  964.    Invalidate;
  965. end;
  967. {-- TMMCustomLevel ------------------------------------------------------}
  968. procedure TMMCustomLevel.SetDCOffset(Index,aValue: Integer);
  969. begin
  970.    case Index of
  971.       0: if FDCOffsetL = aValue then exit else FDCOffsetL := -aValue;
  972.       1: if FDCOffsetR = aValue then exit else FDCOffsetR := -aValue;
  973.    end;
  974. end;
  976. {-- TMMCustomLevel ------------------------------------------------------}
  977. function TMMCustomLevel.GetDCOffset(Index: Integer): integer;
  978. begin
  979.    case Index of
  980.       0: Result := -FDCOffsetL;
  981.       1: Result := -FDCOffsetR;
  982.       else Result := 0;
  983.    end;
  984. end;
  986. {-- TMMCustomLevel ------------------------------------------------------}
  987. procedure TMMCustomLevel.SetInactiveDoted(aValue: Boolean);
  988. begin
  989.    if (aValue <> FInactiveDoted) then
  990.    begin
  991.       FInactiveDoted := aValue;
  992.       DrawInactiveSpots;
  993.       Invalidate;
  994.    end;
  995. end;
  997. {-- TMMCustomLevel ------------------------------------------------------}
  998. procedure TMMCustomLevel.SetActiveDoted(aValue: Boolean);
  999. begin
  1000.    if (aValue <> FActiveDoted) then
  1001.    begin
  1002.       FActiveDoted := aValue;
  1003.       DrawInactiveSpots;
  1004.       Invalidate;
  1005.    end;
  1006. end;
  1008. {-- TMMCustomLevel ------------------------------------------------------}
  1009. procedure TMMCustomLevel.CMColorChanged(var Message: TMessage);
  1010. begin
  1011.    DrawInactiveSpots;
  1012.    inherited;
  1013. end;
  1015. {-- TMMCustomLevel ------------------------------------------------------}
  1016. Procedure TMMCustomLevel.RefreshPCMData(PCMData: Pointer);
  1017. Var
  1018.    i: integer;
  1019.    ReIndex: integer;
  1020.    BestValue,Value,DCOffs: integer;
  1022. begin
  1023.    if FEnabled and Visible then
  1024.    begin
  1025.       BestValue := 0;
  1026.       ReIndex := Ord(FChannel)-1;
  1028.       if (FBits = b8bit) then
  1029.          if (FMode = mMono) then
  1030.          for i := 0 to FSamples-1 do
  1031.          begin
  1032.             Value := ABS((PByteArray(PCMData)^[i]+FDCOffsetL-128) shl 8);
  1033.             if (Value > BestValue) then BestValue := Value;
  1034.          end
  1035.          else if (FChannel = chBoth) then
  1036.          for i := 0 to FSamples-1 do
  1037.          begin
  1038.             Value := ABS(((Word(PByteArray(PCMData)^[i+i]+FDCOffsetL)+PByteArray(PCMData)^[i+i+1]+FDCOffsetR)div 2-128) shl 8);
  1039.             if (Value > BestValue) then BestValue := Value;
  1040.          end
  1041.          else
  1042.          begin
  1043.             if (FChannel = chLeft) then
  1044.                 DCOffs := FDCOffsetL
  1045.             else
  1046.                 DCOffs := FDCOffsetR;
  1048.             for i := 0 to FSamples-1 do
  1049.             begin
  1050.                Value := ABS((PByteArray(PCMData)^[i+i+ReIndex]+DCOffs-128) shl 8);
  1051.                if (Value > BestValue) then BestValue := Value;
  1052.             end;
  1053.          end
  1054.       else
  1055.          if (FMode = mMono) then
  1056.          for i := 0 to FSamples-1 do
  1057.          begin
  1058.             Value := ABS(PSmallArray(PCMData)^[i]+FDCOffsetL);
  1059.             if (Value > BestValue) then BestValue := Value;
  1060.          end
  1061.          else if (FChannel = chBoth) then
  1062.          for i := 0 to FSamples-1 do
  1063.          begin
  1064.             Value := ABS((Long(PSmallArray(PCMData)^[i+i]+FDCOffsetL)+PSmallArray(PCMData)^[i+i+1]+FDCOffsetR)div 2);
  1065.             if (Value > BestValue) then BestValue := Value;
  1066.          end
  1067.          else
  1068.          begin
  1069.             if (FChannel = chLeft) then
  1070.                 DCOffs := FDCOffsetL
  1071.             else
  1072.                 DCOffs := FDCOffsetR;
  1074.             for i := 0 to FSamples-1 do
  1075.             begin
  1076.                Value := ABS(PSmallArray(PCMData)^[i+i+ReIndex]+DCOffs);
  1077.                if (Value > BestValue) then BestValue := Value;
  1078.             end;
  1079.          end;
  1081.       if (BestValue >= FRange) then PcmOverflow;
  1083.       SetData(BestValue);
  1084.    end;
  1085. end;
  1087. {-- TMMCustomLevel ------------------------------------------------------}
  1088. procedure TMMCustomLevel.SetData(SampleValue: integer);
  1089. var
  1090.    dbValue: Float;
  1092. begin
  1093.    SampleValue := abs(SampleValue);
  1095.    FCurPeak := SampleValue;
  1097.    if (SampleValue = 0) and (FData = 0) and not FRefresh then exit;
  1099.    if (FDecayMode <> dmNone) then
  1100.    begin
  1101.       inc(FDecayPtr);
  1102.       inc(FDecayCntAct);
  1103.       if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;
  1104.       if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;
  1106.       { In decay mode, need to average the value }
  1107.       case Ord(FDecayMode) of
  1108.         1: begin
  1109.               FLastVal_F := FLastVal_F*FDecayFactor;
  1110.               if (SampleValue > FLastVal_F) then FLastVal_F := SampleValue
  1111.               else SampleValue := Trunc(FLastVal_F);
  1112.            end;
  1113.         2: begin
  1114.       FLastVal_F := FLastVal_F*FDecayFactor+(1-FDecayFactor)*SampleValue;
  1115.       SampleValue := Floor(FLastVal_F);
  1116.            end;
  1117.         3: begin
  1118.               FLastVal := FLastVal+(SampleValue-FDataBuf[FDecayPtr]);
  1119.               FDataBuf[FDecayPtr] := SampleValue;
  1120.               SampleValue := FLastVal div FDecayCntAct;
  1121.            end;
  1122.       end;
  1123.    end;
  1125.    if FLogAmp then
  1126.    begin
  1127.       { add the gain and calc the actual db value }
  1128.       dbValue := Log10(MaxR(MulDiv32(SampleValue,FGain,8)/FRange,0.000001))*20;
  1130.       { now the scaling }
  1131.       SampleValue := Max(Round((dbValue-FSensitivy)*FNumSpots/-FSensitivy),0);
  1132.    end
  1133.    else
  1134.    begin
  1135.       { calc the low limit (Sensivity(db) to sample value }
  1136.       dbValue := FRange/pow(10,-FSensitivy/20);
  1137.       { now the scaling }
  1138.       SampleValue := Max(Round((MulDiv32(SampleValue,FGain,8)-dbValue)*FNumSpots/(FRange-dbValue)),0);
  1139.    end;
  1141.    if (Direction = dirSymetric) then
  1142.        SampleValue := SampleValue div 2;
  1144.    if FDrawReversed then
  1145.       SampleValue := FNumSpots-SampleValue;
  1147.    if (SampleValue > FNumSpots) then
  1148.    begin
  1149.       GainOverflow;
  1150.       SampleValue := FNumSpots;
  1151.    end;
  1153.    if (SampleValue >= FPeak) and (SampleValue > 0) and (FNumPeaks > 0) then
  1154.    begin
  1155.       FRefresh := True;
  1156.       FPeak := SampleValue;                          {start a new peak timer }
  1157.       FPeakCounter := (FPeakDelay*2)+1;
  1158.    end;
  1160.    if (SampleValue <> FData) or FRefresh then
  1161.    begin
  1162.       FRefresh := False;
  1164.       FData := SampleValue;
  1166.       if FEnabled and Visible then
  1167.          FastDraw(DrawLevel,False);
  1168.    end;
  1169. end;
  1171. {-- TMMCustomLevel ------------------------------------------------------}
  1172. procedure TMMCustomLevel.SetValue(aValue: integer);
  1173. begin
  1174.    SetData(Round(MinMax(aValue,0,VALUERANGE)*FRange/VALUERANGE));
  1175. end;
  1177. {-- TMMCustomLevel ------------------------------------------------------}
  1178. function TMMCustomLevel.GetValue: integer;
  1179. begin
  1180.    if FData = 0 then
  1181.       Result := 0
  1182.    else if not FLogAmp then
  1183.       Result := Round(FData * VALUERANGE / FNumSpots)
  1184.    else
  1185.       Result := Round(pow(10,(FSensitivy-FSensitivy*FData/FNumspots)/20)
  1186.                           * 8 / FGain * VALUERANGE);
  1187. end;
  1189. {-- TMMCustomLevel ------------------------------------------------------}
  1190. function TMMCustomLevel.GetPeak: integer;
  1191. begin
  1192.    if FPeak = 0 then
  1193.       Result := 0
  1194.    else if not FLogAmp then
  1195.       Result := Round(FPeak * VALUERANGE / FNumSpots)
  1196.    else
  1197.       Result := Round(pow(10,(FSensitivy-FSensitivy*FPeak/FNumspots)/20)
  1198.                           * 8 / FGain * VALUERANGE);
  1199. end;
  1201. {-- TMMCustomLevel ------------------------------------------------------}
  1202. function TMMCustomLevel.GetPeakValue: integer;
  1203. begin
  1204.   Result := (GetPeak * FRange) div VALUERANGE;
  1205. end;
  1207. {-- TMMCustomLevel ------------------------------------------------------}
  1208. procedure TMMCustomLevel.SetOnDrawBar(aValue: TMMLevelDrawBar);
  1209. begin
  1210.    FOnDrawBar := aValue;
  1211.    if not assigned(FOnDrawBar) then DrawInactiveSpots;
  1212.    Invalidate;
  1213. end;
  1215. {-- TMMCustomLevel ------------------------------------------------------}
  1216. procedure TMMCustomLevel.DrawLevelHorizontal(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
  1217. Var
  1218.    i: integer;
  1219.    SpotRect: TRect;                                 { Spot draw rectangle }
  1220.    SpotInc: integer;                       { increase value for next spot }
  1222. begin
  1223.    SpotInc := FSpotWidth + FSpotSpace;
  1224.    SpotRect.Top := 0;
  1225.    SpotRect.Bottom := FHeight;
  1227.    if (FDirection = dirNormal) then
  1228.    begin
  1229.       SpotRect.Left := FFirstSpace;
  1230.       SpotRect.Right := SpotRect.Left + FSpotWidth;             {Leerraum }
  1231.    end
  1232.    else
  1233.    begin
  1234.       SpotRect.Right := FWidth - FFirstSpace;
  1235.       SpotRect.Left := SpotRect.Right - FSpotWidth;
  1236.       SpotInc := -SpotInc;
  1237.    end;
  1239.    with DIB do
  1240.    begin
  1241.       if not DrawAll and (Direction = dirSymetric) then
  1242.       begin
  1243.          if (nSpots > FNumSpots) then nSpots := FNumSpots
  1244.          else if (nSpots < 1) then nSpots := 1;
  1246.          OffsetRect(SpotRect, (nSpots-1-SYNCBARS)*SpotInc, 0);
  1248.          for i := 0 to 2*SYNCBARS do   { draw the highlited spots }
  1249.          begin
  1250.             if (nSpots > FPoint2Spot) then DIB_SetTColor(FBar3Color)
  1251.             else if (nSpots > FPoint1Spot) then DIB_SetTColor(FBar2Color)
  1252.             else DIB_SetTColor(FBar1Color);
  1254.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1255.             OffsetRect(SpotRect, SpotInc, 0);
  1256.          end;
  1257.       end
  1258.       else
  1259.       begin
  1260.          DIB_SetTColor(FBar1Color);
  1261.          for i := 1 to nSpots do { draw the highlited spots }
  1262.          begin
  1263.             if i > FPoint2Spot then DIB_SetTColor(FBar3Color)
  1264.             else if i > FPoint1Spot then DIB_SetTColor(FBar2Color);
  1265.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1266.             OffsetRect(SpotRect, SpotInc, 0);
  1267.          end;
  1268.       end;
  1270.       if (FNumPeaks > 0) and (Peak > nSpots) then
  1271.       begin
  1272.          OffsetRect(SpotRect, ((Peak-1)-nSpots)*SpotInc, 0);
  1274.          for i := 0 to FNumPeaks-1 do       { draw the peak spots }
  1275.          begin
  1276.             if Peak-i  > FPoint2Spot then DIB_SetTColor(FBar3Color)
  1277.             else if Peak-i > FPoint1Spot then DIB_SetTColor(FBar2Color)
  1278.             else DIB_SetTColor(FBar1Color);
  1279.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1280.             OffsetRect(SpotRect, -SpotInc, 0);
  1281.          end;
  1282.       end;
  1283.    end;
  1284. end;
  1286. {-- TMMCustomLevel ------------------------------------------------------}
  1287. procedure TMMCustomLevel.DrawLevelVertical(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
  1288. Var
  1289.    i: integer;
  1290.    SpotRect: TRect;                                 { Spot draw rectangle }
  1291.    SpotInc: integer;                       { increase value for next spot }
  1293. begin
  1294.    SpotInc := FSpotWidth + FSpotSpace;
  1295.    SpotRect.Left := 0;
  1296.    SpotRect.Right := FWidth;
  1298.    with DIB do
  1299.    begin
  1300.       if (FDirection = dirNormal) then
  1301.       begin
  1302.          SpotRect.Bottom := FHeight - FFirstSpace;
  1303.          SpotRect.Top := SpotRect.Bottom - FSpotWidth;
  1304.          SpotInc := -SpotInc;
  1305.       end
  1306.       else
  1307.       begin
  1308.          SpotRect.Top := FFirstSpace;
  1309.          SpotRect.Bottom := SpotRect.Top + FSpotWidth;
  1310.       end;
  1312.       if not DrawAll and (Direction = dirSymetric) then
  1313.       begin
  1314.          if (nSpots > FNumSpots) then nSpots := FNumSpots
  1315.          else if (nSpots < 1) then nSpots := 1;
  1317.          OffsetRect(SpotRect, 0, (nSpots-1-SYNCBARS)*SpotInc);
  1319.          for i := 0 to 2*SYNCBARS do   { draw the highlited spots }
  1320.          begin
  1321.             if (nSpots > FPoint2Spot) then DIB_SetTColor(FBar3Color)
  1322.             else if (nSpots > FPoint1Spot) then DIB_SetTColor(FBar2Color)
  1323.             else DIB_SetTColor(FBar1Color);
  1325.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1326.             OffsetRect(SpotRect, 0, SpotInc);
  1327.          end;
  1328.       end
  1329.       else
  1330.       begin
  1331.          DIB_SetTColor(FBar1Color);
  1332.          for i := 1 to nSpots do                 { draw the highlited spots }
  1333.          begin
  1334.             if i > FPoint2Spot then DIB_SetTColor(FBar3Color)
  1335.             else if i > FPoint1Spot then DIB_SetTColor(FBar2Color);
  1337.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1338.             OffsetRect(SpotRect, 0, SpotInc);
  1339.          end;
  1340.       end;
  1342.       if (FNumPeaks > 0) and (Peak > nSpots) then
  1343.       begin
  1344.          OffsetRect(SpotRect, 0, ((Peak-1)-nSpots) * SpotInc);
  1346.          for i := 0 to FNumPeaks-1 do       { draw the peak spots }
  1347.          begin
  1348.             if Peak-i  > FPoint2Spot then DIB_SetTColor(FBar3Color)
  1349.             else if Peak-i > FPoint1Spot then DIB_SetTColor(FBar2Color)
  1350.             else DIB_SetTColor(FBar1Color);
  1351.             DIB_FillRectDoted(SpotRect,FActiveDoted);
  1352.             OffsetRect(SpotRect, 0, -SpotInc);
  1353.          end;
  1354.       end;
  1355.    end;
  1356. end;
  1358. {-- TMMCustomLevel ------------------------------------------------------}
  1359. procedure TMMCustomLevel.DrawInactiveSpots;
  1360. var
  1361.    _Bar1,_Bar2,_Bar3: TColor;
  1362.    _Active: Boolean;
  1364. begin
  1365.    if not (csLoading in ComponentState) and (FBarDIB <> nil) and not assigned(FOnDrawBar) then
  1366.    with FBarDIB do
  1367.    begin
  1368.       DIB_InitDrawing;
  1371.       DIB_SetTColor(Color);
  1372.       DIB_Clear;
  1374.       _Bar1 := FBar1Color;
  1375.       _Bar2 := FBar2Color;
  1376.       _Bar3 := FBar3Color;
  1377.       _Active := FActiveDoted;
  1378.       FBar1Color := FInact1Color;
  1379.       FBar2Color := FInact2Color;
  1380.       FBar3Color := FInact3Color;
  1381.       FActiveDoted := FInactiveDoted;
  1382.       case FKind of
  1383.          lkHorizontal: DrawLevelHorizontal(FBarDIB,FNumSpots,0,True);
  1384.          lkVertical  : DrawLevelVertical(FBarDIB,FNumSpots,0,True);
  1385.       end;
  1386.       FBar1Color := _Bar1;
  1387.       FBar2Color := _Bar2;
  1388.       FBar3Color := _Bar3;
  1389.       FActiveDoted := _Active;
  1391.       DIB_DoneDrawing;
  1392.    end;
  1393. end;
  1395. {-- TMMCustomLevel ------------------------------------------------------}
  1396. procedure TMMCustomLevel.DrawLevel(Dummy: Boolean);
  1397. begin
  1398.    if assigned(FOnPaint) then FOnPaint(Self);
  1400.    DIBCanvas.DIB_InitDrawing;
  1401.                                                    { draw the background }
  1402.    if assigned(FOnDrawBar) then
  1403.    begin
  1404.       FOnDrawBar(Self,DIBCanvas,Rect(0,0,FWidth,FHeight),FData,FPeak);
  1405.    end
  1406.    else
  1407.    begin
  1408.       DIBCanvas.DIB_CopyDIBBits(FBarDIB.Surface,0,0,FWidth,FHeight,0,0);
  1410.       if FEnabled then
  1411.       begin
  1412.          case FKind of                           { draw the level to bitmap }
  1413.            lkHorizontal: DrawLevelHorizontal(DIBCanvas,FData,FPeak,False);
  1414.            lkVertical  : DrawLevelVertical(DIBCanvas,FData,FPeak,False);
  1415.          end;
  1416.       end;
  1417.    end;
  1419.    DIBCanvas.DIB_BitBlt(Canvas.Handle,FClientRect,0,0); { copy to screen }
  1421.    DIBCanvas.DIB_DoneDrawing;
  1422. end;
  1424. {-- TMMCustomLevel ------------------------------------------------------}
  1425. Procedure TMMCustomLevel.Paint;
  1426. begin
  1427.    { draw the bevel }
  1428.    inherited Paint;
  1429.    DrawLevel(True);
  1431.    {$IFDEF BUILD_ACTIVEX}
  1432.    if Selected then
  1433.    begin
  1434.       Canvas.Brush.Style := bsClear;
  1435.       Canvas.Pen.Color   := clRed;
  1436.       Canvas.Rectangle(0,0,Width,Height);
  1437.       Canvas.Brush.Style := bsSolid;
  1438.    end;
  1439.    {$ENDIF}
  1440. end;
  1442. {== TMMLevelScale =======================================================}
  1443. constructor TMMLevelScale.Create(aOwner: TComponent);
  1444. begin
  1445.    inherited create(aOwner);
  1447.    FSensitivy := -35;
  1448.    FLogAmp := True;
  1449.    FScaleTicks := 8;
  1450.    FPoint1 := 50;
  1451.    FPoint2 := 85;
  1452.    FScale1Color := clWhite;
  1453.    FScale2Color := clWhite;
  1454.    FScale3Color := clRed;
  1455.    ParentFont := False;
  1456.    Font.Name := 'Small Fonts';
  1457.    Font.Size := 6;
  1458.    Color := clBlack;
  1459.    Width := 200;
  1460.    Height := 7;
  1461.    FScalePos := spBoth;
  1462.    FScale := TMMLevScale.Create;
  1463.    FScale.Visible := False;
  1464.    FScale.OnChange := ScaleChanged;
  1465. end;
  1467. {-- TMMLevelScale -------------------------------------------------------}
  1468. destructor TMMLevelScale.Destroy;
  1469. begin
  1470.    FScale.Free;
  1472.    inherited Destroy;
  1473. end;
  1475. {-- TMMLevelScale -------------------------------------------------------}
  1476. procedure TMMLevelScale.SetScalePos(Value: TMMScalePos);
  1477. begin
  1478.     if Value <> FScalePos then
  1479.     begin
  1480.        FScalePos := Value;
  1481.        Invalidate;
  1482.     end;
  1483. end;
  1485. {-- TMMLevelScale -------------------------------------------------------}
  1486. procedure TMMLevelScale.SetScale(Value: TMMLevScale);
  1487. begin
  1488.    FScale.Assign(Value);
  1489. end;
  1491. {-- TMMLevelScale -------------------------------------------------------}
  1492. procedure TMMLevelScale.ScaleChanged(Sender: TObject);
  1493. begin
  1494.    Invalidate;
  1495. end;
  1497. {-- TMMLevelScale -------------------------------------------------------}
  1498. procedure TMMLevelScale.SetSensitivy(aValue: integer);
  1499. begin
  1500.    aValue := MinMax(aValue, -90, -9);
  1501.    if (aValue <> FSensitivy) then
  1502.    begin
  1503.       FSensitivy := aValue;
  1504.       Invalidate;
  1505.    end;
  1506. end;
  1508. {-- TMMLevelScale -------------------------------------------------------}
  1509. procedure TMMLevelScale.SetLogAmp(aValue: Boolean);
  1510. begin
  1511.    if (aValue <> FLogAmp) then
  1512.    begin
  1513.       FLogAmp := aValue;
  1514.       Invalidate;
  1515.    end;
  1516. end;
  1518. {-- TMMLevelScale -------------------------------------------------------}
  1519. procedure TMMLevelScale.SetScaleTicks(aValue: integer);
  1520. begin
  1521.    if (aValue <> FScaleTicks) then
  1522.    begin
  1523.       FScaleTicks := Max(aValue,2);
  1524.       Invalidate;
  1525.    end;
  1526. end;
  1528. {-- TMMLevelScale -------------------------------------------------------}
  1529. procedure TMMLevelScale.SetPoints(Index, aValue: integer);
  1530. begin
  1531.    aValue := MinMax(aValue, 1, 100);
  1532.    case Index of
  1533.      0: if FPoint1 = aValue then exit else FPoint1 := aValue;
  1534.      1: if FPoint2 = aValue then exit else FPoint2 := aValue;
  1535.    end;
  1536.    Invalidate;
  1537. end;
  1539. {-- TMMLevelScale -------------------------------------------------------}
  1540. procedure TMMLevelScale.SetColors(Index:Integer; aValue: TColor);
  1541. begin
  1542.    case Index of
  1543.       0: if FScale1Color = aValue then exit else FScale1Color := aValue;
  1544.       1: if FScale2Color = aValue then exit else FScale2Color := aValue;
  1545.       2: if FScale3Color = aValue then exit else FScale3Color := aValue;
  1546.    end;
  1547.    Invalidate;
  1548. end;
  1550. {-- TMMLevelScale -------------------------------------------------------}
  1551. procedure TMMLevelScale.SetKind(aValue: TMMLevelKind);
  1552. var
  1553.    Temp: integer;
  1554. begin
  1555.    if (aValue <> FKind) then
  1556.    begin
  1557.       FKind := aValue;
  1558.       if ((FKind = lkHorizontal) and (Height > Width)) or
  1559.          ((FKind = lkVertical) and (Height < Width)) then
  1560.       begin
  1561.          Temp := Width;
  1562.          Width := Height;                        { swap Width and Height }
  1563.          Height := Temp;
  1564.       end;
  1565.       Invalidate;
  1566.    end;
  1567. end;
  1569. {-- TMMLevelScale -------------------------------------------------------}
  1570. Procedure TMMLevelScale.SetDirection(aValue: TMMLevelDirection);
  1571. Begin
  1572.    if (aValue <> FDirection) then
  1573.    begin
  1574.       FDirection := aValue;
  1575.       Invalidate;
  1576.    end;
  1577. end;
  1579. (*
  1580. {-- TMMLevelScale -------------------------------------------------------}
  1581. procedure TMMLevelScale.Paint;
  1582. const
  1583.      FRange = $7FFF;
  1584. var
  1585.    i, Count,CurValue,Volume: Longint;
  1586.    dbValue: Float;
  1587.    R        : TRect;
  1588.    Rev      : Boolean;
  1589.    P1, P2   : Integer;
  1591. begin
  1592.    with Canvas do
  1593.    begin
  1594.       Brush.Color := Color;
  1595.       FillRect(ClientRect);
  1596.       Font := Self.Font;
  1598.       R := ClientRect;
  1599.       if Scale.Visible then
  1600.       begin
  1601.         InflateRect(R,-1,-2);
  1602.         Scale.Canvas := Canvas ;
  1603.         Rev := (Kind = lkVertical) xor (Direction = dirReversed);
  1604.         if Rev then
  1605.         begin
  1606.             Scale.Color  := Scale3Color;
  1607.             Scale.Color2 := Scale2Color;
  1608.             Scale.Color3 := Scale1Color;
  1609.             P1           := 100 - Point2;
  1610.             P2           := 100 - Point1;
  1611.         end
  1612.         else
  1613.         begin
  1614.             Scale.Color  := Scale1Color;
  1615.             Scale.Color2 := Scale2Color;
  1616.             Scale.Color3 := Scale3Color;
  1617.             P1           := Point1;
  1618.             P2           := Point2;
  1619.         end;
  1621.         Scale.Point1 := MulDiv(P1-1,Scale.TickCount,100);
  1622.         Scale.Point2 := MulDiv(P2-1,Scale.TickCount,100);
  1623.         if (ScalePos = spAboveOrLeft) or (ScalePos = spBoth) then
  1624.         begin
  1625.            if Kind = lkHorizontal then
  1626.            begin
  1627.               Scale.DrawRect(Canvas,Rect(R.Left,R.Top,R.Right-1,R.Top+Scale.ScaleHeight),True);
  1628.               Inc(R.Top,Scale.ScaleHeight);
  1629.            end
  1630.            else
  1631.            begin
  1632.               Scale.DrawRect(Canvas,Rect(R.Left,R.Top,R.Left+Scale.ScaleHeight,R.Bottom-1),True);
  1633.               Inc(R.Left,Scale.ScaleHeight);
  1634.            end;
  1635.         end;
  1637.         if (ScalePos = spBelowOrRight) or (ScalePos = spBoth) then
  1638.         begin
  1639.            if Kind = lkHorizontal then
  1640.            begin
  1641.               Scale.DrawRect(Canvas,Rect(R.Left,R.Bottom-Scale.ScaleHeight,R.Right-1,R.Bottom),False);
  1642.               Dec(R.Bottom,Scale.ScaleHeight)
  1643.            end
  1644.            else
  1645.            begin
  1646.               Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top,R.Right,R.Bottom-1),False);
  1647.               Dec(R.Right,Scale.ScaleHeight);
  1648.            end;
  1649.         end;
  1650.       end;
  1651.       if (R.Top > R.Bottom) or (R.Left > R.Right) then Exit;
  1653.       { Draw the scale }
  1654.       if FScaleTicks > 1 then
  1655.       for i := 0 to FScaleTicks-1 do
  1656.       begin
  1657.          CurValue := MulDiv(FRange,i,FScaleTicks-1);
  1658.          if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
  1659.             ((FKind = lkVertical) and (FDirection = dirNormal)) then
  1660.             CurValue := FRange - CurValue;
  1662.          if (CurValue > Long(FPoint2)*FRange/100) then Font.Color := FScale3Color
  1663.          else if (CurValue > Long(FPoint1)*FRange/100) then Font.Color := FScale2Color
  1664.          else Font.Color := FScale1Color;
  1666.          if FLogAmp then
  1667.          begin
  1668.             Count := i;
  1669.             if ((FKind = lkHorizontal) and (FDirection = dirNormal)) or
  1670.                ((FKind = lkVertical) and (FDirection = dirReversed)) then
  1671.                  Count := FScaleTicks-1-Count;
  1673.             Volume := Muldiv(Count,FSensitivy,FScaleTicks-1)
  1674.          end
  1675.          else
  1676.          begin
  1677.             Count := i;
  1678.             if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
  1679.                ((FKind = lkVertical) and (FDirection = dirNormal)) then
  1680.                  Count := FScaleTicks-1-Count;
  1682.             dbValue := FRange/pow(10,-FSensitivy/20);
  1683.             Volume := Round(Log10(((Long(Count)*(FRange-dbValue)/(FScaleTicks-1))+dbValue)/FRange)*20)
  1684.          end;
  1686.          if (FDirection = dirNormal) then
  1687.             Count := 0
  1688.          else
  1689.             Count := FSensitivy;
  1691.          if (FKind = lkHorizontal) then
  1692.             TextOut(MulDiv32(i,R.Right-R.Left-TextWidth(IntToStr(Count))-1,FScaleTicks-1),
  1693.                     R.Top + (R.Bottom-R.Top-TextHeight(IntToStr(Volume))) div 2,IntToStr(Volume))
  1694.          else
  1695.             TextOut(R.Left + (R.Right-R.Left-TextWidth(IntToStr(Volume))) div 2,
  1696.                     MulDiv32(i,R.Bottom-R.Top-TextHeight(IntToStr(Count))-1,FScaleTicks-1),
  1697.                     IntToStr(Volume));
  1698.       end;
  1699.    end;
  1700. end;
  1701. *)
  1703. { TODO: Not perfect yet ! }
  1704. {-- TMMLevelScale -------------------------------------------------------}
  1705. procedure TMMLevelScale.Paint;
  1706. Label NextLoop;
  1707. const
  1708.    FRange = $7FFF;
  1710. var
  1711.    i, j, Pos, H2, W2, th, tw, tw2, Count, CurValue, Volume: Longint;
  1712.    dbValue  : Float;
  1713.    R        : TRect;
  1714.    Rev      : Boolean;
  1715.    P1, P2   : Integer;
  1716.    Skip     : Integer;
  1717.    incValue : Integer;
  1718.    Offset   : Integer;
  1719.    s        : string;
  1721. begin
  1722.    with Canvas do
  1723.    begin
  1724.       Brush.Color := Color;
  1725.       FillRect(ClientRect);
  1726.       Font := Self.Font;
  1728.       R := ClientRect;
  1729.       if (Kind = lkHorizontal) then
  1730.          Offset := TextWidth('0') div 2
  1731.       else
  1732.          Offset := TextHeight('0') div 2;
  1734.       if Scale.Visible then
  1735.       begin
  1736.         Scale.Canvas := Canvas;
  1737.         Rev := (Kind = lkVertical) xor (Direction = dirReversed);
  1738.         if Rev then
  1739.         begin
  1740.             Scale.Color  := Scale3Color;
  1741.             Scale.Color2 := Scale2Color;
  1742.             Scale.Color3 := Scale1Color;
  1743.             P1           := 100 - Point2;
  1744.             P2           := 100 - Point1;
  1745.         end
  1746.         else
  1747.         begin
  1748.             Scale.Color  := Scale1Color;
  1749.             Scale.Color2 := Scale2Color;
  1750.             Scale.Color3 := Scale3Color;
  1751.             P1           := Point1;
  1752.             P2           := Point2;
  1753.         end;
  1755.         Scale.Point1 := MulDiv(P1-1,Scale.TickCount,100);
  1756.         Scale.Point2 := MulDiv(P2-1,Scale.TickCount,100);
  1757.         if (ScalePos = spAboveOrLeft) or (ScalePos = spBoth) then
  1758.         begin
  1759.            if Kind = lkHorizontal then
  1760.            begin
  1761.               if Direction <> dirReversed then
  1762.                  Scale.DrawRect(Canvas,Rect(R.Left-Offset-1,R.Top,R.Right-Offset-1,R.Top+Scale.ScaleHeight),True)
  1763.               else
  1764.                  Scale.DrawRect(Canvas,Rect(R.Left+Offset,R.Top,R.Right+Offset-1,R.Top+Scale.ScaleHeight),True);
  1765.               Inc(R.Top,Scale.ScaleHeight);
  1766.            end
  1767.            else
  1768.            begin
  1769.               if Direction <> dirReversed then
  1770.                  Scale.DrawRect(Canvas,Rect(R.Left,R.Top+Offset,R.Left+Scale.ScaleHeight,R.Bottom+Offset-1),True)
  1771.               else
  1772.                  Scale.DrawRect(Canvas,Rect(R.Left,R.Top-Offset,R.Left+Scale.ScaleHeight,R.Bottom-Offset-1),True);
  1773.               Inc(R.Left,Scale.ScaleHeight);
  1774.            end;
  1775.         end;
  1777.         if (ScalePos = spBelowOrRight) or (ScalePos = spBoth) then
  1778.         begin
  1779.            if Kind = lkHorizontal then
  1780.            begin
  1781.               if Direction <> dirReversed then
  1782.                  Scale.DrawRect(Canvas,Rect(R.Left-Offset-1,R.Bottom-Scale.ScaleHeight,R.Right-Offset-1,R.Bottom),False)
  1783.               else
  1784.                  Scale.DrawRect(Canvas,Rect(R.Left+Offset,R.Bottom-Scale.ScaleHeight,R.Right+Offset-1,R.Bottom),False);
  1786.               Dec(R.Bottom,Scale.ScaleHeight)
  1787.            end
  1788.            else
  1789.            begin
  1790.               if Direction <> dirReversed then
  1791.                  Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top+Offset,R.Right,R.Bottom+Offset-1),False)
  1792.               else
  1793.                  Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top-Offset,R.Right,R.Bottom-Offset-1),False);
  1794.               Dec(R.Right,Scale.ScaleHeight);
  1795.            end;
  1796.         end;
  1797.       end;
  1799.       if (R.Top > R.Bottom) or (R.Left > R.Right) then Exit;
  1801.       th := TextHeight('W');
  1802.       tw := TextWidth(IntToStr(FSensitivy));
  1803.       tw2:= tw;
  1805.       { maybe we must skip some ticks ? }
  1806.       Skip := 1;
  1807.       if (FKind = lkHorizontal) then
  1808.       begin
  1809.          if (Direction = dirSymetric) then
  1810.             while (Width div 2) div (((FScaleTicks-1) div skip)*tw) < 1 do inc(Skip)
  1811.          else
  1812.             while Width div (((FScaleTicks-1) div skip)*tw) < 1 do inc(Skip);
  1814.          if (Direction <> dirReversed) then
  1815.             incValue := -1
  1816.          else
  1817.             incValue := 1;
  1818.       end
  1819.       else
  1820.       begin
  1821.          if (Direction = dirSymetric) then
  1822.              while (Height div 2) div (((FScaleTicks-1) div skip)*th) < 1 do inc(Skip)
  1823.          else
  1824.              while Height div (((FScaleTicks-1) div skip)*th) < 1 do inc(Skip);
  1826.          if (Direction <> dirReversed) then
  1827.             incValue := 1
  1828.          else
  1829.             incValue := -1;
  1830.       end;
  1832.       if (incValue = 1) then
  1833.          i := 0
  1834.       else
  1835.          i := FScaleTicks-1;
  1837.       H2 := (R.Bottom-R.Top) div 2;
  1838.       W2 := (R.Right-R.Left) div 2;
  1840.       { draw the scale }
  1841.       for j := 0 to FScaleTicks-1 do
  1842.       begin
  1843.          if ((j) mod Skip <> 0) then goto NextLoop;
  1845.          CurValue := MulDiv(FRange,i,FScaleTicks-1);
  1846.          if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
  1847.             ((FKind = lkVertical) and (FDirection <> dirReversed)) then
  1848.             CurValue := FRange - CurValue;
  1850.          if (CurValue > Long(FPoint2)*FRange/100) then Font.Color := FScale3Color
  1851.          else if (CurValue > Long(FPoint1)*FRange/100) then Font.Color := FScale2Color
  1852.          else Font.Color := FScale1Color;
  1854.          if FLogAmp then
  1855.          begin
  1856.             Count := i;
  1857.             if ((FKind = lkHorizontal) and (FDirection <> dirReversed)) or
  1858.                ((FKind = lkVertical) and (FDirection = dirReversed)) then
  1859.                  Count := FScaleTicks-1-Count;
  1861.             Volume := Muldiv(Count,FSensitivy,FScaleTicks-1)
  1862.          end
  1863.          else
  1864.          begin
  1865.             Count := i;
  1866.             if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
  1867.                ((FKind = lkVertical) and (FDirection <> dirReversed)) then
  1868.                  Count := FScaleTicks-1-Count;
  1870.             dbValue := FRange/pow(10,-FSensitivy/20);
  1871.             Volume := Round(Log10(((Long(Count)*(FRange-dbValue)/(FScaleTicks-1))+dbValue)/FRange)*20)
  1872.          end;
  1874.          if (FKind = lkHorizontal) then
  1875.          begin
  1876.             s := IntToStr(Volume);
  1877.             tw := TextWidth(s);
  1878.             if (FDirection = dirSymetric) then
  1879.             begin
  1880.                Pos := MulDivRN(i,(R.Right-R.Left-1)div 2,FScaleTicks-1);
  1881.                if (Pos >= 0) and (W2-Pos+tw <= W2) then
  1882.                begin
  1883.                   TextOut(R.Left+Pos-(tw div 2),R.Top+(R.Bottom-R.Top-th)div 2,s);
  1884.                   if (i < FScaleTicks-1) then
  1885.                   begin
  1886.                      s := '+'+IntToStr(abs(Volume));
  1887.                      TextOut(R.Left+2*W2-Pos-1-(tw div 2),R.Top+(R.Bottom-R.Top-th)div 2,s);
  1888.                   end; 
  1889.                end;
  1890.             end
  1891.             else
  1892.             begin
  1893.                Pos := MulDivRN(i,R.Right-R.Left-1,FScaleTicks-1);
  1894.                if incValue = -1 then dec(Pos,tw);
  1895.                if (Pos >= 0) and (Pos+tw <= Width) then
  1896.                   TextOut(R.Left+Pos,R.Top+(R.Bottom-R.Top-th)div 2,s);
  1897.             end;
  1898.          end
  1899.          else
  1900.          begin
  1901.             s := IntToStr(Volume);
  1902.             tw := TextWidth(s);
  1903.             if (FDirection = dirSymetric) then
  1904.             begin
  1905.                Pos := MulDivRN(i,(R.Bottom-R.Top-1)div 2,FScaleTicks-1);
  1906.                if (Pos >= 0) and (Pos+th <= H2) then
  1907.                begin
  1908.                   TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+H2+1+Pos-(th div 2),s);
  1909.                   if (i > 0) then
  1910.                   begin
  1911.                      s := '+'+IntToStr(abs(Volume));
  1912.                      TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+H2+1-Pos-(th div 2),s);
  1913.                   end;
  1914.                end;
  1915.             end
  1916.             else
  1917.             begin
  1918.                Pos := MulDivRN(i,R.Bottom-R.Top-1,FScaleTicks-1);
  1920.                if incValue = -1 then dec(Pos,th);
  1921.                if (Pos >= 0) and (Pos+th <= Height) then
  1922.                    TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+Pos,s);
  1923.             end;
  1924.          end;
  1926. NextLoop:
  1927.          i := i + incValue;
  1928.       end;
  1929.    end;
  1930. end;
  1932. end.