actnctrls.pas

这是不可多得的源代码

end;

{ TCustomActionDockBar }

constructor TCustomActionDockBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alNone;
  DragKind := dkDock;
end;

procedure TCustomActionDockBar.Dock(NewDockSite: TWinControl; ARect: TRect);
var
  NewWidth: Integer;
  Item: TActionClientItem;
begin
  inherited Dock(NewDockSite, ARect);
  if Floating then
  begin
    if Assigned(ActionClient) then
      TActionBarItem(ActionClient).AutoSize := True;
    DragMode := dmManual;
  end
  else
  begin
    DragMode := dmManual;
    if Assigned(ActionClient) then
      TActionBarItem(ActionClient).AutoSize := False;
    NewWidth := HorzMargin * 2;
    Item := FindFirstVisibleItem;
    while Assigned(Item) do
    begin
      Inc(NewWidth, Item.Control.Width);
      Inc(NewWidth, Spacing);
      Item := FindNextVisibleItem(Item);
    end;
    if NewWidth <> HorzMargin * 2 then
      Width := NewWidth;
    Height := 0;
  end;
end;

procedure TCustomActionDockBar.DoEndDock(Target: TObject; X, Y: Integer);
begin
  inherited;
  FDragObject.Free;
  FDragObject := nil;
end;

procedure TCustomActionDockBar.DoStartDock(var DragObject: TDragObject);
begin
  inherited;
  FDragObject := TToolDockObject.Create(Self);
  DragObject := FDragObject;
end;

procedure TCustomActionDockBar.GetSiteInfo(Client: TControl;
  var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
  inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
  CanDock := CanDock and ((Client is TCustomActionControl) or (Client is TSpeedButton));
end;

procedure TCustomActionDockBar.Loaded;
var
  I: Integer;
begin
  { Make sure we dock controls after streaming }
  for I := 0 to ControlCount - 1 do
    Controls[I].HostDockSite := Self;
  inherited Loaded;
end;

function TCustomActionDockBar.GetFloatingDockSiteClass: TWinControlClass;
begin
  Result := TXToolDockForm;
end;

{ TCustomActionToolBar }

constructor TCustomActionToolBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alTop;
  Height := 29;
  HorzMargin := 1;
  EdgeBorders := [];
  EdgeInner := esRaised;
  EdgeOuter := esNone;
  HorzSeparator := True;
  VertSeparator := True;
end;

destructor TCustomActionToolBar.Destroy;
begin
  FHiddenItems.Free;
  if Assigned(FScrollBtn) then
    FreeAndNil(FScrollBtn);
  inherited Destroy;
end;

procedure TCustomActionToolBar.AutoSizingChanged;
begin
  inherited;
  if not AutoSizing then
    SetupDropDownBtn
  else
  begin
    while Assigned(FHiddenItems) and (FHiddenItems.Count > 0) do
      TCustomActionControl(FHiddenItems.Pop).Visible := True;
    FreeAndNil(FHiddenItems);
    FreeAndNil(FScrollBtn);
    Resize;
  end;
end;

function TCustomActionToolBar.CalcButtonWidth: Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to ItemCount - 1 do
    if ActionControls[I].Width > Result then
      Result := ActionControls[I].Width;
end;

function TCustomActionToolBar.CreateControl(
  AnItem: TActionClientItem): TCustomActionControl;
begin
  Result := inherited CreateControl(AnItem);
  with Result do
  begin
    Spacing := 3;
    Margins := Rect(4,4,4,4);
    if Assigned(Self.ActionClient) then
    begin
      GlyphLayout := TActionBarItem(Self.ActionClient).GlyphLayout;
      SmallIcon := Self.ActionClient.Items.SmallIcons;
    end;
  end;
end;

procedure TCustomActionToolBar.DisableHiding;
begin
  Inc(FHideLevel);
end;

function TCustomActionToolBar.GetControlClass(
  AnItem: TActionClientItem): TCustomActionControlClass;
begin
  Result := Style.GetControlClass(Self, AnItem)
end;

procedure TCustomActionToolBar.DoDropCategory(Source: TCategoryDragObject;
  const X, Y: Integer);
var
  I: Integer;
  Idx: Integer;
  Ctrl: TCustomActionControl;
begin
  Idx := 0;
  Ctrl := FindNearestControl(Point(X, Y));
  if Assigned(Ctrl) then
    Idx := Ctrl.ActionClient.Index;
  for I := 0 to Source.ActionCount - 1 do
    TActionClientItem(ActionClient.Items.Insert(Idx)).Action := Source.Actions[I];
end;

procedure TCustomActionToolBar.DrawBackground;
var
  FirstItem,
  LastItem: TActionClientItem;
  I: Integer;
begin
  inherited DrawBackground;
  if (ItemCount = 0) or not AutoSizing then exit;
  FirstItem := FindFirst;
  LastItem := FindLast;
  if not Assigned(FirstItem) or not Assigned(LastItem) or
    not Assigned(FirstItem.Control) or not Assigned(LastItem.Control) or
    (FirstItem.Control.Top = LastItem.Control.Top) then exit;
  if HorzSeparator and (Orientation in [boLeftToRight, boRightToLeft]) then
    for I := 1 to VRowCount - 1 do
      DrawSeparator(((VertMargin * 2 + LastItem.Control.Height) +
        (I - 1) * (VertMargin * 2 + 2 + LastItem.Control.Height)) + 1, 2);
  if VertSeparator and (Orientation in [boTopToBottom, boBottomToTop]) then
    for I := 1 to HRowCount - 1 do
      DrawSeparator(((HorzMargin * 2 + LastItem.Control.Width) +
        (I - 1) * (HorzMargin * 2 + 2 + LastItem.Control.Width)) + 1, 2);
end;

procedure TCustomActionToolBar.DrawSeparator(const Pos, Offset: Integer);
var
  StartPos: TPoint;
  EndPos: TPoint;
begin
  if Orientation in [boTopToBottom, boBottomToTop] then
  begin     // Vertical bar
    StartPos := Point(Pos - 1, Offset - 1);
    EndPos := Point(Pos - 1, ClientHeight - Offset + 1);
  end
  else
  begin     // Horizontal bar
    StartPos := Point(Offset + GetBannerWidth(beLeft), Pos - 1);
    EndPos := Point(ClientWidth - Offset - GetBannerWidth(beRight), Pos - 1);
  end;
  with Canvas do
  begin
    Pen.Width := 1;
    Pen.Color := ColorMap.ShadowColor;
    MoveTo(StartPos.X, StartPos.Y);
    LineTo(EndPos.X, EndPos.Y);
    Pen.Color := ColorMap.UnusedColor;
    if StartPos.X = EndPos.X then
    begin
      MoveTo(StartPos.X + 1, StartPos.Y);
      LineTo(StartPos.X + 1, EndPos.Y);
    end
    else
    begin
      MoveTo(StartPos.X, StartPos.Y + 1);
      LineTo(EndPos.X, EndPos.Y + 1);
    end;
  end;
end;

procedure TCustomActionToolBar.EnableHiding;
begin
  if FHideLevel > 0 then
  begin
    Dec(FHideLevel);
    if FHideLevel = 0 then
      HideUnusedItems;
  end;
end;

function TCustomActionToolBar.GetHiddenCount: Integer;
begin
  Result := 0;
  if Assigned(FHiddenItems) then
    Result := FHiddenItems.Count;
end;

procedure TCustomActionToolBar.HideUnusedItems;
var
  ScrollBtnBounds: TRect;
  LastItem: TActionClientItem;

  function HideItem(AnItem: TCustomActionControl): Boolean;
  begin
    Result := False;
    if Assigned(AnItem) then
      if LastItem = AnItem.ActionClient then
      begin
        case Orientation of
          boLeftToRight:
            Result := AnItem.BoundsRect.Right >= ScrollBtnBounds.Left;
          boRightToLeft:
            Result := AnItem.Left <= ScrollBtnBounds.Left +
              (ScrollBtnBounds.Right - ScrollBtnBounds.Left);
          boBottomToTop:
            Result := AnItem.Top <= ScrollBtnBounds.Top +
              (ScrollBtnBounds.Bottom - ScrollBtnBounds.Top);
          boTopToBottom:
            Result := AnItem.BoundsRect.Bottom >= ScrollBtnBounds.Top;
        end;
        Result := Result and AnItem.ActionClient.Visible;
      end
      else
        case Orientation of
          boLeftToRight:
            Result := LastItem.Control.BoundsRect.Right + Spacing + AnItem.Width >
              ClientWidth - HorzMargin - GetBannerWidth(beRight) -
                (ScrollBtnBounds.Right - ScrollBtnBounds.Left);
          boRightToLeft:
            Result := AnItem.Width > LastItem.Control.Left - Spacing -
              (ScrollBtnBounds.Left + (ScrollBtnBounds.Right - ScrollBtnBounds.Left));
          boBottomToTop:
            Result := AnItem.Height > LastItem.Control.Top - Spacing -
              (ScrollBtnBounds.Top + (ScrollBtnBounds.Bottom - ScrollBtnBounds.Top));
          boTopToBottom:
            Result := LastItem.Control.BoundsRect.Bottom + AnItem.Height >
              ClientHeight - Spacing - VertMargin - (ScrollBtnBounds.Bottom - ScrollBtnBounds.Top);
        end;
  end;

var
  AnItem: TActionClientItem;
begin
  if AutoSizing or (FHideLevel > 0) then exit;
  if Assigned(FScrollBtn) then
    ScrollBtnBounds := FScrollBtn.BoundsRect
  else
    ScrollBtnBounds := Rect(0,0,0,0);
  LastItem := FindLastVisibleItem;
  if LastItem = nil then exit;
  if HideItem(LastItem.Control) then
  begin
    if ActionClient.Items.HideUnused then
      AnItem := FindLeastUsedItem(True)
    else
      AnItem := LastItem;
    if Assigned(AnItem) and AnItem.Visible and (LastItem <> FindFirstVisibleItem) then
    begin
      if FHiddenItems = nil then
      begin
        FHiddenItems := TStack.Create;
        SetupDropDownBtn;
      end;
      if csDesigning in ComponentState then
        AnItem.Control.ControlStyle := AnItem.Control.ControlStyle + [csNoDesignVisible];
      FHiddenItems.Push(AnItem.Control);
      AnItem.Control.Visible := False;
    end;
  end
  else
    if Assigned(FHiddenItems) and (FHiddenItems.Count > 0) then
      if not HideItem(TCustomActionControl(FHiddenItems.Peek)) then
      begin
        if csDesigning in ComponentState then
          with TControl(FHiddenItems.Peek) do
            ControlStyle := ControlStyle + [csNoDesignVisible];
        if TCustomActionControl(FHiddenItems.Peek).ActionClient.Visible then
          TCustomActionControl(FHiddenItems.Pop).Visible := True;
        if Assigned(FHiddenItems) and (FHiddenItems.Count = 0) then
          FreeAndNil(FHiddenItems);
      end;
  if Assigned(FScrollBtn) then
    FScrollBtn.Enabled := not (csDesigning in ComponentState) and
      ((HiddenCount > 0) or Assigned(ActionManager.DefaultActionBars));
end;

type
  TStackClass = class(TStack);

procedure TCustomActionToolBar.ScrollBtnClick(Sender: TObject);
var
  AC: TCustomizeActionClientItem;
  I: Integer;
  Pt: TPoint;
begin
  if Assigned(FPopupBar) or not Assigned(ActionClient) then
    Exit;
  AC := TCustomizeActionClientItem.Create(ActionClient.Items);
  AC.Visible := False;
  for I := 0 to ActionClient.Items.Count - 1 do
    if Assigned(FHiddenItems) and
       (TStackClass(FHiddenItems).List.IndexOf(ActionClient.Items[I].Control) <> -1) then
      with AC.Items.Add do
      begin
        ChangesAllowed := caAllChanges;
        Assign(ActionClient.Items[I]);
        UsageCount := -1;
      end;
  FPopupBar := GetPopupClass.Create(Self);
  try
    with FPopupBar as TCustomizeActionToolBar do
    begin
      ColorMap := Self.ColorMap;
      RootMenu := TCustomizeActionToolBar(FPopupBar);
      ParentControl := Self.FScrollBtn;
      Parent := Self;
      ActionClient := AC;
      Expand(True);
      ReAlign;
      case Self.Orientation of
        boBottomToTop: Pt := Self.ClientToScreen(Point(FScrollBtn.Left,
          FScrollBtn.Top - FPopupBar.Height));
        boTopToBottom: Pt := Self.ClientToScreen(Point(FScrollBtn.Left,
          FScrollBtn.Top + FScrollBtn.Height));
        boLeftToRight,
        boRightToLeft: Pt := Self.ClientToScreen(Point(FScrollBtn.Left -
         FPopupBar.Width + FScrollBtn.Width, FScrollBtn.Top + FScrollBtn.Height));
      end;
      Popup(Pt.X, Pt.Y);
    end;
  finally
    FPopupBar.Free;
    FPopupBar := nil;
    AC.Control.Free;
    AC.Free;
    Resize;
  end;
end;

const
  BtnAlignment: array[TBarOrientation] of TAlign =
    (alRight, alLeft, alBottom, alTop);
  ArrowDirection: array[TBarOrientation] of TScrollDirection =
    (sdRight, sdLeft, sdDown, sdUp);

procedure TCustomActionToolBar.SetOrientation(const Value: TBarOrientation);
begin
  DisableHiding;
  try
    if Assigned(FHiddenItems) then
      while FHiddenItems.Count > 0 do
        TCustomActionControl(FHiddenItems.Pop).Visible := True;
    FreeAndNil(FHiddenItems);
    inherited SetOrientation(Value);
    if Assigned(FScrollBtn) then
    begin
      FScrollBtn.Direction := ArrowDirection[Orientation];
      FScrollBtn.Align := BtnAlignment[Orientation];
    end;
  finally
    EnableHiding;
  end;
end;

procedure TCustomActionToolBar.SetupDropDownBtn;
begin
  if AutoSizing then exit;
  if Assigned(FScrollBtn) or not Assigned(ActionClient) then exit;
  FScrollBtn := GetScrollBtnClass.Create(Self);
  with FScrollBtn do
  begin
    Hint := SMoreButtons;
    Direction := ArrowDirection[Orientation];
    Align := BtnAlignment[Orientation];
    Parent := Self;
    ParentColor := True;
    if Align in [alTop, alBottom] then
      Height := 13
    else
      Width := 11;
    Transparent := Self.ActionClient.HasBackground;
    OnClick := ScrollBtnClick;
  end;
end;

procedure TCustomActionToolBar.Reset;
begin
  DisableHiding;
  try
    if Assigned(FHiddenItems) then
    begin
      while FHiddenItems.Count > 0 do
        TCustomActionControl(FHiddenItems.Pop).Visible := True;
      FreeAndNil(FHiddenItems);
    end;
    inherited Reset;
  finally
    EnableHiding;
  end;
end;

procedure TCustomActionToolBar.CMColorchanged(var Message: TMessage);
begin
  inherited;
  FShadowClr := ColorAdjustLuma(Self.Color, -85, False);
  FHighLightClr := ColorAdjustLuma(Self.Color, +85, False);
end;

procedure TCustomActionToolBar.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if not AutoSizing then
    HideUnusedItems;
end;

procedure TCustomActionToolBar.DragDrop(Source: TObject; X, Y: Integer);
begin
  inherited;
  SetBounds(Left, Top, Width, Height);
  if not AutoSizing then
    HideUnusedItems;
end;

function TCustomActionToolBar.GetPopupClass: TCustomActionBarClass;
begin
  with Style as TActionBarStyleEx do
    Result := GetPopupClass(Self);
end;

function TCustomActionToolBar.GetScrollBtnClass: TCustomToolScrollBtnClass;
begin
  with Style as TActionBarStyleEx do
    Result := GetScrollBtnClass;
end;

end.