Delphi控件源码

开发平台：
Delphi

MMMixBlk.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMMixBlk;
{$I COMPILER.INC}
{.$DEFINE _MMDEBUG}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    Forms,
    Messages,
    Stdctrls,
    ExtCtrls,
    SysUtils,
    Controls,
    Classes,
    Graphics,
    MMObj,
    MMObsrv,
    MMUtils,
    MMScale,
    MMLevel,
    MMSlider,
{$IFDEF BUILD_ACTIVEX}
    AxCtrlsUtil,
{$ENDIF}
    MMMixer,
    MMMixCtl;
const
    MM_SETPARENT = MM_USER + 1;
type
    TMMSetParentAction = (saInsert,saInsNoRole,saRemove,saUpdate);
    TMMSetParent = record
        Msg      : Cardinal;
        Action   : Cardinal;
        Control  : TControl;
        Result   : LongInt;
    end;
type
    TMMBlockSliderStyle  = (ssWin95);
    TMMBlockSliderRole   = (srPan,srLeftVolume,srRightVolume);
    {-- TMMCustomBlockSlider -----------------------------------------------}
    TMMCustomBlockSlider = class(TMMCustomMixerSlider)
    private
        FStyle  : TMMBlockSliderStyle;
        FRole   : TMMBlockSliderRole;
        FIsRole : Boolean;
        procedure SetStyle(Value: TMMBlockSliderStyle);
        procedure SetRole(Value: TMMBlockSliderRole);
    protected
        procedure SetParent(Value: TWinControl); override;
        procedure UpdateStyle; virtual;
{$IFDEF BUILD_ACTIVEX}
        procedure MMParentWindowChanged(var M: TMessage); message MM_PARENTWINDOWCHANGED;
        procedure ChangeDesigning(Value: Boolean); override;
{$ENDIF}
    public
        constructor Create(AOwner: TComponent); override;
    protected
        property Style: TMMBlockSliderStyle read FStyle write SetStyle default ssWin95;
        property Role: TMMBlockSliderRole read FRole write SetRole default srPan;
        property GrooveSize nodefault;
        property ScalePosition nodefault;
        property Logarithmic nodefault;
    end;
    {-- TMMMixerBlockSlider ---------------------------------------------}
    TMMMixerBlockSlider = class(TMMCustomBlockSlider)
    published
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnChange;
        property OnTrack;
        property OnTrackEnd;
        property OnDrawThumb;
        property OnDrawGroove;
        property Style;
        property Role;
        property Logarithmic;
        property Sensitivity;
        property Enabled;
        property Visible;
        property Color;
        property ParentShowHint;
        property PopupMenu;
        property ShowHint;
        property TabStop;
        property TabOrder;
        property Width;
        property Height;
        property Bevel;
        property Groove;
        property FocusAction;
        property FocusColor;
        property GrooveColor;
        property ThumbColor;
        property DisabledColor;
        property HandCursor;
        property Orientation;
        property GrooveSize;
        property ThumbWidth;
        property ThumbHeight;
        property ThumbStyle;
        property Scale;
        property ScalePosition;
        property ScaleDistance;
        property PicLeft;
        property PicRight;
        property Position;
    end;
    TMMBlockLevelStyle  = (lsWin95);
    TMMBlockLevelRole   = (lrLeftLevel,lrRightLevel);
    {-- TMMCustomBlockLevel ------------------------------------------------}
    TMMCustomBlockLevel = class(TMMCustomLevel)
    private
        FStyle  : TMMBlockLevelStyle;
        FRole   : TMMBlockLevelRole;
        FIsRole : Boolean;
        procedure SetStyle(Value: TMMBlockLevelStyle);
        procedure SetRole(Value: TMMBlockLevelRole);
    protected
        procedure UpdateStyle; virtual;
        procedure SetParent(Value: TWinControl); override;
{$IFDEF BUILD_ACTIVEX}
        procedure MMParentWindowChanged(var M: TMessage); message MM_PARENTWINDOWCHANGED;
        procedure ChangeDesigning(Value: Boolean); override;
{$ENDIF}
    public
        constructor Create(AOwner: TComponent); override;
    protected
        property Style: TMMBlockLevelStyle read FStyle write SetStyle default lsWin95;
        property Role: TMMBlockLevelRole read FRole write SetRole default lrLeftLevel;
        property Color nodefault;
        property SpotWidth nodefault;
        property Bar1Color nodefault;
        property Bar2Color nodefault;
        property Bar3Color nodefault;
        property Inactive1Color nodefault;
        property Inactive2Color nodefault;
        property Inactive3Color nodefault;
        property Point1 nodefault;
        property Point2 nodefault;
        property LogAmp nodefault;
        property NumPeaks nodefault;
    end;
    {-- TMMMixerBlockLevel ----------------------------------------------}
    TMMMixerBlockLevel = class(TMMCustomBlockLevel)
    published
        property OnClick;
        property OnDblClick;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnGainOverflow;
        property OnPcmOverflow;
        property Style;
        property Role;
        property Align;
        property Bevel;
        property ParentShowHint;
        property ParentColor;
        property ShowHint;
        property Visible;
        property Color;
        property Enabled;
        property Kind;
        property Height;
        property Width;
        property SpotSpace;
        property SpotWidth;
        property Bar1Color;
        property Bar2Color;
        property Bar3Color;
        property Inactive1Color;
        property Inactive2Color;
        property Inactive3Color;
        property InactiveDoted;
        property ActiveDoted;
        property Point1;
        property Point2;
        property Direction;
        property BitLength;
        property Channel;
        property Mode;
        property Gain;
        property Samples;
        property Sensitivy;
        property LogAmp;
        property NumPeaks;
        property PeakSpeed;
        property PeakDelay;
        property DecayMode;
        property Decay;
        property Value;
    end;
    {-- TMMCustomBlockCheck ----------------------------------------------}
    TMMCustomBlockCheck = class(TMMCustomMixerCheckBox)
    protected
        procedure SetParent(Value: TWinControl); override;
{$IFDEF BUILD_ACTIVEX}
        procedure MMParentWindowChanged(var M: TMessage); message MM_PARENTWINDOWCHANGED;
        procedure MMDesignModeChanged(var M: TMessage); message MM_DESIGNMODECHANGED;
    public
        constructor Create(AOwner: TComponent); override;
{$ENDIF}
    end;
    {-- TMMMixerBlockCheck -----------------------------------------------}
    TMMMixerBlockCheck = class(TMMCustomBlockCheck)
    published
        property OnDragDrop;
        property OnDragOver;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDrag;
        property AutoCaption;
        property Short;
        property Enabled;
        property Checked;
        property Caption;
        property Alignment;
        property Color;
        property Ctl3D;
        property DragCursor;
        property DragMode;
        property Font;
        property ParentColor;
        property ParentCtl3D;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
    end;
    TMMBlockLabelRole   = (lrLineTitle,lrPanTitle,lrVolumeTitle);
    {-- TMMCustomMixerLabel ----------------------------------------------}
{$IFNDEF BUILD_ACTIVEX}
    TMMCustomBlockLabel = class(TCustomLabel)
{$ELSE}
    TMMCustomBlockLabel = class(TStaticText)
{$ENDIF}
    private
        FRole  : TMMBlockLabelRole;
        FIsRole: Boolean;
        procedure SetRole(Value: TMMBlockLabelRole);
    protected
        procedure SetParent(Value: TWinControl); override;
{$IFDEF BUILD_ACTIVEX}
        procedure MMParentWindowChanged(var M: TMessage); message MM_PARENTWINDOWCHANGED;
        procedure MMDesignModeChanged(var M: TMessage); message MM_DESIGNMODECHANGED;
    public
        constructor Create(AOwner: TComponent); override;
{$ENDIF}
    protected
        property Role: TMMBlockLabelRole read FRole write SetRole default lrLineTitle;
    end;
    {-- TMMMixerBlockLabel ----------------------------------------------}
    TMMMixerBlockLabel = class(TMMCustomBlockLabel)
    published
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDrag;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDrag;
        property Role;
        property Align;
        property Alignment;
        property AutoSize;
        property Caption;
        property Color;
        property DragCursor;
        property DragMode;
        property Enabled;
        property FocusControl;
        property Font;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ShowAccelChar;
        property ShowHint;
        property Visible;
{$IFNDEF BUILD_ACTIVEX}
        property Transparent;
        property WordWrap;
{$ENDIF}
    end;
    EMMBlockError = class(Exception);
    TMMBlockStyle = (bsWin95);
    TMMMuteKind   = (mkMute,mkSelect);
    {-- TMMCustomMixerBlock ------------------------------------------------}
    TMMCustomMixerBlock = class(TMMCustomPanel)
    private
        FAutoArrange: Boolean;
        FAutoSize   : Boolean;
        FPan        : TMMCustomBlockSlider;
        FMute       : TMMCustomBlockCheck;
        FVolumeLeft : TMMCustomBlockSlider;
        FVolumeRight: TMMCustomBlockSlider;
        FLevelLeft  : TMMCustomBlockLevel;
        FLevelRight : TMMCustomBlockLevel;
        FLineTitle  : TMMCustomBlockLabel;
        FPanTitle   : TMMCustomBlockLabel;
        FVolumeTitle: TMMCustomBlockLabel;
        FPanCtl     : TMMPanControl;
        FVolumeCtl  : TMMVolumeControl;
        FMuteCtl    : TMMMixerControl;
        FConnector  : TMMMixerConnector;
        FPeakCtl    : TMMMixerControl;
        FLine       : TMMAudioLine;
        FObserver   : TMMObserver;
        FMixer      : TMMCustomMixerControl;
        FItem       : TMMItemIndex;
        FMixObserver: TMMObserver;
        FStyle      : TMMBlockStyle;
        FRemoving   : TControl;
        FKDummy     : TMMMuteKind;
        procedure SetLine(Value: TMMAudioLine);
        procedure LineNotify(Sender, Data : TObject);
        procedure SetAutoArrange(Value: Boolean);
        procedure SetAutoSize(Value: Boolean);
        procedure SetStyle(Value: TMMBlockStyle);
        procedure SetMixer(Value: TMMCustomMixerControl);
        procedure MixNotify(Sender, Data: TObject);
        procedure SetItem(Value: TMMItemIndex);
    protected
        procedure UpdateBlock; virtual;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure InsertCtl(C: TComponent); virtual;
        procedure Loaded; override;
        procedure ArrangeControls; virtual;
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
        procedure ConnectLine;
        procedure DisconnectLine;
        procedure ConnectControls;
        procedure MMSetParent(var Msg: TMMSetParent); message MM_SETPARENT;
        procedure CollectControls;
{$IFDEF BUILD_ACTIVEX}
        procedure ChangeDesigning(Value: Boolean); override;
{$ENDIF}
    public
        constructor Create(AOwner: TComponent); override;
        destructor  Destroy; override;
        function GetMuteKind: TMMMuteKind;
        property Pan: TMMCustomBlockSlider read FPan;
        property Mute: TMMCustomBlockCheck read FMute;
        property VolumeLeft: TMMCustomBlockSlider read FVolumeLeft;
        property VolumeRight: TMMCustomBlockSlider read FVolumeRight;
        property LevelLeft: TMMCustomBlockLevel read FLevelLeft;
        property LevelRight: TMMCustomBlockLevel read FLevelRight;
        property LineTitle: TMMCustomBlockLabel read FLineTitle;
        property PanTitle: TMMCustomBlockLabel read FPanTitle;
        property VolumeTitle: TMMCustomBlockLabel read FVolumeTitle;
    protected
        property Line: TMMAudioLine read FLine write SetLine;
        property AutoArrange : Boolean read FAutoArrange write SetAutoArrange default True;
        property AutoSize : Boolean read FAutoSize write SetAutoSize default True;
        property Style: TMMBlockStyle read FStyle write SetStyle default bsWin95;
        property Mixer: TMMCustomMixerControl read FMixer write SetMixer;
        property Item: TMMItemIndex read FItem write SetItem default NoItem;
        property MuteKind: TMMMuteKind read GetMuteKind write FKDummy stored False;
    end;
    {-- TMMMixerBlock ------------------------------------------------------}
    TMMMixerBlock = class(TMMCustomMixerBlock)
    published
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        {$IFDEF WIN32}
        property OnStartDrag;
        {$ENDIF}
        property Align;
        property Bevel;
        property DragCursor;
        property DragMode;
        property Enabled;
        property Color;
        property Ctl3D;
        property Font;
        property ParentColor;
        property ParentCtl3D;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;
        property Line;
        property AutoArrange;
        property AutoSize;
        property Style;
        property Mixer;
        property Item;
        property MuteKind;
    end;
implementation
const
    SpkLeftBmp  = 'SPK_LEFT';
    SpkRightBmp = 'SPK_RIGHT';
{$IFDEF DELPHI2}
const
{$ELSE}
resourcestring
{$ENDIF}
  SIncorrectyUsed = 'This controls can be used only with MixerBlock';
{$IFDEF WIN32}
    {$R MMMIXBLK.D32}
{$ELSE}
    {$R MMMIXBLK.D16}
{$ENDIF}
{-----------------------------------------------------------------------}
function  FindBlock(C: TControl): TMMCustomMixerBlock;
var
   Ctl: TControl;
begin
   Ctl := C;
   while (Ctl <> nil) and not (Ctl is TMMCustomMixerBlock) do
          Ctl := Ctl.Parent;
   Result := Ctl as TMMCustomMixerBlock;
end;
{-----------------------------------------------------------------------}
procedure PostChange(C: TControl; Action: TMMSetParentAction);
var
   Block: TControl;
begin
   Block := FindBlock(C);
   if Block <> nil then
      Block.Perform(MM_SETPARENT,Cardinal(Action),Cardinal(C));
end;
{-----------------------------------------------------------------------}
procedure CheckParent(Value: TWinControl);
begin
   if Value <> nil then
      if FindBlock(Value) = nil then
         { TODO: Should be resource id }
         raise EMMBlockError.Create(SIncorrectyUsed);
end;
{$IFDEF BUILD_ACTIVEX}
{-----------------------------------------------------------------------}
function FindBlockByHandle(Handle, TopHandle: HWND): TMMCustomMixerBlock;
begin
  if (Handle <> 0) and (Handle <> -1) then
  begin
    repeat
      Result := TMMCustomMixerBlock(MMActiveXControls.DelphiControlByHandle(
        Handle));
      if (Result <> nil) and (Result is TMMCustomMixerBlock) then
        exit;
      if Handle = TopHandle then
        break;
      Handle := GetParent(Handle);
    until Handle = 0;
  end;
  Result := nil;
end;
{-----------------------------------------------------------------------}
procedure CheckCorrectUsage(Control: TWinControl);
begin
  with Control do
    if (csDesigning in ComponentState) and
       (not MMActiveXControls.ControlsByDelphiControl[Control].IsParked) and
       (not Assigned(FindBlockByHandle(ParentWindow, 0))) then
      raise EMMBlockError.Create(SIncorrectyUsed);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockSlider.MMParentWindowChanged(var M: TMessage);
begin
  SetParent(FindBlockByHandle(M.LParam, M.WParam));
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockCheck.MMParentWindowChanged(var M: TMessage);
begin
  SetParent(FindBlockByHandle(M.LParam, M.WParam));
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockLevel.MMParentWindowChanged(var M: TMessage);
begin
  SetParent(FindBlockByHandle(M.LParam, M.WParam));
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockLabel.MMParentWindowChanged(var M: TMessage);
begin
  SetParent(FindBlockByHandle(M.LParam, M.WParam));
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
constructor TMMCustomBlockCheck.Create(AOwner: TComponent);
begin
  inherited;
  SetDesigning(True);
end;
{-----------------------------------------------------------------------}
constructor TMMCustomBlockLabel.Create(AOwner: TComponent);
begin
  inherited;
  SetDesigning(True);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockSlider.ChangeDesigning(Value: Boolean);
begin
  inherited;
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockLevel.ChangeDesigning(Value: Boolean);
begin
  inherited;
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockCheck.MMDesignModeChanged(var M: TMessage);
begin
  CheckCorrectUsage(Self);
end;
{-----------------------------------------------------------------------}
procedure TMMCustomBlockLabel.MMDesignModeChanged(var M: TMessage);
begin
  CheckCorrectUsage(Self);
end;
{$ENDIF}
{== TMMCustomBlockSlider ===============================================}
constructor TMMCustomBlockSlider.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FStyle := ssWin95;
   FRole  := srPan;
   UpdateStyle;
end;
{-- TMMCustomBlockSlider -----------------------------------------------}
procedure TMMCustomBlockSlider.SetParent(Value: TWinControl);
begin
   CheckParent(Value);
   if Parent <> Value then
   begin
      PostChange(Self,saRemove);
      inherited SetParent(Value);
      if FIsRole then
         PostChange(Self,saInsert)
      else
         PostChange(Self,saInsNoRole);
   end;
end;
{-- TMMCustomBlockSlider -----------------------------------------------}
procedure TMMCustomBlockSlider.SetStyle(Value: TMMBlockSliderStyle);
begin
   if Value <> FStyle then
   begin
      FStyle := Value;
      UpdateStyle;
   end;
end;
{-- TMMCustomBlockSlider -----------------------------------------------}
procedure TMMCustomBlockSlider.SetRole(Value: TMMBlockSliderRole);
begin
   if not FIsRole or (Value <> FRole) then
   begin
      FIsRole := True;
      FRole   := Value;
      UpdateStyle;
      PostChange(Self,saUpdate);
   end;
end;
{-- TMMCustomBlockSlider -----------------------------------------------}
procedure TMMCustomBlockSlider.UpdateStyle;
begin
   Bevel.BevelOuter:= bvNone;
   Scale.Visible   := True;
   Scale.Connect   := False;
   Scale.Origin    := soInner;
   Scale.Size      := 6;
   GrooveSize      := 1;
   if FRole = srPan then
   begin
      PicLeft.Handle := LoadBitmap(hInstance,SpkLeftBmp);
      PicRight.Handle := LoadBitmap(hInstance,SpkRightBmp);
      Scale.TickCount := 3;
      Scale.EnlargeEvery := 2;
      ScalePosition := spBelowOrRight;
      Logarithmic := False;
   end
   else
   begin
      PicLeft := nil;
      PicRight := nil;
      Scale.TickCount := 7;
      Scale.EnlargeEvery := 6;
      ScalePosition := spBoth;
      Logarithmic := True;
   end;
end;
{== TMMCustomBlockLevel ================================================}
constructor TMMCustomBlockLevel.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FStyle := lsWin95;
   FRole  := lrLeftLevel;
   UpdateStyle;
end;
{-- TMMCustomBlockLevel ------------------------------------------------}
procedure TMMCustomBlockLevel.SetStyle(Value: TMMBlockLevelStyle);
begin
   if Value <> FStyle then
   begin
      FStyle := Value;
      UpdateStyle;
   end;
end;
{-- TMMCustomBlockLevel ------------------------------------------------}
procedure TMMCustomBlockLevel.SetRole(Value: TMMBlockLevelRole);
begin
   if not FIsRole or (Value <> FRole) then
   begin
      FIsRole := True;
      FRole   := Value;
      UpdateStyle;
      PostChange(Self,saUpdate);
   end;
end;
{-- TMMCustomBlockLevel ------------------------------------------------}
procedure TMMCustomBlockLevel.UpdateStyle;
begin
   Bevel.BorderWidth   := 1;
   Color               := clBtnFace;
   SpotWidth           := 6;
   Bar1Color           := clGreen;
   Bar2Color           := clLime;
   Bar3Color           := clYellow;
   Inactive1Color      := clBtnFace;
   Inactive2Color      := clBtnFace;
   Inactive3Color      := clBtnFace;
   Point1              := 45;
   Point2              := 60;
   LogAmp              := False;
   NumPeaks            := 0;
end;
{-- TMMCustomBlockLevel ------------------------------------------------}
procedure TMMCustomBlockLevel.SetParent(Value: TWinControl);
begin
   CheckParent(Value);
   if Parent <> Value then
   begin
      PostChange(Self,saRemove);
      inherited SetParent(Value);
      if FIsRole then
         PostChange(Self,saInsert)
      else
         PostChange(Self,saInsNoRole)
   end;
end;
{== TMMCustomBlockCheck ================================================}
procedure TMMCustomBlockCheck.SetParent(Value: TWinControl);
begin
   CheckParent(Value);
   if Parent <> Value then
   begin
      PostChange(Self,saRemove);
      inherited SetParent(Value);
      PostChange(Self,saInsert)
   end;
end;
{== TMMCustomBlockLabel ================================================}
procedure TMMCustomBlockLabel.SetParent(Value: TWinControl);
begin
   CheckParent(Value);
   if Parent <> Value then
   begin
      PostChange(Self,saRemove);
      inherited SetParent(Value);
      if FIsRole then
         PostChange(Self,saInsert)
      else
         PostChange(Self,saInsNoRole)
   end;
end;
{-- TMMCustomBlockLabel ------------------------------------------------}
procedure TMMCustomBlockLabel.SetRole(Value: TMMBlockLabelRole);
begin
   if not FIsRole or (FRole <> Value) then
   begin
      FRole   := Value;
      FIsRole := True;
      PostChange(Self,saUpdate);
   end;
end;
{== TMMCustomMixerBlock ================================================}
constructor TMMCustomMixerBlock.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   ControlStyle            := ControlStyle - [csSetCaption];
   FObserver               := TMMObserver.Create;
   FObserver.OnNotify      := LineNotify;
   FAutoArrange            := True;
   FAutoSize               := True;
   FStyle                  := bsWin95;
   FPanCtl                 := TMMPanControl.Create(Self);
   FVolumeCtl              := TMMVolumeControl.Create(Self);
   FPanCtl.VolumeControl   := FVolumeCtl;
   FMuteCtl                := TMMMixerControl.Create(Self);
   FMuteCtl.ControlType    := ctMute;
   FConnector              := TMMMixerConnector.Create(Self);
   FPeakCtl                := TMMMixerControl.Create(Self);
   FPeakCtl.ControlType    := ctPeakMeter;
   FConnector.Control      := FPeakCtl;
   FItem                   := NoItem;
   FMixObserver            := TMMObserver.Create;
   FMixObserver.OnNotify   := MixNotify;
   Width                   := 100;
   Height                  := 250;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
destructor TMMCustomMixerBlock.Destroy;
begin
   FPanCtl.Free;
   FVolumeCtl.Free;
   FMuteCtl.Free;
   FPeakCtl.Free;
   FConnector.Free;
   FObserver.Free;
   FMixObserver.Free;
   inherited Destroy;
end;
{$IFDEF BUILD_ACTIVEX}
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.ChangeDesigning(Value: Boolean);
begin
  inherited;
  FPanCtl.ChangeDesigning(Value);
  FVolumeCtl.ChangeDesigning(Value);
  FMuteCtl.ChangeDesigning(Value);
  FConnector.ChangeDesigning(Value);
  FPeakCtl.ChangeDesigning(Value);
end;
{$ENDIF}
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.UpdateBlock;
begin
   if (csDestroying in ComponentState) then
       Exit;
   if not (csLoading in ComponentState) then
   begin
      CollectControls;
      if csDesigning in ComponentState then
      begin
         if Style = bsWin95 then
         begin
            if FPan <> nil then
               FPan.Style := ssWin95;
            if FVolumeLeft <> nil then
               FVolumeLeft.Style := ssWin95;
            if FVolumeRight <> nil then
               FVolumeRight.Style := ssWin95;
            if FLevelLeft <> nil then
               FLevelLeft.Style := lsWin95;
            if FLevelRight <> nil then
               FLevelRight.Style := lsWin95;
         end;
      end;
      ConnectControls;
      ArrangeControls;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.MMSetParent(var Msg: TMMSetParent);
begin
   inherited;
   case TMMSetParentAction(Msg.Action) of
        saRemove    : FRemoving := Msg.Control;
        saInsNoRole : if (csDesigning in ComponentState) and
                          not (csLoading in ComponentState) and
                          not (csReading in ComponentState) then
                              InsertCtl(Msg.Control); { Change control's role if needed }
        saInsert    :;
        saUpdate    :;
   end;
   UpdateBlock;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent,Operation);
   if Operation = opRemove then
      if AComponent = Line then
         Line := nil
      else if AComponent = Mixer then
          Mixer := nil
      else if AComponent is TControl then
           if FindBlock(AComponent as TControl) = Self then
              UpdateBlock;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.InsertCtl(C: TComponent);
begin
   if (C is TMMCustomBlockSlider) then
   begin
      if FPan = nil then
         (C as TMMCustomBlockSlider).Role := srPan
      else if FVolumeLeft = nil then
         (C as TMMCustomBlockSlider).Role := srLeftVolume
      else if FVolumeRight = nil then
         (C as TMMCustomBlockSlider).Role := srRightVolume
      else
         Exit;
   end
   else if C is TMMCustomBlockLevel then
   begin
      if FLevelLeft = nil then
         (C as TMMCustomBlockLevel).Role := lrLeftLevel
      else if FLevelRight = nil then
         (C as TMMCustomBlockLevel).Role := lrRightLevel
      else
          Exit;
   end
   else if C is TMMCustomBlockLabel then
   begin
      if FLineTitle = nil then
         (C as TMMCustomBlockLabel).Role := lrLineTitle
      else if FPanTitle = nil then
         (C as TMMCustomBlockLabel).Role := lrPanTitle
      else if FVolumeTitle = nil then
         (C as TMMCustomBlockLabel).Role := lrVolumeTitle
      else
         Exit;
   end
   else Exit;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetLine(Value: TMMAudioLine);
begin
   if Value <> FLine then
   begin
      if FLine <> nil then
      begin
         FLine.RemoveObserver(FObserver);
         DisconnectLine;
      end;
      FLine := Value;
      if FLine <> nil then
      begin
         FLine.AddObserver(FObserver);
         ConnectLine;
      end;
      ConnectControls;
      ArrangeControls;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.LineNotify(Sender, Data : TObject);
begin
   if (Data = nil) or (Data is TMMLineIdChange) then
   begin
      ConnectControls;
      ArrangeControls;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.Loaded;
begin
   inherited Loaded;
   UpdateBlock;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.ArrangeControls;
var
   R     : TRect;
   HSpace: Integer;
   VSpace: Integer;
   VolW  : Integer;
   PeakW : Integer;
   procedure SubTop(Value: Integer);
   begin
      if R.Top + Value <= R.Bottom then
         R.Top := R.Top + Value
      else
         R.Top := R.Bottom;
   end;
   procedure SubBottom(Value: Integer);
   begin
      if R.Bottom - Value >= R.Top then
         R.Bottom := R.Bottom - Value
      else
         R.Bottom := R.Top;
   end;
   function ShouldArrange(C: TControl): Boolean;
   begin
    Result := AutoArrange and (C.Parent = Self);
   end;
   procedure PutAtTop;
   begin
      if FLineTitle <> nil then
      begin
         if ShouldArrange(FLineTitle) then
         begin
             FLineTitle.Top      := R.Top;
             FLineTitle.Left     := R.Left;
             if AutoSize then
                FLineTitle.Width    := R.Right - R.Left;
             SubTop(FLineTitle.Height+VSpace);
         end;
         if Line = nil then
            FLineTitle.Caption := 'Not connected'
         else
            FLineTitle.Caption := Line.LineInfo.Name;
      end;
      if FPanTitle <> nil then
      begin
         if ShouldArrange(FPanTitle) then
         begin
             FPanTitle.Top       := R.Top;
             FPanTitle.Left      := R.Left;
             if AutoSize then
                FPanTitle.Width     := R.Right - R.Left;
         end;
         { TODO: Should be resource id }
         FPanTitle.Caption   := 'Balance:';
         SubTop(FPanTitle.Height);
      end;
      if FPan <> nil then
      begin
         if ShouldArrange(FPan) then
         begin
             FPan.Top         := R.Top;
             if AutoSize then
             begin
                 FPan.Left        := R.Left;
                 FPan.Width       := R.Right - R.Left;
             end
             else
                 FPan.Left        := R.Left + (R.Right - R.Left - FPan.Width) div 2;
             SubTop(FPan.Height+VSpace);
         end;
      end;
      SubTop(VSpace);
      if FVolumeTitle <> nil then
      begin
         if ShouldArrange(FVolumeTitle) then
         begin
             FVolumeTitle.Top     := R.Top;
             FVolumeTitle.Left    := R.Left;
             if AutoSize then
                FVolumeTitle.Width   := R.Right - R.Left;
         end;
         FVolumeTitle.Caption := 'Volume:';
         SubTop(FVolumeTitle.Height);
      end;
    end;
    procedure PutAtBottom;
    begin
       if FMute <> nil then
       begin
          if ShouldArrange(FMute) then
          begin
            FMute.Top    := R.Bottom - FMute.Height;
            if AutoSize then
            begin
                FMute.Left   := R.Left;
                FMute.Width  := R.Right - R.Left;
            end
            else
                FMute.Left   := R.Left + (R.Right - R.Left - FMute.Width) div 2;
            SubBottom(FMute.Height + VSpace);
          end;
       end;
    end;
    procedure PutAtCenter;
    var
       Vol, Peak : Boolean;
       W         : Integer;
       procedure PutRect(C1, C2: TControl; R : TRect);
       begin
          if not AutoArrange then
            Exit;
            
          if C1 <> nil then
          begin
             if AutoSize then
             begin
                 C1.Top      := R.Top;
                 C1.Height   := R.Bottom - R.Top;
                 C1.Left     := R.Left;
                 if C2 <> nil then
                    C1.Width := (R.Right - R.Left) div 2 - HSpace div 2
                 else
                    C1.Width := (R.Right - R.Left);
             end
             else
             begin
                 C1.Top      := R.Top + (R.Bottom - R.Top - C1.Height) div 2;
                 if C2 <> nil then
                    C1.Left  := R.Left + ((R.Right - R.Left) div 2 - HSpace div 2 - C1.Width) div 2
                 else
                    C1.Left  := R.Left + ((R.Right - R.Left) - C1.Width) div 2;
             end;
          end;
          if C2 <> nil then
          begin
             if AutoSize then
             begin
                 C2.Top     := R.Top;
                 C2.Height  := R.Bottom - R.Top;
                 if C1 <> nil then
                    C2.Left := R.Left + (R.Right - R.Left) div 2 + HSpace div 2
                 else
                    C2.Left := R.Left;
                 C2.Width   := R.Right - C2.Left;
             end
             else
             begin
                 C2.Top     := R.Top + (R.Bottom - R.Top - C2.Height) div 2;
                 if C1 <> nil then
                    C2.Left := R.Left + (R.Right - R.Left) div 2 + HSpace div 2 + (((R.Right - R.Left) div 2 - HSpace div 2) - C2.Width) div 2
                 else
                    C2.Left := R.Left + (R.Right - R.Left - C2.Width) div 2;
             end;
          end;
       end;
       procedure PutVol(R: TRect);
       begin
          PutRect(FVolumeLeft,FVolumeRight,R);
       end;
       procedure PutLev(R: TRect);
       begin
          PutRect(FLevelLeft,FLevelRight,R);
       end;
    begin
        Vol     := (FVolumeLeft <> nil) or (FVolumeRight <> nil);
        Peak    := ((FLevelLeft <> nil) or (FLevelRight <> nil)) and
                   ((csDesigning in ComponentState) or (FPeakCtl.Available));
        W       := R.Right - R.Left;
        VolW    := 3 * (W div 4);
        PeakW   := W - VolW;
        if FLevelLeft <> nil then
        begin
           FLevelLeft.Kind      := lkVertical;
           FLevelLeft.Visible   := Peak;
        end;
        if FLevelRight <> nil then
        begin
           FLevelRight.Kind     := lkVertical;
           FLevelRight.Visible  := Peak;
        end;
        if Vol and Peak then
        begin
           PutVol(Bounds(R.Left,R.Top,VolW,R.Bottom-R.Top));
           PutLev(Bounds(R.Left+VolW,R.Top,PeakW,R.Bottom-R.Top));
        end
        else if Vol then
             PutVol(R)
        else if Peak then
            PutLev(R);
    end;
begin
   if (csLoading in ComponentState) or
{$IFNDEF BUILD_ACTIVEX}
      (Parent = nil) then
{$ELSE}
      (ParentWindow = 0) then
{$ENDIF}
       Exit;
   HSpace := Canvas.TextWidth('A');
   VSpace := Canvas.TextHeight('A') div 2;
   if Style = bsWin95 then
   begin
      R := ClientRect;
      InflateRect(R,-BevelExtend-HSpace,-BevelExtend-VSpace);
      PutAtTop;
      PutAtBottom;
      PutAtCenter;
      if AutoArrange then
      begin
          if FPan <> nil then
          begin
             FPan.TabOrder := 0;
             FPan.TabStop := True;
          end;
          if FVolumeLeft <> nil then
          begin
             FVolumeLeft.TabOrder := 1;
             FVolumeLeft.TabStop := True;
          end;
          if FVolumeRight <> nil then
          begin
             FVolumeRight.TabOrder := 2;
             FVolumeRight.TabStop := True;
          end;
          if FMute <> nil then
          begin
             FMute.TabOrder := 3;
             FMute.TabStop := True;
          end;
      end;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetAutoArrange(Value: Boolean);
begin
   if Value <> FAutoArrange then
   begin
      FAutoArrange := Value;
      ArrangeControls;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetAutoSize(Value: Boolean);
begin
   if Value <> FAutoSize then
   begin
      FAutoSize := Value;
      ArrangeControls;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
   inherited SetBounds(ALeft,ATop,AWidth,AHeight);
   ArrangeControls;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetStyle(Value: TMMBlockStyle);
begin
   if Value <> FStyle then
   begin
      FStyle := Value;
      UpdateBlock;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.ConnectLine;
begin
   FPanCtl.AudioLine    := FLine;
   FVolumeCtl.AudioLine := FLine;
   FMuteCtl.AudioLine   := FLine;
   FPeakCtl.AudioLine   := FLine;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.DisconnectLine;
begin
   FPanCtl.AudioLine    := nil;
   FVolumeCtl.AudioLine := nil;
   FMuteCtl.AudioLine   := nil;
   FPeakCtl.AudioLine   := nil;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.ConnectControls;
var
    AItem: TMMItemIndex;
begin
   if FPan <> nil then
      FPan.Control    := FPanCtl;
   if FMute <> nil then
   begin
      AItem := NoItem;
      if (Mixer <> nil) and Mixer.Available and (Line <> nil) then
          if Item = NoItem then
             AItem := Mixer.GetItemForLine(Line)
          else
             AItem := Item;
      if AItem <> NoItem then
      begin
         FMute.Control   := Mixer;
         FMute.Item      := AItem;
      end
      else
      begin
         FMute.Control   := FMuteCtl;
         FMute.Item      := NoItem;
      end;
   end;
   if FVolumeLeft <> nil then
   begin
      FVolumeLeft.Control := FVolumeCtl;
      if FVolumeRight = nil then
         FVolumeLeft.Channel := chBoth
      else
         FVolumeLeft.Channel := chLeft
   end;
   if FVolumeRight <> nil then
   begin
      FVolumeRight.Control := FVolumeCtl;
      if FVolumeLeft = nil then
         FVolumeRight.Channel := chBoth
      else
         FVolumeRight.Channel := chRight
   end;
   if FLevelLeft <> nil then
      FConnector.Level1 := FLevelLeft;
   if FLevelRight <> nil then
      FConnector.Level2 := FLevelRight;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
function TMMCustomMixerBlock.GetMuteKind: TMMMuteKind;
begin
   if (FMute <> nil) and (Mixer <> nil) and (FMute.Control = Mixer) then
       Result := mkSelect
   else
       Result := mkMute;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.CollectControls;
   procedure SetCtl(var P; C: TControl);
   begin
      TControl(P) := C;
   end;
   function  CheckCtl(C: TControl): Boolean;
   begin
      Result := False;
      if C = FRemoving then
         Exit;
      if C is TMMCustomBlockSlider then
      begin
         with C as TMMCustomBlockSlider do
         if Role = srPan then
            SetCtl(FPan,C)
         else if Role = srLeftVolume then
            SetCtl(FVolumeLeft,C)
         else if Role = srRightVolume then
            SetCtl(FVolumeRight,C)
      end
      else if C is TMMCustomBlockCheck then
            SetCtl(FMute,C)
      else if C is TMMCustomBlockLevel then
      begin
          with C as TMMCustomBlockLevel do
          if Role = lrLeftLevel then
             SetCtl(FLevelLeft,C)
          else if Role = lrRightLevel then
             SetCtl(FLevelRight,C)
      end
      else if C is TMMCustomBlockLabel then
      begin
         with C as TMMCustomBlockLabel do
         if Role = lrLineTitle then
            SetCtl(FLineTitle,C)
         else if Role = lrPanTitle then
            SetCtl(FPanTitle,C)
         else if Role = lrVolumeTitle then
            SetCtl(FVolumeTitle,C)
      end
      else
        Exit;
      Result := True;
   end;
   procedure Process(C: TWinControl);
   var
    i: Integer;
   begin
       for i := 0 to C.ControlCount - 1 do
        if not CheckCtl(C.Controls[i]) and (C.Controls[i] is TWinControl) then
            Process(C.Controls[i] as TWinControl);
   end;
begin
   FPan        := nil;
   FVolumeLeft := nil;
   FVolumeRight:= nil;
   FMute       := nil;
   FLevelLeft  := nil;
   FLevelRight := nil;
   FLineTitle  := nil;
   FPanTitle   := nil;
   FVolumeTitle:= nil;
   Process(Self);
   FRemoving := nil;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetMixer(Value: TMMCustomMixerControl);
begin
   if Value <> FMixer then
   begin
      if FMixer <> nil then
         FMixer.RemoveObserver(FMixObserver);
      FMixer := Value;
      if FMixer <> nil then
      begin
         FMixer.AddObserver(FMixObserver);
         FMixer.FreeNotification(Self);
      end;
      UpdateBlock;
   end;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.MixNotify(Sender, Data: TObject);
begin
   if (Data = nil) or (Data is TMMControlIdChange) then
       UpdateBlock;
end;
{-- TMMCustomMixerBlock ------------------------------------------------}
procedure TMMCustomMixerBlock.SetItem(Value: TMMItemIndex);
begin
   if Value <> FItem then
   begin
      FItem := Value;
      UpdateBlock;
   end;
end;
end.

						