mmmixblk.pas

一套及时通讯的原码

{-- 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.