stdactnmenus.pas

这是不可多得的源代码

begin
  Windows.GetClientRect(Handle, RC);
  GetWindowRect(Handle, RW);
  MapWindowPoints(0, Handle, RW, 2);
  OffsetRect(RC, -RW.Left, -RW.Top);
  ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  { Draw border in non-client area }
  OffsetRect(RW, -RW.Left, -RW.Top);
  OldHandle := Canvas.Handle;
  try
    Canvas.Handle := DC;
    Canvas.Pen.Width := 1;

    Canvas.Pen.Color := ColorMap.FrameTopLeftOuter;
    Canvas.MoveTo(RW.Right, RW.Top);
    Canvas.LineTo(RW.Left, Rw.Top);
    Canvas.LineTo(RW.Left, RW.Bottom);

    Canvas.Pen.Color := ColorMap.FrameTopLeftInner;
    Canvas.MoveTo(RW.Right - 1, RW.Top + 1);
    Canvas.LineTo(RW.Left + 1, Rw.Top + 1);
    Canvas.LineTo(RW.Left + 1, RW.Bottom - 2);

    Canvas.Pen.Color := ColorMap.FrameBottomRightOuter;
    Canvas.MoveTo(RW.Right - 1, RW.Top);
    Canvas.LineTo(RW.Right - 1, RW.Bottom - 1);
    Canvas.LineTo(RW.Left - 1, RW.Bottom - 1);

    Canvas.Pen.Color := ColorMap.FrameBottomRightInner;
    Canvas.MoveTo(RW.Right - 2, RW.Top + 1);
    Canvas.LineTo(RW.Right - 2, RW.Bottom - 2);
    Canvas.LineTo(RW.Left, RW.Bottom - 2);
  finally
    Canvas.Handle := OldHandle;
  end;
end;

procedure TStandardMenuPopup.PositionPopup(AnOwner: TCustomActionBar;
  ParentItem: TCustomActionControl);
begin
  inherited PositionPopup(AnOwner, ParentItem);
  if (ParentItem is TCustomMenuItem) and (Left > ParentItem.Parent.BoundsRect.Left) then
    Left := ParentItem.Parent.BoundsRect.Right - 6;
end;

{ TStandardAddRemoveItem }

procedure TStandardAddRemoveItem.DrawGlyph(const Location: TPoint);
var
  FrameRect: TRect;
begin
  if HasGlyph then
  begin
    FrameRect := Rect(Location.X - 1, 0, Location.X + 18, Self.Height);
    if ((Selected and Enabled) or (Selected and not MouseSelected)) or IsChecked then
    begin
      Inc(FrameRect.Top, EdgesOffset[ebTop in Edges]);
      Dec(FrameRect.Bottom, EdgesOffset[ebBottom in Edges]);
      if not (csDesigning in ComponentState) then
        Windows.DrawEdge(Canvas.Handle, FrameRect, FrameStyle[IsChecked],
          FillStyles[Transparent] or BF_RECT);
      if not Transparent then
      begin
        if not Selected then
          Canvas.Brush.Bitmap := AllocPatternBitmap(Menu.ColorMap.Color,
            GetHighLightColor(Menu.ColorMap.Color))
        else
          Canvas.Brush.Color := Menu.ColorMap.Color;
        InflateRect(FrameRect, -1, -1);
        Canvas.FillRect(FrameRect);
      end;
    end;
  end;
  if not HasGlyph and IsChecked then
  begin
    Canvas.Pen.Color := Menu.ColorMap.FontColor;
    DrawCheck(Canvas, Point(Location.X + 4, Location.Y + 4), 2);
  end;
  inherited DrawGlyph(Location);
  if IsActionVisible then
  begin
    FrameRect := Rect(2 - 1, 0, 18, Self.Height);
    Inc(FrameRect.Top, EdgesOffset[ebTop in Edges]);
    Dec(FrameRect.Bottom, EdgesOffset[ebBottom in Edges]);
    if not (csDesigning in ComponentState) then
      Windows.DrawEdge(Canvas.Handle, FrameRect, FrameStyle[True],
        FillStyles[False] or BF_RECT);
    if not Transparent then
    begin
      if not Selected then
        Canvas.Brush.Bitmap := AllocPatternBitmap(Menu.ColorMap.Color,
          GetHighLightColor(Menu.ColorMap.Color))
      else
        Canvas.Brush.Color := GetHighLightColor(Menu.ColorMap.Color);
      InflateRect(FrameRect, -1, -1);
      Canvas.FillRect(FrameRect);
    end;
    DrawCheck(Canvas, Point(6, Height div 2 + 1), 2, True);
  end;
end;

procedure TStandardAddRemoveItem.DrawBackground(var PaintRect: TRect);
begin
  if ActionClient = nil then exit;

  if ((Selected and Enabled) or (Selected and not MouseSelected)) and
     not ActionBar.DesignMode then
  begin
    if ActionClient.HasGlyph or IsChecked then
      Inc(PaintRect.Left, 22)
    else
      Inc(PaintRect.Left);
    Dec(PaintRect.Right, 2);
  end;
  if Selected then
    Canvas.Brush.Color := ActionBar.ColorMap.SelectedColor;
  if ActionClient.Unused and not Selected then
    Canvas.Brush.Color := ActionBar.ColorMap.UnusedColor;
  if Selected and ActionBar.DesignMode and not ActionClient.HasItems then
    if ActionClient.Unused then
      Canvas.Brush.Color := ActionBar.ColorMap.UnusedColor
    else
      Canvas.Brush.Color := ActionBar.ColorMap.MenuColor;
  inherited DrawBackground(PaintRect);
end;

{ TStandardCustomizePopup }

function TStandardCustomizePopup.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  Result := inherited CanAutoSize(NewWidth, NewHeight);
//  Inc(NewHeight, 2);
end;

procedure TStandardCustomizePopup.PositionPopup(AnOwner: TCustomActionBar;
  ParentItem: TCustomActionControl);
begin
  inherited PositionPopup(AnOwner, ParentItem);
//  Left := Left - 5;
//  Top := Top - 3;
end;

{ TStandardMenuButton }

procedure TStandardMenuButton.DrawBackground(var PaintRect: TRect);
begin
  if Selected then
    Canvas.Brush.Color := ActionBar.ColorMap.BtnSelectedColor
  else
    Canvas.Brush.Color := ActionBar.ColorMap.Color;
  inherited;
end;

procedure TStandardMenuButton.DrawDesignFocus(var PaintRect: TRect);
begin
  if Mouse.IsDragging then exit;
  inherited;
end;

procedure TStandardMenuButton.DrawFrame(ARect: TRect; Down: Boolean);
var
  Clrs: array[Boolean] of TColor;
begin
  inherited;
  if (FState = bsDown) or not Flat or MouseInControl or IsChecked then
  begin
    Clrs[False] := ActionBar.ColorMap.FrameTopLeftInner;
    Clrs[True] := ActionBar.ColorMap.FrameBottomRightInner;
    Canvas.Pen.Color := Clrs[Down];
    Canvas.MoveTo(ARect.Right - Integer(not Down), ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Bottom - Integer(not Down));
    Canvas.Pen.Color := Clrs[not Down];
    Canvas.MoveTo(ARect.Right - 1, ARect.Top - Integer(Down));
    Canvas.LineTo(ARect.Right - 1, ARect.Bottom - 1);
    Canvas.LineTo(ARect.Left{-1 }+ Integer(Down), ARect.Bottom - 1);
  end;
end;

procedure TStandardMenuButton.DrawText(var ARect: TRect;
  var Flags: Cardinal; Text: String);
begin
  if not (csDesigning in ComponentState) and ((FState = bsDown) or IsChecked) then
    OffsetRect(ARect, 1, 1);
  inherited DrawText(ARect, Flags, Text);
end;

{ TStandardToolScrollBtn }

procedure TStandardToolScrollBtn.DrawFrame(ARect: TRect; Down: Boolean);
var
  Clrs: array[Boolean] of TColor;
begin
  if MouseInControl then
  begin
    Clrs[False] := ActionBar.ColorMap.FrameTopLeftInner;
    Clrs[True] := ActionBar.ColorMap.FrameBottomRightInner;
    Canvas.Pen.Color := Clrs[Down];
    Canvas.MoveTo(ARect.Right - Integer(not Down), ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Bottom - Integer(not Down));
    Canvas.Pen.Color := Clrs[not Down];
    Canvas.MoveTo(ARect.Right - 1, ARect.Top - Integer(Down));
    Canvas.LineTo(ARect.Right - 1, ARect.Bottom - 1);
    Canvas.LineTo(ARect.Left{-1 }+ Integer(Down), ARect.Bottom - 1);
  end;
end;

{ TStandardButtonControl }

procedure TStandardButtonControl.DrawFrame(ARect: TRect; Down: Boolean);
var
  Clrs: array[Boolean] of TColor;
begin
  inherited;
  if (FState = bsDown) or not Flat or MouseInControl or IsChecked then
  begin
    Clrs[False] := ActionBar.ColorMap.FrameTopLeftInner;
    Clrs[True] := ActionBar.ColorMap.FrameBottomRightInner;
    Canvas.Pen.Color := Clrs[Down];
    Canvas.MoveTo(ARect.Right - Integer(not Down), ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Bottom - Integer(not Down));
    Canvas.Pen.Color := Clrs[not Down];
    Canvas.MoveTo(ARect.Right - 1, ARect.Top - Integer(Down));
    Canvas.LineTo(ARect.Right - 1, ARect.Bottom - 1);
    Canvas.LineTo(ARect.Left{-1 }+ Integer(Down), ARect.Bottom - 1);
  end;
end;

procedure TStandardButtonControl.DrawGlyph(const Location: TPoint);
var
  NewLocation: TPoint;
begin
  NewLocation := Location;
  if not (csDesigning in ComponentState) and ((FState = bsDown) or IsChecked) then
  begin
    Inc(NewLocation.X);
    Inc(NewLocation.Y);
  end;
  inherited DrawGlyph(NewLocation);
end;

procedure TStandardButtonControl.DrawText(var ARect: TRect;
  var Flags: Cardinal; Text: String);
begin
  if not (csDesigning in ComponentState) and ((FState = bsDown) or IsChecked) then
    OffsetRect(ARect, 1, 1);
  Canvas.Font.Color := ActionBar.ColorMap.FontColor;
  inherited;
end;

{ TStandardMenuExpandBtn }

procedure TStandardMenuExpandBtn.DrawBackground(var PaintRect: TRect);
begin
  Canvas.Brush.Color := Menu.ColorMap.MenuColor;
  Canvas.FillRect(PaintRect);
  inherited;
  if ((FState = bsDown) or not Flat or MouseInControl or IsChecked) then
  begin
    Canvas.Brush.Color := Menu.ColorMap.UnusedColor;
    Canvas.FillRect(PaintRect);
  end;
end;

procedure TStandardMenuExpandBtn.DrawFrame(ARect: TRect; Down: Boolean);
var
  Clrs: array[Boolean] of TColor;
begin
  OffsetRect(ARect, 0, 1);
  InflateRect(ARect, -2, -4);
  inherited;
  if (FState = bsDown) or not Flat or MouseInControl or IsChecked then
  begin
    Clrs[False] := Menu.ColorMap.FrameTopLeftInner;
    Clrs[True] := Menu.ColorMap.FrameBottomRightInner;
    Clrs[False] := ActionBar.ColorMap.FrameTopLeftInner;
    Clrs[True] := ActionBar.ColorMap.FrameBottomRightInner;
    Canvas.Pen.Color := Menu.ColorMap.FrameTopLeftInner;;//Clrs[Down];
    Canvas.MoveTo(ARect.Right - Integer(not Down), ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Top);
    Canvas.LineTo(ARect.Left, ARect.Bottom - Integer(not Down));
    Canvas.Pen.Color := Menu.ColorMap.FrameBottomRightInner;//Clrs[not Down];
    Canvas.MoveTo(ARect.Right - 1, ARect.Top - Integer(Down));
    Canvas.LineTo(ARect.Right - 1, ARect.Bottom - 1);
    Canvas.LineTo(ARect.Left{-1 }+ Integer(Down), ARect.Bottom - 1);
  end;
end;

end.