mmmixblk.pas

一套及时通讯的原码

{$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;