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

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

Delphi控件源码

开发平台：

Delphi

MMLight.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 03.03.98 - 18:51:13 $                                        =}
  24. {========================================================================}
  25. Unit MMLight;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.     Windows,
  34. {$ELSE}
  35.     WinTypes,
  36.     WinProcs,
  37. {$ENDIF}
  38.     SysUtils,
  39.     Messages,
  40.     Classes,
  41.     Graphics,
  42.     Controls,
  43.     Forms,
  44.     Menus,
  45.     MMSystem,
  46.     MMUtils,
  47.     MMObj,
  48.     MMString,
  49.     MMMath,
  50.     MMMulDiv,
  51.     MMFFT,
  52.     MMRegs,
  53.     MMPCMSup,
  54.     MMDIBCv;
  56. const
  57.     MAX_FFTLEN      = 4096; { Define the maximum FFT buffer length.        }
  58.     MAXDECAYCOUNT   = 32;   { Maximum amount of temporal averaging allowed }
  60. type
  61.     TMMLightKind    = (lkCircle,lkSphere);
  62.     TMMLightArrange = (laLine,laTriangle);
  63.     TMMLightPeakMode= (pmRMS,pmPeak,pmAverage);
  65. const
  66.     {$IFDEF CBUILDER3} {$EXTERNALSYM defRealize} {$ENDIF}
  67.     defRealize          = True;
  68.     {$IFDEF CBUILDER3} {$EXTERNALSYM defEnabled} {$ENDIF}
  69.     defEnabled          = True;
  70.     {$IFDEF CBUILDER3} {$EXTERNALSYM defHeight} {$ENDIF}
  71.     defHeight           = 90;
  72.     {$IFDEF CBUILDER3} {$EXTERNALSYM defWidth} {$ENDIF}
  73.     defWidth            = 194;
  74.     {$IFDEF CBUILDER3} {$EXTERNALSYM defMode} {$ENDIF}
  75.     defMode             = mMono;
  76.     {$IFDEF CBUILDER3} {$EXTERNALSYM defBitLength} {$ENDIF}
  77.     defBitLength        = b8bit;
  78.     {$IFDEF CBUILDER3} {$EXTERNALSYM defChannel} {$ENDIF}
  79.     defChannel          = chBoth;
  80.     {$IFDEF CBUILDER3} {$EXTERNALSYM defSampleRate} {$ENDIF}
  81.     defSampleRate       = 11025;
  82.     {$IFDEF CBUILDER3} {$EXTERNALSYM defFFTLen} {$ENDIF}
  83.     defFFTLen           = 128;
  84.     {$IFDEF CBUILDER3} {$EXTERNALSYM defWindow} {$ENDIF}
  85.     defWindow           = fwHamming;
  86.     {$IFDEF CBUILDER3} {$EXTERNALSYM defDecayMode} {$ENDIF}
  87.     defDecayMode        = dmNone;
  88.     {$IFDEF CBUILDER3} {$EXTERNALSYM defDecay} {$ENDIF}
  89.     defDecay            = 1;
  90.     {$IFDEF CBUILDER3} {$EXTERNALSYM defPeakMode} {$ENDIF}
  91.     defPeakMode         = pmPeak;
  92.     {$IFDEF CBUILDER3} {$EXTERNALSYM defKind} {$ENDIF}
  93.     defKind             = lkCircle;
  94.     {$IFDEF CBUILDER3} {$EXTERNALSYM defArrange} {$ENDIF}
  95.     defArrange          = laLine;
  96.     {$IFDEF CBUILDER3} {$EXTERNALSYM defTriangleDist} {$ENDIF}
  97.     defTriangleDist     = 10;
  98.     {$IFDEF CBUILDER3} {$EXTERNALSYM defSphereHorz} {$ENDIF}
  99.     defSphereHorz       = 1.0;
  100.     {$IFDEF CBUILDER3} {$EXTERNALSYM defSphereVert} {$ENDIF}
  101.     defSphereVert       = 1.0;
  102.     {$IFDEF CBUILDER3} {$EXTERNALSYM defZoneCount} {$ENDIF}
  103.     defZoneCount        = 60;
  104.     {$IFDEF CBUILDER3} {$EXTERNALSYM defColor} {$ENDIF}
  105.     defColor            = clBlack;
  107. type
  108.     EMMLightError   = class(Exception);
  110.     { array for uniform decay mode values }
  111.     PDataBuf        = ^TDataBuf;
  112.     TDataBuf        = array[0..MAXDECAYCOUNT-1] of PLongArray;
  114.     { struct to hold pre-calculated values for every band }
  115.     Values          = record
  116.        OldValue: Longint;
  117.        CurValue: Longint;
  118.     end;
  119.     PValues         = ^TValues;
  120.     TValues         = array[0..0] of Values;
  122.     {-- TMMLight --------------------------------------------------------}
  123.     TMMLight = class(TMMDIBGraphicControl)
  124.     private
  125.       {$IFDEF WIN32}
  126.       FpFFT           : PFFTReal;   { the instance for FFT calculation    }
  127.       {$ELSE}
  128.       FFT             : TMMFFT;     { the FFT object                      }
  129.       {$ENDIF}
  130.       FFFTData        : PSmallArray;{ Array for FFT data                  }
  131.       FWinBuf         : PIntArray;  { Array storing windowing function    }
  132.       FDataBuf        : PDataBuf;   { Memory for averaging mode           }
  133.       FDisplayVal     : PLongArray; { Array storing display values        }
  134.       FValues         : PValues;    { array with precalculted bin values  }
  135.       FLastVal_F      : PFloatArray;{ Last value buffer for exp decay mode}
  136.       FLastVal        : PLongArray; { Last value buffer for uniform avg   }
  137.       Fx1             : PIntArray;  { Array of bin #'s displayed          }
  138.       Fx2             : PIntArray;  { Array of terminal bin #'s           }
  140.       FDecay          : integer;    { the current Decay value             }
  141.       FDecayMode      : TMMDecayMode;{ indicating decay mode on/off       }
  142.       FDecayFactor    : Float;      { Geometric decay factor              }
  143.       FDecayCount     : integer;    { Temporal averaging parameter        }
  144.       FDecayCntAct    : integer;    { Total number of bins averaged so far}
  145.       FMaxDecayCount  : integer;    { Maximum value for the decay count   }
  146.       FDecayPtr       : integer;    { index for cur. averag. buffer location}
  148.       FFTLen          : integer;    { Number of points for FFT            }
  149.       FSampleRate     : Longint;    { A/D sampling rate                   }
  150.       FAmpScale       : Float;      { scaling factor for amplitude scaling}
  151.       FGainBass       : Float;      { gain factor for bass frequency light}
  152.       FGainMiddle     : Float;      { gain factor for middle freq. light  }
  153.       FGainTreble     : Float;      { gain factor for treble freq. light  }
  154.       FWindow         : TMMFFTWindow;{ selected window function           }
  155.       FEnabled        : Boolean;    { Enable or disable Light             }
  156.       FBits           : TMMBits;    { b8bit or b16bit                     }
  157.       FChannel        : TMMChannel; { chBoth, chLeft or chRigth           }
  158.       FMode           : TMMMode;    { mMono, mStereo or mQuadro           }
  159.       FBytes          : Longint;    { calculated data bytes p. Light}
  160.       FWidth          : integer;    { calculated width without border     }
  161.       FHeight         : integer;    { calculated height without border    }
  162.       FClientRect     : TRect;      { calculated beveled Rect             }
  163.       FPeakMode       : TMMLightPeakMode;
  164.       FKind           : TMMLightKind;
  165.       FArrange        : TMMLightArrange;
  166.       FTriangleDist   : Integer;
  167.       FSphereHorz     : Float;
  168.       FSphereVert     : Float;
  169.       FZoneCount      : Integer;
  171.       { Events }
  172.       FOnPcmOverflow  : TNotifyEvent;
  174.       procedure CreateDataBuffers(Length: Cardinal);
  175.       procedure FreeDataBuffers;
  176.       procedure CreateArrays(Size: Cardinal);
  177.       procedure FreeArrays;
  178.       procedure ResetDecayBuffers;
  179.       procedure ResetValues;
  180.       procedure InitializeData;
  181.       procedure SetBytesPerLight;
  182.       procedure SetupScale;
  183.       procedure CalcMagnitude(MagnitudeForm: Boolean);
  184.       procedure CalcDisplayValues;
  185.       procedure DrawLight;
  187.       procedure AdjustCtrlSize(var W, H: Integer);
  188.       procedure SetFFTLen(aLength: integer);
  189.       procedure SetDecayMode(aValue: TMMDecayMode);
  190.       procedure SetDecay(aValue: integer);
  191.       procedure SetWindow(aValue: TMMFFTWindow);
  192.       procedure SetAmpScale(index: integer; aValue: integer);
  193.       function  GetAmpScale(index: integer): integer;
  194.       procedure SetEnabled(aValue: Boolean);
  195.       procedure SetPCMWaveFormat(wf: TPCMWaveFormat);
  196.       function  GetPCMWaveFormat: TPCMWaveFormat;
  197.       procedure SetBits(aValue: TMMBits);
  198.       procedure SetChannel(aValue: TMMChannel);
  199.       procedure SetMode(aValue: TMMMode);
  200.       procedure SetSampleRate(aValue: Longint);
  201.       procedure SetPeakMode(aValue: TMMLightPeakMode);
  202.       procedure SetKind(aValue: TMMLightKind);
  203.       procedure SetArrange(aValue: TMMLightArrange);
  204.       procedure SetTriangleDist(Value: Integer);
  205.       procedure SetSphereHorz(Value: Float);
  206.       procedure SetSphereVert(Value: Float);
  207.       procedure SetZoneCount(Value: Integer);
  209.     protected
  210.       procedure Paint; override;
  211.       procedure Loaded; override;
  212.       procedure PcmOverflow; dynamic;
  213.       procedure Changed; override;
  215.       procedure InitDIB;
  216.       procedure DrawInitData;
  217.       procedure DrawCurrentData;
  218.       function  GetPalette: HPALETTE; override;
  220.     public
  221.       constructor Create(AOwner: TComponent); override;
  222.       destructor  Destroy; override;
  224.       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  226.       procedure RefreshPCMData(PCMData: Pointer);
  227.       procedure RefreshFFTData(FFTData: Pointer);
  228.       procedure RefreshMagnitudeData(MagData: Pointer);
  229.       procedure ResetData;
  231.       property  BytesPerLight: Longint read FBytes;
  232.       property  PCMWaveFormat: TPCMWaveFormat read GetPCMWaveFormat write SetPCMWaveFormat;
  234.     published
  235.       { Events }
  236.       property OnClick;
  237.       property OnDblClick;
  238.       property OnMouseDown;
  239.       property OnMouseMove;
  240.       property OnMouseUp;
  241.       property OnDragDrop;
  242.       property OnDragOver;
  243.       property OnEndDrag;
  244.       property OnStartDrag;
  245.       property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
  247.       property Align;
  248.       property Bevel;
  249.       property Color default defColor;
  250.       property ParentShowHint;
  251.       property ShowHint;
  252.       property Visible;
  253.       property PopupMenu;
  254.       property PaletteRealize default defRealize;
  255.       property PaletteMapped;
  257.       property Enabled: Boolean read FEnabled write SetEnabled default defEnabled;
  258.       property Height default defHeight;
  259.       property Width default defWidth;
  260.       property Mode: TMMMode read FMode write SetMode default defMode;
  261.       property BitLength: TMMBits read FBits write SetBits default defBitLength;
  262.       property Channel: TMMChannel read FChannel write SetChannel default defChannel;
  263.       property SampleRate: Longint read FSampleRate write SetSampleRate default defSampleRate;
  264.       property FFTLength: integer read FFTLen write SetFFTLen default defFFTLen;
  265.       property Window: TMMFFTWindow read FWindow write SetWindow default defWindow;
  266.       property DecayMode: TMMDecayMode read FDecayMode write SetDecayMode default defDecayMode;
  267.       property Decay: integer read FDecay write SetDecay default defDecay;
  269.       property AmplitudeScale: integer index 0 read GetAmpScale write SetAmpScale;
  270.       property GainBass: integer index 1 read GetAmpScale write SetAmpScale;
  271.       property GainMiddle: integer index 2 read GetAmpScale write SetAmpScale;
  272.       property GainTreble: integer index 3 read GetAmpScale write SetAmpScale;
  273.       property PeakMode: TMMLightPeakMode read FPeakMode write SetPeakMode default defPeakMode;
  274.       property Kind: TMMLightKind read FKind write SetKind default defKind;
  275.       property Arrange: TMMLightArrange read FArrange write SetArrange default defArrange;
  276.       property TriangleDist: Integer read FTriangleDist write SetTriangleDist default defTriangleDist;
  277.       property SphereHorz: Float read FSphereHorz write SetSphereHorz;
  278.       property SphereVert: Float read FSphereVert write SetSphereVert;
  279.       property ZoneCount: Integer read FZoneCount write SetZoneCount default defZoneCount;
  280.     end;
  282. implementation
  284. uses
  285.     Consts;
  287. const
  288.      NumLights = 3;
  289.      { Here we have the Center Frequencys from the different bands }
  290.      CenterFreq: array[0..NumLights-1] of integer = (150,750,1750);
  292. {-- TMMLight ------------------------------------------------------------}
  293. constructor TMMLight.Create(AOwner: TComponent);
  294. begin
  295.    inherited Create(AOwner);
  297.    CreateDataBuffers(MAX_FFTLEN);
  298.    CreateArrays(NumLights);
  300.    PaletteRealize := defRealize;
  302.    {$IFDEF WIN32}
  303.    FpFFT := InitRealFFT(8);
  304.    {$ELSE}
  305.    FFT := TMMFFT.Create;
  306.    {$ENDIF}
  308.    FFTLen := 8;
  309.    FDecay := defDecay;
  310.    FDecayMode := defDecayMode;
  312.    FDecayFactor := 0.0001;
  313.    FDecayCount := 1;
  314.    FDecayCntAct := 0;
  315.    FDecayPtr := 0;
  317.    FSampleRate := defSampleRate;
  318.    FChannel := defChannel;
  319.    FBits := defBitLength;
  320.    FMode := defMode;
  321.    FWindow := defWindow;
  323.    FAmpScale := 1.0;
  324.    FGainBass := 0.05;
  325.    FGainMiddle := 0.05;
  326.    FGainTreble := 0.05;
  328.    FEnabled := defEnabled;
  329.    FPeakMode := defPeakMode;
  330.    FKind := defKind;
  331.    FArrange := defArrange;
  333.    FTriangleDist := defTriangleDist;
  334.    FSphereHorz := defSphereHorz;
  335.    FSphereVert := defSphereVert;
  336.    FZoneCount := defZoneCount;
  337.    FFTLength := defFFTLen;
  339.    Color := defColor;
  341.    Height := defHeight;
  342.    Width := defWidth;
  344.    InitDIB;
  346.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  347.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  348. end;
  350. {-- TMMLight ------------------------------------------------------------}
  351. Destructor TMMLight.Destroy;
  352. begin
  353.    FreeDataBuffers;
  354.    FreeArrays;
  355.    {$IFDEF WIN32}
  356.    DoneRealFFT(FpFFT);
  357.    {$ELSE}
  358.    FFT.Free;
  359.    {$ENDIF}
  361.    inherited Destroy;
  362. end;
  364. {-- TMMLight ------------------------------------------------------------}
  365. procedure TMMLight.PcmOverflow;
  366. begin
  367.    if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
  368. end;
  370. {-- TMMLight ------------------------------------------------------------}
  371. procedure TMMLight.CreateDataBuffers(Length: Cardinal);
  372. begin
  373.    if (Length > 0) then
  374.    begin
  375.       FFFTData   := GlobalAllocMem(Length * sizeOf(SmallInt));
  376.       FWinBuf    := GlobalAllocMem(Length * sizeOf(Integer));
  377.       FDisplayVal:= GlobalAllocMem((Length div 2) * sizeOf(Long));
  378.       FLastVal   := GlobalAllocMem((Length div 2) * sizeOf(Long));
  379.       FLastVal_F := GlobalAllocMem((Length div 2) * sizeOf(Float));
  380.       FDataBuf   := GlobalAllocMem(MAXDECAYCOUNT * sizeOf(PLongArray));
  382.       {$IFDEF WIN32}
  383.       {$IFDEF TRIAL}
  384.       {$DEFINE _HACK1}
  385.       {$I MMHACK.INC}
  386.       {$ENDIF}
  387.       {$ENDIF}
  389.       FMaxDecayCount := 0;
  390.       while FMaxDecayCount < MAXDECAYCOUNT do
  391.       begin
  392.          FDataBuf^[FMaxDecayCount] := GlobalAllocMem((Length div 2) * sizeOf(Long));
  393.          if FDataBuf^[FMaxDecayCount] = nil then break;
  394.          inc(FMaxDecayCount);
  395.       end;
  396.       if (FMaxDecayCount < 1) then OutOfMemoryError;
  398.       FDecayCount := Min(FDecayCount, FMaxDecayCount);
  400.       { Clear out the memory buffers }
  401.       ResetDecayBuffers;
  402.    end;
  403. end;
  405. {-- TMMLight ------------------------------------------------------------}
  406. procedure TMMLight.FreeDataBuffers;
  407. var
  408.    i: integer;
  410. begin
  411.    GlobalFreeMem(Pointer(FFFTData));
  412.    GlobalFreeMem(Pointer(FWinBuf));
  413.    GlobalFreeMem(Pointer(FDisplayVal));
  414.    GlobalFreeMem(Pointer(FLastVal));
  415.    GlobalFreeMem(Pointer(FLastVal_F));
  417.    if FDataBuf <> nil then
  418.    begin
  419.       for i := 0 to FMaxDecayCount-1 do
  420.           if FDataBuf^[i] <> nil then GlobalFreeMem(Pointer(FDataBuf^[i]));
  421.       GlobalFreeMem(Pointer(FDataBuf));
  422.    end;
  423. end;
  425. {-- TMMLight ------------------------------------------------------------}
  426. procedure TMMLight.CreateArrays(Size: Cardinal);
  427. begin
  428.    if (Size > 0) then
  429.    begin
  430.       Fx1     := GlobalAllocMem(Size * sizeOf(Integer));
  431.       Fx2     := GlobalAllocMem(Size * sizeOf(Integer));
  432.       FValues := GlobalAllocMem(Size * sizeOf(TValues));
  433.    end;
  434. end;
  436. {-- TMMLight ------------------------------------------------------------}
  437. procedure TMMLight.FreeArrays;
  438. begin
  439.    GlobalFreeMem(Pointer(Fx1));
  440.    GlobalFreeMem(Pointer(Fx2));
  441.    GlobalFreeMem(Pointer(FValues));
  442. end;
  444. {-- TMMLight ------------------------------------------------------------}
  445. procedure TMMLight.ResetDecayBuffers;
  446. var
  447.    i, j: integer;
  449. begin
  450.    FDecayPtr := 0;
  451.    FDecayCntAct := 0; { Restart the count of number of samples taken }
  452.    FillChar(FLastVal^, (FFTLen div 2)*sizeOf(Long),0);
  453.    FillChar(FLastVal_F^, (FFTLen div 2)*sizeOf(Float),0);
  454.    for i := 0 to FMaxDecayCount-1 do
  455.        for j := 0 to (FFTLen div 2)-1 do FDataBuf^[i]^[j] := 0;
  456. end;
  458. {-- TMMLight ------------------------------------------------------------}
  459. procedure TMMLight.ResetValues;
  460. var
  461.    i: integer;
  462. begin
  463.    for i := 0 to NumLights-1 do
  464.    begin
  465.       FValues^[i].OldValue := -1;
  466.       FValues^[i].CurValue := 0;
  467.    end;
  468. end;
  470. {-- TMMLight ------------------------------------------------------------}
  471. procedure TMMLight.InitializeData;
  472. Var
  473.    i: integer;
  475. begin
  476.    if Enabled and (csDesigning in ComponentState) then
  477.    begin
  478.       Randomize;
  479.       for i := 0 to FFTLen div 2-1 do
  480.       begin                                         { create random data }
  481.          FDisplayVal^[i] := Long(Random(32767));
  482.       end;
  483.       ResetValues;
  484.    end
  485.    else
  486.    begin                                              { create zero data }
  487.       FillChar(FDisplayVal^[0], FFTLen div 2 * sizeOf(Long), 0);
  488.       FillChar(FFFTData^[0], FFTLen * sizeOf(SmallInt), 0);
  489.       ResetDecayBuffers;
  490.       ResetValues;
  491.    end;
  492. end;
  494. {-- TMMLight ------------------------------------------------------------}
  495. procedure TMMLight.ResetData;
  496. begin
  497.    InitializeData;
  498.    Refresh;
  499. end;
  501. {-- TMMLight ------------------------------------------------------------}
  502. procedure TMMLight.SetFFTLen(aLength: integer);
  503. var
  504.    Order: integer;
  506. begin
  507.    aLength := MinMax(aLength,8,MAX_FFTLEN);
  508.    { Convert FFTLen to a power of 2 }
  509.    Order := 0;
  510.    while aLength > 1 do
  511.    begin
  512.       aLength := aLength shr 1;
  513.       inc(Order);
  514.    end;
  515.    if (Order > 0) then aLength := aLength shl Order;
  517.    {$IFDEF WIN32}
  518.    {$IFDEF TRIAL}
  519.    {$DEFINE _HACK2}
  520.    {$I MMHACK.INC}
  521.    {$ENDIF}
  522.    {$ENDIF}
  524.    if (aLength <> FFTLen) then
  525.    begin
  526.       { re-init the FFTObject with the new FFT-length }
  527.       {$IFDEF WIN32}
  528.       DoneRealFFT(FpFFT);
  529.       FpFFT := InitRealFFT(Order);
  530.       FFTLen := aLength;
  531.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  532.       {$ELSE}
  533.       FFT.FFTLength := aLength;
  534.       FFTLen := aLength;
  535.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  536.       {$ENDIF}
  537.       { Re-initialize the display }
  538.       SetupScale;
  539.       SetBytesPerLight;
  541.       InitDIB;
  542.    end;
  543. end;
  545. {-- TMMLight ------------------------------------------------------------}
  546. procedure TMMLight.SetDecayMode(aValue: TMMDecayMode);
  547. begin
  548.    { Select averaging mode }
  549.    if (aValue <> FDecayMode) then
  550.    begin
  551.       FDecayMode := aValue;
  552.       { Re-initialize the buffers }
  553.       ResetDecayBuffers;
  554.    end;
  555.    {$IFDEF WIN32}
  556.    {$IFDEF TRIAL}
  557.    {$DEFINE _HACK2}
  558.    {$I MMHACK.INC}
  559.    {$ENDIF}
  560.    {$ENDIF}
  561. end;
  563. {-- TMMLight ------------------------------------------------------------}
  564. procedure TMMLight.SetDecay(aValue: integer);
  565. var
  566.    i: integer;
  568. begin
  569.    aValue := MinMax(aValue,1,16);
  570.    if (aValue <> FDecay) then
  571.    begin
  572.       FDecay := aValue;
  574.       { factor for stepUp and exponential averaging }
  575.       FDecayFactor := 0.0001;
  576.       for i := 0 to FDecay-1 do
  577.           FDecayFactor := sqrt(FDecayFactor);
  579.       { counter for uniform averaging }
  580.       FDecayCount := MinMax(2*(aValue-1),1,MaxDecayCount);
  582.       { Re-initialize the buffers for uniform averaging }
  583.       if (FDecayMode = dmUniform) then ResetDecayBuffers;
  584.    end;
  585. end;
  587. {-- TMMLight ------------------------------------------------------------}
  588. procedure TMMLight.SetWindow(aValue: TMMFFTWindow);
  589. begin
  590.    if (aValue <> FWindow) then
  591.    begin
  592.       FWindow := aValue;
  593.       GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
  594.    end;
  595. end;
  597. {-- TMMLight ------------------------------------------------------------}
  598. procedure TMMLight.SetSampleRate(aValue: Longint);
  599. begin
  600.    if (aValue <> FSampleRate) then
  601.    begin
  602.       FSampleRate := MinMax(aValue, 8000, 100000);
  603.       { Re-initialize the display }
  604.       SetupScale;
  606.       InitDIB;
  607.    end;
  608. end;
  610. {-- TMMLight ------------------------------------------------------------}
  611. procedure TMMLight.SetEnabled(aValue: Boolean);
  612. begin
  613.    if (aValue <> FEnabled) then
  614.    begin
  615.       FEnabled := aValue;
  616.       { inherited Enabled := Value }
  617.       InitDIB;
  618.    end;
  619. end;
  621. {-- TMMLight ------------------------------------------------------------}
  622. procedure TMMLight.SetKind(aValue: TMMLightKind);
  623. begin
  624.     if (aValue <> FKind) then
  625.     begin
  626.        FKind := aValue;
  627.        InitDIB;
  628.     end;
  629. end;
  631. {-- TMMLight ------------------------------------------------------------}
  632. procedure TMMLight.SetArrange(aValue: TMMLightArrange);
  633. begin
  634.    if (aValue <> FArrange) then
  635.    begin
  636.       FArrange := aValue;
  637.       InitDIB;
  638.    end;
  639. end;
  641. {-- TMMLight ------------------------------------------------------------}
  642. procedure TMMLight.SetTriangleDist(Value: Integer);
  643. begin
  644.    Value := MinMax(Value,2,MaxInt);
  645.    if (Value <> FTriangleDist) then
  646.    begin
  647.       FTriangleDist := Value;
  648.       InitDIB;
  649.    end;
  650. end;
  652. {-- TMMLight ------------------------------------------------------------}
  653. procedure TMMLight.SetSphereHorz(Value: Float);
  654. begin
  655.    Value := MaxR(Value,0);
  656.    if (Value <> FSphereHorz) then
  657.    begin
  658.       FSphereHorz := Value;
  659.       InitDIB;
  660.    end;
  661. end;
  663. {-- TMMLight ------------------------------------------------------------}
  664. procedure TMMLight.SetSphereVert(Value: Float);
  665. begin
  666.    Value := MaxR(Value,0);
  667.    if (Value <> FSphereVert) then
  668.    begin
  669.       FSphereVert := Value;
  670.       InitDIB;
  671.    end;
  672. end;
  674. {-- TMMLight ------------------------------------------------------------}
  675. procedure TMMLight.SetZoneCount(Value: Integer);
  676. begin
  677.    Value := MinMax(Value,1,MaxInt);
  678.    if (Value <> FZoneCount) then
  679.    begin
  680.       FZoneCount := Value;
  681.       InitDIB;
  682.    end;
  683. end;
  685. {-- TMMLight ------------------------------------------------------------}
  686. procedure TMMLight.SetPeakMode(aValue: TMMLightPeakMode);
  687. begin
  688.    if (aValue <> FPeakMode) then
  689.    begin
  690.       FPeakMode := aValue;
  691.       Refresh;
  692.    end;
  693. end;
  695. {-- TMMLight ------------------------------------------------------------}
  696. procedure TMMLight.Loaded;
  697. begin
  698.    inherited Loaded;
  700.    SetupScale;
  702.    InitDIB;
  703. end;
  705. {-- TMMLight ------------------------------------------------------------}
  706. procedure TMMLight.AdjustCtrlSize(var W, H: Integer);
  707. begin
  708.    W := Max(W,2*BevelExtend+5);
  709.    H := Max(H,2*BevelExtend+5);
  710. end;
  712. {-- TMMLight ------------------------------------------------------------}
  713. procedure TMMLight.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  714. var
  715.   W, H: Integer;
  717. begin
  718.    W := aWidth;
  719.    H := aHeight;
  720.    AdjustCtrlSize (W, H);
  721.    inherited SetBounds(aLeft, aTop, W, H);
  722.    Changed;
  723. end;
  725. {-- TMMLight ------------------------------------------------------------}
  726. procedure TMMLight.Changed;
  727. begin
  728.    FClientRect := BeveledRect;
  730.    { save the real height and width }
  731.    FWidth  := Max(FClientRect.Right - FClientRect.Left,4);
  732.    FHeight := Max(FClientRect.Bottom - FClientRect.Top,4);
  734.    DIBCanvas.SetBounds(0,0,FWidth,FHeight);
  736.    InitDIB;
  738.    inherited Changed;
  739. end;
  741. {-- TMMLight ------------------------------------------------------------}
  742. procedure TMMLight.SetBytesPerLight;
  743. begin
  744.    FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FFTLen;
  745. end;
  747. {-- TMMLight ------------------------------------------------------------}
  748. Procedure TMMLight.SetPCMWaveFormat(wf: TPCMWaveFormat);
  749. var
  750.    pwfx: PWaveFormatEx;
  752. begin
  753.    pwfx := @wf;
  754.    if not pcmIsValidFormat(pwfx) then
  755.       raise EMMLightError.Create(LoadResStr(IDS_INVALIDFORMAT));
  757.    SampleRate := pwfx^.nSamplesPerSec;
  758.    BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
  759.    Mode := TMMMode(pwfx^.nChannels-1);
  760. end;
  762. {-- TMMLight ------------------------------------------------------------}
  763. function TMMLight.GetPCMWaveFormat: TPCMWaveFormat;
  764. var
  765.    wfx: TWaveFormatEx;
  766. begin
  767.    pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
  768.    Result := PPCMWaveFormat(@wfx)^;
  769. end;
  771. {-- TMMLight ------------------------------------------------------------}
  772. Procedure TMMLight.SetBits(aValue: TMMBits);
  773. begin
  774.    if (aValue <> FBits) then
  775.    begin
  776.       FBits := aValue;
  777.       SetBytesPerLight;
  778.    end;
  779. end;
  781. {-- TMMLight ------------------------------------------------------------}
  782. Procedure TMMLight.SetChannel(aValue: TMMChannel);
  783. begin
  784.    if (aValue <> FChannel) then
  785.    begin
  786.       FChannel := aValue;
  787.       SetBytesPerLight;
  788.    end;
  789. end;
  791. {-- TMMLight ------------------------------------------------------------}
  792. Procedure TMMLight.SetMode(aValue: TMMMode);
  793. begin
  794.    if (aValue <> FMode) then
  795.    begin
  796.       FMode := aValue;
  797.       SetBytesPerLight;
  798.    end;
  799. end;
  801. {-- TMMLight ------------------------------------------------------------}
  802. procedure TMMLight.SetAmpScale(index: integer; aValue: integer);
  803. begin
  804.    { Change the amplitude scale factor }
  805.    aValue := MinMax(aValue, 0, 1000);
  806.    if (aValue = GetAmpScale(index)) then exit;
  808.    case index of
  809.       0: FAmpScale  := 0.01*aValue;
  810.       1: FGainBass  := 0.0005*aValue;
  811.       2: FGainMiddle:= 0.0005*aValue;
  812.       3: FGainTreble:= 0.0005*aValue;
  813.    end;
  815.    { Flush the buffers }
  816.    InitializeData;
  817. end;
  819. {-- TMMLight ------------------------------------------------------------}
  820. function TMMLight.GetAmpScale(index: integer): integer;
  821. begin
  822.    case index of
  823.       0: Result := Round(FAmpScale/0.01);
  824.       1: Result := Round(FGainBass/0.0005);
  825.       2: Result := Round(FGainMiddle/0.0005);
  826.       3: Result := Round(FGainTreble/0.0005);
  827.    else
  828.       Result := 0;
  829.    end;
  830. end;
  832. {-- TMMLight ------------------------------------------------------------}
  833. procedure TMMLight.SetupScale;
  834. var
  835.    i,ival: Longint;
  836.    StartFreq: array[0..NumLights-1] of Float;
  838. begin
  839.    if not (csLoading in ComponentState) then
  840.    begin
  841.       { Do RMS averaging into a fixed set of bins }
  842.       StartFreq[0] := 0;
  843.       for i := 1 to NumLights-1 do
  844.     StartFreq[i] := sqrt(Longint(CenterFreq[i])*CenterFreq[i-1]);
  846.       i := 0;
  847.       while i < NumLights do
  848.       begin
  849.       ival := MinMax(Round(StartFreq[i]/FSampleRate*FFTLen),0,FFTLen div 2);
  850.         Fx1^[i] := ival;
  851.         if (i > 0) then Fx2^[i-1] := ival;
  852.         inc(i);
  853.       end;
  854.       Fx2^[i-1] := FFTlen div 2-1;
  856.       { Compute the ending locations for lines holding multiple bins }
  857.       for i := 0 to NumLights-1 do
  858.           if (Fx2^[i] <= (Fx1^[i]+1)) then Fx2^[i] := 0;
  860.       { if lines are repeated on the screen, flag this so that we don't
  861.         have to recompute the y values. }
  862.       for i := NumLights-1 downTo 1 do
  863.       begin
  864.          if (Fx1^[i] = Fx1^[i-1]) then
  865.          begin
  866.            Fx1^[i] := -1;
  867.             Fx2^[i]:= 0;
  868.          end;
  869.       end;
  870.    end;
  871.    {$IFDEF WIN32}
  872.    {$IFDEF TRIAL}
  873.    {$DEFINE _HACK1}
  874.    {$I MMHACK.INC}
  875.    {$ENDIF}
  876.    {$ENDIF}
  877. end;
  879. {-- TMMLight ------------------------------------------------------------}
  880. procedure TMMLight.RefreshPCMData(PCMData: Pointer);
  881. var
  882.    Value: Longint;
  883.    i: Integer;
  884.    ReIndex: integer;
  885.    {$IFDEF WIN32}
  886.    fTemp: array[0..MAX_FFTLEN-1] of Float;
  887.    {$ELSE}
  888.    fTemp: array[0..MAX_FFTLEN-1] of Smallint;
  889.    {$ENDIF}
  891. begin
  892.    if FEnabled and Visible then
  893.    begin
  894.       ReIndex := Ord(FChannel)-1;
  896.       { perform windowing on sample Data from PCMData to FFFTData }
  897.       if (FBits = b8bit) then
  898.       begin
  899.          if (FMode = mMono) then
  900.          for i := 0 to FFTLen-1 do
  901.          begin
  902.             Value := PByteArray(PCMData)^[i];
  903.             if Value >= 255 then PcmOverflow;
  904.             fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  905.          end
  906.          else if (FChannel = chBoth) then
  907.          for i := 0 to FFTLen-1 do
  908.          begin
  909.             Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
  910.             if Value >= 255 then PcmOverflow;
  911.             fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  912.          end
  913.          else
  914.          for i := 0 to FFTLen-1 do
  915.          begin
  916.             Value := PByteArray(PCMData)^[i+i+ReIndex];
  917.             if Value >= 255 then PcmOverflow;
  918.             fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
  919.          end;
  920.       end
  921.       else
  922.       begin
  923.          if (FMode = mMono) then
  924.          for i := 0 to FFTLen-1 do
  925.          begin
  926.             Value := PSmallArray(PCMData)^[i];
  927.             if Value >= 32767 then PcmOverflow;
  928.             fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  929.          end
  930.          else if (FChannel = chBoth) then
  931.          for i := 0 to FFTLen-1 do
  932.          begin
  933.             Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
  934.             if Value >= 32766 then PcmOverflow;
  935.             fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  936.          end
  937.          else
  938.          for i := 0 to FFTLen-1 do
  939.          begin
  940.             Value := PSmallArray(PCMData)^[i+i+ReIndex];
  941.             if Value >= 32767 then PcmOverflow;
  942.             fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
  943.          end;
  944.       end;
  946.       { calc the FFT }
  947.       {$IFDEF WIN32}
  948.       DoRealFFT(FpFFT,@fTemp, 1);
  949.       for i := 0 to FFTLen-1 do FFFTData^[i] := Trunc(fTemp[i]/(FFTLen div 2));
  950.       {$ELSE}
  951.       for i := 0 to FFTLen-1 do FFFTData^[i] := fTemp[i];
  952.       FFT.CalcFFT(Pointer(FFFTData));
  953.       {$ENDIF}
  955.       { calc the magnitude }
  956.       CalcMagnitude(False);
  957.       { next, put this data up on the display }
  958.       DrawLight;
  959.    end;
  960. end;
  962. {-- TMMLight ------------------------------------------------------------}
  963. procedure TMMLight.RefreshFFTData(FFTData: Pointer);
  964. begin
  965.    Move(PByte(FFTData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
  966.    { calc the magnitude }
  967.    CalcMagnitude(False);
  968.    { next, put this data up on the display }
  969.    DrawLight;
  970. end;
  972. {-- TMMLight ------------------------------------------------------------}
  973. procedure TMMLight.RefreshMagnitudeData(MagData: Pointer);
  974. begin
  975.    Move(PByte(MagData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
  976.    { calc display values }
  977.    CalcMagnitude(True);
  978.    { next, put this data up on the display }
  979.    DrawLight;
  980. end;
  982. {-- TMMLight ------------------------------------------------------------}
  983. procedure TMMLight.CalcMagnitude(MagnitudeForm: Boolean);
  984. var
  985.    i: integer;
  986.    re,im: Long;
  987.    a2,Root: Long;{ Variables for computing Sqrt/Log of Amplitude^2 }
  989. begin
  990.    { go through the data set and convert it to magnitude form }
  991.    inc(FDecayPtr);
  992.    inc(FDecayCntAct);
  994.    if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;
  996.    if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;
  998.    for i := 0 to (FFTLen div 2)-1 do
  999.    begin
  1000.       if MagnitudeForm then
  1001.       begin
  1002.          a2 := PLongArray(FFFTData)^[i];
  1003.       end
  1004.       else
  1005.       begin
  1006.          { Compute the magnitude }
  1007.          {$IFDEF WIN32}
  1008.          re := FFFTData^[i+i];
  1009.          im := FFFTData^[i+i+1];
  1010.          {$ELSE}
  1011.          re := FFFTData^[FFT.BitReversed^[i]];
  1012.          im := FFFTData^[FFT.BitReversed^[i]+1];
  1013.          {$ENDIF}
  1014.          a2 := re*re+im*im;
  1015.       end;
  1017.       { Watch for possible overflow }
  1018.       if (a2 < 0) then a2 := 0;
  1020.       Root := Trunc(FAmpScale*sqrt(a2));
  1022.       { In decay mode, need to average this value }
  1023.       case Ord(FDecayMode) of
  1024.          1: begin
  1025.                FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor;
  1026.                if (Root >= FLastVal_F^[i]) then FLastVal_F^[i] := Root
  1027.                else Root := Trunc(FLastVal_F^[i]);
  1028.             end;
  1029.          2: begin
  1030.        FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor+(1-FDecayFactor)*Root;
  1031.        Root := Floor(FLastVal_F^[i]);
  1032.             end;
  1033.          3: begin
  1034.                FLastVal^[i] := FLastVal^[i] + (Root-FDataBuf^[FDecayPtr]^[i]);
  1035.                FDataBuf^[FDecayPtr]^[i] := Root;
  1036.                Root := FLastVal^[i] div FDecayCntAct;
  1037.             end;
  1038.       end;
  1039.       FDisplayVal^[i] := Root;
  1040.    end;
  1041. end;
  1043. {-- TMMLight ------------------------------------------------------------}
  1044. procedure TMMLight.CalcDisplayValues;
  1045. var
  1046.    i, j, k, index: integer;
  1047.    dv,val: Longint;
  1048.    valf: Float;
  1050. begin
  1051.    dv := 0;
  1052.    j := 0;
  1053.    i := 0;
  1054.    while i < NumLights do
  1055.    begin
  1056.       { If this line is the same as the previous one, just use the previous
  1057.         Y value. Else go ahead and compute the value. }
  1058.       index := Fx1^[i];
  1059.       if (index >= 0) then
  1060.       begin
  1061.          if i > 0 then
  1062.          begin
  1063.             FValues^[j].CurValue := dv;
  1064.             { now the next }
  1065.             inc(j);
  1066.          end;
  1068.          k := 1;
  1069.          dv := FDisplayVal^[index];
  1070.          valf := dv;
  1072.          if (Fx2^[i] > 0) then
  1073.          begin
  1074.             while (index < Fx2^[i]) do
  1075.             begin
  1076.                { We have three ways here }
  1077.                case FPeakMode of
  1078.                  { build the RMS value of the set of bins }
  1079.                  pmRMS:
  1080.                  begin
  1081.                     val := FDisplayVal^[index];
  1082.                     valf := valf + (val+0.1)*val;
  1083.                  end;
  1084.                  { search the higest bin }
  1085.                  pmPeak:
  1086.                  begin
  1087.                     if FDisplayVal^[index] > dv then
  1088.                        dv := FDisplayVal^[index];
  1089.                  end;
  1090.                  { average the bins }
  1091.                  pmAverage:
  1092.                  begin
  1093.                     dv := dv + FDisplayVal^[index];
  1094.                     inc(k);
  1095.                  end;
  1096.                end;
  1097.                inc(index);
  1098.             end;
  1100.             case FPeakMode of
  1101.               pmRMS    : dv := Trunc(sqrt(valf/Max(index-Fx1^[i],1)));
  1102.               pmPeak   :;
  1103.               pmAverage: dv := dv div k;
  1104.             end;
  1105.          end;
  1106.       end;
  1107.       inc(i);
  1108.    end;
  1109.    { store the last value }
  1110.    FValues^[j].CurValue := dv;
  1111. end;
  1113. {-- TMMLight ------------------------------------------------------------}
  1114. procedure TMMLight.InitDIB;
  1115. begin
  1116.    if (csLoading in ComponentState) then Exit;
  1118.    if Kind = lkCircle then
  1119.       DIBCanvas.AnimatedColorCount := NumLights
  1120.    else
  1121.       DIBCanvas.AnimatedColorCount := NumLights * ZoneCount;
  1123.    DIBCanvas.DIB_InitDrawing;
  1124.                                                       { clear background }
  1125.    DIBCanvas.DIB_SetTColor(Color);
  1126.    DIBCanvas.DIB_Clear;
  1128.    { Flush the buffers }
  1129.    InitializeData;
  1131.    DrawInitData;
  1133.    DIBCanvas.DIB_DoneDrawing;
  1135.    Invalidate;
  1136. end;
  1138. {-- TMMLight ------------------------------------------------------------}
  1139. procedure TMMLight.DrawInitData;
  1140. var
  1141.     i       : Integer;
  1142.     j       : Integer;
  1143.     AWidth  : Integer;
  1144.     AHeight : Integer;
  1145.     ERect   : TRect;
  1146.     R       : TRect;
  1147.     Delta   : Integer;
  1148.     Radius  : Integer;
  1149.     Vert    : Boolean;
  1151.     procedure DrawCircle(X,Y,W,H: Integer; Color: Integer);
  1152.     begin
  1153.        with DIBCanvas do
  1154.        begin
  1155.           DIB_SetColor(AnimatedColorIndex[Color]);
  1156.           DIB_FillEllipse(X+W div 2,Y + H div 2,W div 2,H div 2);
  1157.        end;
  1158.     end;
  1160.     procedure DrawZone(X,Y,W,H: Integer; Zone: Integer; Color: Integer);
  1161.     var
  1162.        HDelta, VDelta: Integer;
  1163.     begin
  1164.         HDelta := Trunc(Zone * ((W/ZoneCount)/2));
  1165.         VDelta := Trunc(Zone * ((H/ZoneCount)/2));
  1167.         with DIBCanvas do
  1168.         begin
  1169.            DIB_SetColor(AnimatedColorIndex[Color]);
  1170.            DIB_FillEllipse(X+W div 2,Y+H div 2,(W-HDelta*2) div 2,(H-VDelta*2) div 2);
  1171.         end;
  1172.     end;
  1174.     function EllipseRect(i: Integer ): TRect;
  1175.     var
  1176.         X, Y: Integer;
  1177.     begin
  1178.        if Arrange = laLine then
  1179.           if Vert then
  1180.             Result := Bounds(ERect.Left + Delta, ERect.Top + i*2*Radius + (2*i+1)* Delta, 2*Radius, 2*Radius)
  1181.           else
  1182.             Result := Bounds(ERect.Left + i*2*Radius + (2*i+1)* Delta, ERect.Top + Delta, 2*Radius, 2*Radius)
  1183.        else
  1184.        begin
  1185.           case i of
  1186.              0 : begin X := AWidth div 2 - Radius - Delta; Y := Radius + Delta; end;
  1187.              1 : begin X := AWidth div 2; Y := AHeight - Delta - Radius; end;
  1188.              2 : begin X := AWidth div 2 + Radius + Delta; Y := Radius + Delta; end;
  1189.            else
  1190.               Exit; {???}
  1191.           end;
  1192.           Result := Bounds(X+ERect.Left-Radius,Y+ERect.Top-Radius,2*Radius,2*Radius);
  1193.        end;
  1194.     end;
  1196. begin
  1197.     AWidth  := (FClientRect.Right-FClientRect.Left);
  1198.     AHeight := (FClientRect.Bottom-FClientRect.Top);
  1199.     Delta   := TriangleDist div 2;
  1201.     if Arrange = laLine then
  1202.     begin
  1203.        Vert    := False;
  1204.        if AHeight > AWidth then
  1205.        begin
  1206.           Vert := True;
  1207.           if (AHeight div NumLights) > AWidth then
  1208.               AHeight := AWidth * NumLights
  1209.           else
  1210.               AWidth := AHeight div NumLights;
  1212.           Radius := ((AHeight div NumLights)) div 2 - Delta;
  1213.        end
  1214.        else
  1215.        begin
  1216.           if (AWidth div NumLights) > AHeight then
  1217.               AWidth := AHeight * NumLights
  1218.           else
  1219.               AHeight := AWidth div NumLights;
  1221.           Radius := ((AWidth div NumLights)) div 2 - Delta;
  1222.        end;
  1223.     end
  1224.     else
  1225.     begin
  1226.        if (AWidth > AHeight) then
  1227.           AWidth := AHeight;
  1229.        Radius  := (AWidth - 4 * Delta) div 4;
  1230.        AWidth  := 4*(Radius+Delta);
  1231.        AHeight := Trunc((2+Sqrt(3))*(Radius+Delta));
  1232.     end;
  1234.     if Radius <= 0 then Exit;
  1236.     ERect := Bounds(((FClientRect.Right-FClientRect.Left)-AWidth) div 2,
  1237.                     ((FClientRect.Bottom-FClientRect.Top)-AHeight) div 2,
  1238.                     AWidth, AHeight);
  1240.     if (Kind = lkCircle) then
  1241.     begin
  1242.        for i := 0 to NumLights-1 do
  1243.        begin
  1244.           R := EllipseRect(i);
  1245.           DrawCircle(R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,i);
  1246.        end;
  1247.     end
  1248.     else
  1249.     begin
  1250.        for i := 0 to NumLights-1 do
  1251.        begin
  1252.           R := EllipseRect(i);
  1253.           for j := 0 to ZoneCount - 1 do
  1254.               DrawZone(R.Left,R.Top,R.Right-R.Left,
  1255.                        R.Bottom-R.Top,j,i*ZoneCount+j);
  1256.        end;
  1257.     end;
  1258. end;
  1260. {-- TMMLight ------------------------------------------------------------}
  1261. procedure TMMLight.DrawCurrentData;
  1262. var
  1263.     i       : integer;
  1264.     j       : integer;
  1265.     Value   : Integer;
  1267.     function RGBColor(Index: Integer; Value: Integer): TColor;
  1268.     begin
  1269.        Result := 0;
  1270.        case i of
  1271.           0 : Result := RGB(Value,0,0);
  1272.           1 : Result := RGB(0,Value,0);
  1273.           2 : Result := RGB(Value,Value,0);
  1274.        end;
  1275.     end;
  1277.     function LightColor(i: Integer; Value: Integer): TColor;
  1278.     begin
  1279.        Result:= RGBColor(i,Value);
  1280.     end;
  1282.     function ZoneColor(i: Integer; Zone: Integer; Value: Integer): TColor;
  1283.     var
  1284.        X, Y: Integer;
  1285.        ZoneUpper: Integer;
  1286.     begin
  1287.        X  := (ZoneCount - Zone - 1);
  1288.        if X > ZoneCount*SphereHorz then
  1289.           X := Trunc(ZoneCount*SphereHorz);
  1290.        if (SphereHorz = 0) or (SphereVert = 0) then
  1291.           Value := 0
  1292.        else
  1293.        begin
  1294.           Y        := Trunc(Sqrt(Sqr(ZoneCount)-Sqr(X/SphereHorz))*SphereVert);
  1295.           ZoneUpper:= Trunc((Y/(ZoneCount*SphereVert))*255);
  1296.           Value    := Trunc((Value/255)*ZoneUpper);
  1297.        end;
  1298.        Result := RGBColor(i,Value);
  1299.     end;
  1300. begin
  1301.    CalcDisplayValues;
  1303.    DIBCanvas.BeginAnimate;
  1304.    try
  1305.       for i := 0 to NumLights - 1 do
  1306.       begin
  1307.          case i of
  1308.               0: Value := Trunc(FValues^[i].CurValue * (FGainBass));
  1309.               1: Value := Trunc(FValues^[i].CurValue * (2*FGainMiddle));
  1310.               2: Value := Trunc(FValues^[i].CurValue * (4*FGainTreble));
  1311.            else  Value := 0;
  1312.          end;
  1314.          Value := MinMax(Value,0,255);
  1316.          if (Value <> FValues^[i].OldValue) then
  1317.          begin
  1318.             FValues^[i].OldValue := Value;
  1320.             with DIBCanvas do
  1321.             if Kind = lkCircle then
  1322.                AnimatedColorValue[i] := LightColor(i,Value)
  1323.             else
  1324.                for j := 0 to ZoneCount - 1 do
  1325.                AnimatedColorValue[ZoneCount*i+j] := ZoneColor(i,j,Value);
  1326.          end;
  1327.       end;
  1329.    finally
  1330.       DIBCanvas.EndAnimate;
  1331.    end;
  1332. end;
  1334. {-- TMMLight ------------------------------------------------------------}
  1335. function TMMLight.GetPalette: HPALETTE;
  1336. begin
  1337.    Result := DIBCanvas.Palette;
  1338. end;
  1340. {-- TMMLight ------------------------------------------------------------}
  1341. procedure TMMLight.DrawLight;
  1342. begin
  1343.    SelectPalette(Canvas.Handle,DIBCanvas.Palette,True);
  1344.    DrawCurrentData;
  1345.    DIBCanvas.DIB_BitBlt(Canvas.Handle, FClientRect,0,0);
  1346. end;
  1348. {-- TMMLight ------------------------------------------------------------}
  1349. Procedure TMMLight.Paint;
  1350. begin
  1351.    { draw the Bevel }
  1352.    Bevel.PaintBevel(Canvas, ClientRect,True);
  1354.    DrawLight;
  1356.    {$IFDEF BUILD_ACTIVEX}
  1357.    if Selected then
  1358.    begin
  1359.       Canvas.Brush.Style := bsClear;
  1360.       Canvas.Pen.Color   := clRed;
  1361.       Canvas.Rectangle(0,0,Width,Height);
  1362.       Canvas.Brush.Style := bsSolid;
  1363.    end;
  1364.    {$ENDIF}
  1365. end;
  1367. end.