xpactnctrls.pas

天涯進銷存系統

    Canvas.MoveTo(RW.Right - 2, RW.Top + 1);
    Canvas.LineTo(RW.Right - 2, RW.Bottom - 2);
    Canvas.LineTo(RW.Left, RW.Bottom - 2);

    if Assigned(ActionClient) and (ColorMap.BtnSelectedColor <> ColorMap.FrameTopLeftOuter) and
       (ParentControl is TXPStyleMenuButton) then
    begin
      Offset := ParentControl.Parent.ClientToScreen(ParentControl.BoundsRect.TopLeft);
      if BoundsRect.Bottom <= Offset.Y then
        Offset.Y := RW.Bottom - 1
      else
        Offset.Y := 0;
      Canvas.MoveTo(Offset.X - Left + 1, Offset.Y);
      Canvas.Pen.Color := ColorMap.BtnSelectedColor;
      Canvas.LineTo(Offset.X - Left + ParentControl.Width - 1, Offset.Y);
    end;

  finally
    Canvas.Handle := OldHandle;
  end;
end;

procedure TXPStylePopupMenu.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 - 1
  else if ParentItem is TCustomMenuButton and (Left > ParentItem.BoundsRect.Left) then
    Left := Left - 1;
end;

procedure TXPStylePopupMenu.VisibleChanging;
begin
  if ParentControl is TCustomButtonControl then
    ParentControl.Invalidate;
  inherited;
end;

{ TXPStyleExpandBtn }

procedure TXPStyleExpandBtn.DrawBackground(var PaintRect: TRect);
var
  BannerRect: TRect;
begin
  Canvas.Brush.Color := Menu.ColorMap.MenuColor;
  Canvas.FillRect(PaintRect);
  BannerRect := PaintRect;
  BannerRect.Right := 25;
  Canvas.Brush.Color := Menu.ColorMap.UnusedColor;
  Canvas.FillRect(BannerRect);
  if ((FState = bsDown) or not Flat or MouseInControl or IsChecked) then
  begin
    OffsetRect(PaintRect, 0, 1);
    InflateRect(PaintRect, -2, -4);
    Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Canvas.FillRect(PaintRect);
  end;
end;

procedure TXPStyleExpandBtn.DrawFrame(ARect: TRect; Down: Boolean);
begin
  if Enabled and ((FState = bsDown) or not Flat or MouseInControl or IsChecked) then
  begin
    OffsetRect(ARect, 0, 1);
    InflateRect(ARect, -2, -4);
    Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
    Canvas.Rectangle(ARect);
  end;
end;

{ TXPStyleButton }

procedure TXPStyleButton.DrawBackground(var PaintRect: TRect);
begin
  if Enabled and not (ActionBar.DesignMode) then
  begin
    if (MouseInControl or IsChecked) and
       (Assigned(ActionClient) and not ActionClient.Separator) then
      Canvas.Brush.Color := ActionBar.ColorMap.SelectedColor
    else
      Canvas.Brush.Color := ActionBar.ColorMap.Color;
  end
  else
    Canvas.Brush.Color := ActionBar.ColorMap.Color;
  inherited DrawBackground(PaintRect);
end;

procedure TXPStyleButton.DrawFrame(ARect: TRect; Down: Boolean);
begin
  if not ActionBar.DesignMode and Enabled and
     ((FState = bsDown) or not Flat or MouseInControl or IsChecked) then
  begin
    Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(ARect);
  end;
end;

procedure TXPStyleButton.DrawGlyph(const Location: TPoint);
var
  OldBrushColor: TColor;
  SelBmp: TBitmap;
  NewLocation: TPoint;
  ActionList: TCustomActionList;
begin
  NewLocation := Location;
  if not ActionBar.DesignMode and MouseInControl and
     not IsChecked and Enabled and ActionClient.HasGlyph then
  begin
    OldBrushColor := Canvas.Brush.Color;
    SelBmp := TBitmap.Create;
    try
      ActionList := ActionClient.Action.ActionList;
      if ActionList.Images.GetBitmap(ActionClient.ImageIndex, SelBmp) then
      begin
        Canvas.Brush.Color := GetShadowColor(ActionBar.ColorMap.SelectedColor);
        SelBmp.Width := ActionList.Images.Width;
        SelBmp.Height := ActionList.Images.Width;
        DrawState(Canvas.Handle, Canvas.Brush.Handle, nil, SelBmp.Handle, 0,
          NewLocation.X + 1, NewLocation.Y + 1, 0, 0, DST_BITMAP or DSS_MONO);
      end;
    finally
      SelBmp.Free;
      Canvas.Brush.Color := OldBrushColor;
    end;
    if not IsChecked then
    begin
      Dec(NewLocation.X);
      Dec(NewLocation.Y);
    end;
  end;
  if not (csDesigning in ComponentState) and ((FState = bsDown) and not IsChecked)
     and IsMouseButtonPressed then
  begin
    Inc(NewLocation.X);
    Inc(NewLocation.Y);
  end;
  inherited DrawGlyph(NewLocation);
end;

procedure TXPStyleButton.DrawText(var ARect: TRect; var Flags: Cardinal;
  Text: String);
begin
  if MouseInControl and (ActionBar.ColorMap.HotFontColor <> clDefault) then
    Canvas.Font.Color := ActionBar.ColorMap.HotFontColor;
  OffsetRect(ARect, 0, 1);
  inherited;
end;

{ TXPStyleDropDownBtn }

procedure TXPStyleDropDownBtn.DrawBackground(var PaintRect: TRect);
begin
  if Enabled and not (ActionBar.DesignMode) then
  begin
    if (MouseInControl or IsChecked) and Assigned(ActionClient) then
      Canvas.Brush.Color := ActionBar.ColorMap.SelectedColor
    else
      Canvas.Brush.Color := ActionBar.ColorMap.Color;
  end
  else
    Canvas.Brush.Color := ActionBar.ColorMap.Color;
  inherited DrawBackground(PaintRect);
end;

procedure TXPStyleDropDownBtn.DrawFrame(ARect: TRect; Down: Boolean);
begin
  if Enabled and not (ActionBar.DesignMode) then
    if (MouseInControl or IsChecked) and Assigned(ActionClient) then
    begin
      Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
      Dec(ARect.Right, 9);
      Canvas.Rectangle(ARect);
      ARect.Left := ARect.Right - 1;
      Inc(ARect.Right, 9);
      Canvas.Rectangle(ARect);
    end;
end;

procedure TXPStyleDropDownBtn.DrawGlyph(const Location: TPoint);
var
  OldBrushColor: TColor;
  SelBmp: TBitmap;
  NewLocation: TPoint;
  ActionList: TCustomActionList;
begin
  NewLocation := Location;
  if not ActionBar.DesignMode and MouseInControl and
     not IsChecked and Enabled and ActionClient.HasGlyph then
  begin
    OldBrushColor := Canvas.Brush.Color;
    SelBmp := TBitmap.Create;
    try
      ActionList := TAction(Action).ActionList;
      if ActionList.Images.GetBitmap(ActionClient.ImageIndex, SelBmp) then
      begin
        Canvas.Brush.Color := GetShadowColor(ActionBar.ColorMap.SelectedColor);
        SelBmp.Width := ActionList.Images.Width;
        SelBmp.Height := ActionList.Images.Width;
        DrawState(Canvas.Handle, Canvas.Brush.Handle, nil, SelBmp.Handle, 0,
          NewLocation.X + 1, NewLocation.Y + 1, 0, 0, DST_BITMAP or DSS_MONO);
      end;
    finally
      SelBmp.Free;
      Canvas.Brush.Color := OldBrushColor;
    end;
    if not IsChecked then
    begin
      Dec(NewLocation.X);
      Dec(NewLocation.Y);
    end;
  end;
  if not (csDesigning in ComponentState) and ((FState = bsDown) and not IsChecked)
     and IsMouseButtonPressed then
  begin
    Inc(NewLocation.X);
    Inc(NewLocation.Y);
  end;
  inherited DrawGlyph(NewLocation);
end;

function TXPStyleDropDownBtn.GetPopupClass: TCustomActionBarClass;
begin
  Result := TXPStylePopupMenu;
end;

{ TXPStyleCustomizePopup }

constructor TXPStyleCustomizePopup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  VertMargin := 0;
end;

function TXPStyleCustomizePopup.GetAddRemoveItemClass: TCustomAddRemoveItemClass;
begin
  Result := TXPStyleAddRemoveItem;
end;

function TXPStyleCustomizePopup.GetDefaultColorMapClass: TCustomColorMapClass;
begin
  Result := TXPColorMap;
end;

procedure TXPStyleCustomizePopup.NCPaint(DC: HDC);
var
  RC, RW: TRect;
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);
  try
    Canvas.Handle := DC;
    Canvas.Pen.Color := ColorMap.FrameTopLeftOuter;
    Canvas.Brush.Color := ColorMap.Color;
    Canvas.Rectangle(RW);
    Canvas.Pen.Color := ColorMap.BtnSelectedColor;
    Canvas.MoveTo(1,1);
    Canvas.LineTo(1, Height - 1);
  finally
    IntersectClipRect(Canvas.Handle, RW.Left, RW.Top, RW.Right, RW.Bottom);
    Canvas.Handle := 0;
  end;
end;

{ TXPStyleAddRemoveItem }

procedure TXPStyleAddRemoveItem.CalcBounds;
begin
  inherited;
  if Separator then
    Height := 3
  else
    Height := Height + 2;
end;

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

  if ActionClient.Color <> clDefault then
    Canvas.Brush.Color := ActionClient.Color;

  BGRect := PaintRect;
  if TextBounds.Left > GlyphPos.X then
    BGRect.Left := 0;
  BannerRect := PaintRect;
  if TextBounds.Left > GlyphPos.X then
    BannerRect.Right := TextBounds.Left - 3
  else
    BannerRect.Right := TextBounds.Right + 3;
  BannerRect.Right := 44;
  BGRect.Left := BannerRect.Right - BannerRect.Left;
  if ActionClient.Unused then
    Canvas.Brush.Color := Menu.ColorMap.UnusedColor
  else
    Canvas.Brush.Color := Menu.ColorMap.BtnSelectedColor;
  inherited DrawBackground(BannerRect);
  Canvas.Brush.Color := Menu.ColorMap.MenuColor;

  if ((Selected and Enabled) or (Selected and not MouseSelected)) then
  begin
    Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Dec(PaintRect.Right, 1);
  end;
  inherited DrawBackground(BGRect);
  if (Selected and Enabled) or (Selected and not MouseSelected) then
  begin
    Canvas.FillRect(PaintRect);
    Canvas.Brush.Color := ActionBar.ColorMap.BtnFrameColor;
    Canvas.FrameRect(PaintRect);
  end;
end;

procedure TXPStyleAddRemoveItem.DrawGlyph(const Location: TPoint);
var
  OldColor, OldBrushColor: TColor;
  NewLocation: TPoint;
  FrameRect: TRect;
  SelBmp: TBitmap;
  ActionList: TCustomActionList;
begin
  if (Assigned(ActionClient) and not ActionClient.HasGlyph) and
     ((Action is TCustomAction) and TCustomAction(Action).Checked) then
  begin
    if IsChecked then
    begin
      FrameRect := Rect(Location.X - 1, 1, Location.X + 20, Self.Height - 1);
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
      Canvas.FillRect(FrameRect);
      Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
      Canvas.Rectangle(FrameRect);
    end;
    Canvas.Pen.Color := Menu.ColorMap.FontColor;
    with Location do
      DrawCheck(Canvas, Point(X + 6, Y + 3), 2)
  end
  else
  begin
    if IsChecked then
    begin
      FrameRect := Rect(Location.X - 1, 1, Location.X + 20, Self.Height - 1);
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
      Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
      Canvas.Rectangle(FrameRect);
    end;
    OldColor := Canvas.Brush.Color;
    if (Selected and Enabled) or (Selected and not MouseSelected) then
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor
    else
      Canvas.Brush.Color := Menu.ColorMap.BtnSelectedColor;
    NewLocation := Location;

    if (Selected and Enabled and ActionClient.HasGlyph) then
    begin
      OldBrushColor := Canvas.Brush.Color;
      SelBmp := TBitmap.Create;
      try
        Canvas.Brush.Color := clBtnShadow;
        ActionList := TAction(Action).ActionList;
        if ActionList.Images.GetBitmap(ActionClient.ImageIndex, SelBmp) then
        begin
          SelBmp.Width := ActionList.Images.Width;
          SelBmp.Height := ActionList.Images.Width;
          DrawState(Canvas.Handle, Canvas.Brush.Handle, nil, SelBmp.Handle, 0,
            NewLocation.X + 3, NewLocation.Y + 2, 0, 0, DST_BITMAP or DSS_MONO);
        end;
      finally
        SelBmp.Free;
        Canvas.Brush.Color := OldBrushColor;
      end;

      Inc(NewLocation.X, 1);
      inherited DrawGlyph(NewLocation);
    end
    else begin
      Inc(NewLocation.X, 2);
      Inc(NewLocation.Y, 1);
      inherited DrawGlyph(NewLocation);
    end;
    Canvas.Brush.Color := OldColor;
  end;
  if Menu.RootMenu.ParentControl.ActionBar.ActionClient.Items[ActionClient.Index].Visible then
  begin
    FrameRect := Rect(2 - 1, 1, 18, Self.Height - 1);
    Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Canvas.FillRect(FrameRect);
    Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
    Canvas.Rectangle(FrameRect);
    Canvas.Pen.Color := Menu.ColorMap.FontColor;
    with Location do
      DrawCheck(Canvas, Point(FrameRect.Left + 5, Self.Height div 2 - 1), 2);
  end;
end;

procedure TXPStyleAddRemoveItem.DrawSeparator(const Offset: Integer);
var
  PaintRect: TRect;
  PR: TPenRecall;
  BR: TBrushRecall;
begin
  if Selected then
    Canvas.FillRect(ClientRect);
  BR := TBrushRecall.Create(Canvas.Brush);
  PR := TPenRecall.Create(Canvas.Pen);
  try
    if Assigned(ActionClient) and ActionClient.Unused and not Transparent then
      Canvas.Brush.Style := bsSolid
    else
    begin
      Canvas.Brush.Color := Color;
      PaintRect := BoundsRect;
      Windows.DrawEdge(Canvas.Handle, PaintRect, BDR_RAISEDINNER, BF_LEFT);
      Windows.DrawEdge(Canvas.Handle, PaintRect, BDR_RAISEDINNER, BF_RIGHT);
    end;
    Canvas.Pen.Color := clBtnShadow;
    Canvas.MoveTo(32, ClientHeight div 2);
    Canvas.LineTo(ClientWidth, ClientHeight div 2);
  finally
    BR.Free;
    PR.Free;
  end;
end;

procedure TXPStyleAddRemoveItem.DrawText(var Rect: TRect; var Flags: Cardinal;
  Text: String);
var
  S: string;
begin
  S := Text;
  if Parent is TCustomActionBar then
    if not TCustomActionBarType(Parent).PersistentHotkeys then
      begin
        if Pos('&', S) > 0 then
          Delete(S, Pos('&', S), 1);
      end;
  Text := S;
  OffsetRect(Rect, 6, 0);
  if Enabled then
    Canvas.Font.Color := Menu.ColorMap.FontColor
  else
    Canvas.Font.Color := Menu.ColorMap.DisabledFontColor;
  inherited DrawText(Rect, Flags, Text);
end;

procedure TXPStyleAddRemoveItem.DrawUnusedEdges;
begin
// This style of menu item does not have unused edges
end;

{ TXPStyleToolScrollBtn }

procedure TXPStyleToolScrollBtn.DrawBackground(var PaintRect: TRect);
begin
  if Enabled and MouseInControl then
      Canvas.Brush.Color := ActionBar.ColorMap.SelectedColor
  else
    Canvas.Brush.Color := ActionBar.ColorMap.Color;
  inherited DrawBackground(PaintRect);
  if Enabled and MouseInControl then
  begin
    Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
    Canvas.Rectangle(ClientRect);
  end;
end;

end.