如何使 TJvCaptionPanel 按钮的外观现代化？答案

【问题标题】：How to modernize the look of the TJvCaptionPanel buttons?如何使 TJvCaptionPanel 按钮的外观现代化？
【发布时间】：2020-12-18 18:50:54
【问题描述】：

我在 Delphi 10.4 中使用 TJvCaptionPanel 来显示带有标题和按钮的面板：

（TJvCaptionPanel 是 OpenSource JEDI Visual Component Library 的一部分，可从 GetIt 获得）

这是JvCaptionPanel1对象实例的对象代码，所以你可以将它粘贴到表单设计器中：

object JvCaptionPanel1: TJvCaptionPanel
  Left = 560
  Top = 79
  Width = 210
  Height = 306
  Align = alRight
  Buttons = [capClose, capHelp]
  Caption = 'My Test Caption'
  CaptionPosition = dpTop
  CaptionFont.Charset = DEFAULT_CHARSET
  CaptionFont.Color = clWhite
  CaptionFont.Height = -13
  CaptionFont.Name = 'Tahoma'
  CaptionFont.Style = [fsBold]
  FlatButtons = True
  Icon.Data = {
    0000010001001010000001002000680400001600000028000000100000002000
    0000010020000000000040040000000000000000000000000000000000000000
    00000000000000000000777777A4777777E07777773177777763777777887777
    7788777777617777772D777777DF777777A80000000000000000000000000000
    00000000000000000000777777C5787878FE7F7F7FFDA9A9A9FDC0C0C0FDBFBF
    BFFDA8A8A8FD7F7F7FFD787878FE777777C90000000000000000000000000000
    0000000000007676760E777777CBABABABFDF4F4F4FDFDFDFDFDFDFDFDFDFDFD
    FDFDFDFDFDFDF4F4F4FDA9A9A9FD777777C77777770C00000000000000000000
    000000000000777777A8B0B0B0FDFCFCFCFDFDFDFDFDFDFDFDFDFDFDFDFDFDFD
    FDFDFDFDFDFDEADCCEFCF2EAE2FCAEAEAEFD777777A300000000000000000000
    000076767635898989FDF9F9F9FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFD
    FDFDDDC4ACFCCDA782FCFCFCFCFCF8F8F8FD888888FD77777730000000000000
    00007777778EBEBEBEFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFCFCFCFCD5B5
    96FCBE8D5CFCF9F6F3FCFDFDFDFDFDFDFDFDBCBCBCFD77777789000000000000
    0000777777BDDBDBDBFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDD7B99BFCB883
    4DFCF3EBE3FCFDFDFDFDFDFDFDFDFDFDFDFDD9D9D9FD777777B7000000000000
    0000777777C6E0E0E0FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDC59A6FFCDEC7
    AFFCFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDDEDEDEFD777777C1000000000000
    0000777777AACFCFCFFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDCAA37BFCE4D0
    BDFCFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDCCCCCCFD777777A4000000000000
    000077777766A4A4A4FDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDD1AF8DFCE8D8
    C8FCFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDA2A2A2FD77777761000000000000
    00007372710C797979E7DFDFDFFDFDFDFDFDFDFDFDFDFDFDFDFDDBC2A8FCF0E7
    DEFCFDFDFDFDFDFDFDFDFDFDFDFDDDDDDDFD787878E378767509000000000000
    0000A47547088376694C848484FBE5E5E5FCFDFDFDFCFDFDFDFCF1E8E0FCFBFA
    F9FCFDFDFDFCFDFDFDFCE4E4E4FC838383FA80766C47A2764A08000000000000
    0000B1773C9FA7764445827568557B7B7BF1B6B6B6FCE8E8E8FCFCFCFCFCFCFC
    FCFCE7E7E7FCB5B5B5FC7B7B7BF07E756B51A476483DB1773CA8000000000000
    0000B1773CB7B1773CF5AB77425F8F765C1D7B76718F777676DD7A7A7AFC7A7A
    7AFC767676DC7A76728D8C755F1BA8764457B1773DF2B1773CCA000000000000
    0000B1763B3CB1773CF5B2783DFEB1773DC2A9774357000000005D5D5D065D5D
    5D0600000000A8774552B0773DBCB2783DFEB2783DFCB1773C56000000000000
    000000000000B1773B2FB1773CBAB1773CE6B1773C6F00000000000000000000
    000000000000B1773C68B1773CEFB1773CD1B1763B470000000000000000E007
    0000E0070000C0030000C0030000800100008001000080010000800100008001
    0000800100008001000080010000800100008001000082410000C3C30000}
  OutlookLook = False
  Resizable = False
  TabOrder = 2
  OnButtonClick = JvCaptionPanel1ButtonClick
end

虽然JvCaptionPanel1.FlatButtons = True，从上面的截图中可以看出，按钮具有老式的“石器时代”“雅达利”像素化外观：

这与我的应用程序的现代外观形成鲜明对比。

是否可以“现代化”按钮的外观以使其看起来更“现代”？这怎么可能？

【问题讨论】：

我想你知道新的（但有问题的）custom title bar feature in 10.4 但对它不满意？如果是这样，您可能会觉得 stackoverflow.com/questions/6550249/… 很有趣。
@AndreasRejbrand 我已经尝试过TTitleBarPanel，但它似乎不适用于TPanel。 TTitleBarPanel 似乎只能替换 Form 的 TitleBar。
@AndreasRejbrand 我还看了你漂亮的TCloseButton 组件。但我需要的是 CaptionPanel 和关闭按钮的最佳有机组合。所以我最终使用了Tpanel 和TSpeedButton：i.imgur.com/y2XyOub.png 这不是最优的，因为我必须在每个TCard 上重复这一点，而且很有可能会发生一些差异。在这种情况下，我还需要保持所有这些组件组合同步。也许我应该写一个TSynchronizer 组件...
您可以创建自己的自定义控件，其外观和行为与您的面板 + 按钮完全相同。这样，您可以像拖放任何其他组件一样轻松地将新的此类面板拖放到容器上，并且可以保证它们看起来都一样。
你会怎么做？

标签： delphi jvcl delphi-10.4-sydney

【解决方案1】：

如果我是你，我会创建一个自定义控件：

unit PanelCaption;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Graphics, Controls,
  StdCtrls, Forms;

type
  TPanelCaption = class(TCustomControl)
  private
    FTextColor: TColor;
    FCloseBtnHot: Boolean;
    FCloseBtnDown: Boolean;
    FCloseBtnClicked: TNotifyEvent;
    procedure SetTextColor(const Value: TColor);
    function CloseBtnRect: TRect;
    procedure DoCloseBtnClicked;
  protected
    procedure Paint; override;
    procedure Resize; override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Color;
    property TextColor: TColor read FTextColor write SetTextColor;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Padding;
    property ParentBackground;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont default True;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    property StyleElements;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnClick;
    property OnCloseBtnClick: TNotifyEvent read FCloseBtnClicked write FCloseBtnClicked;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDockDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

uses
  Math;

function Scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

{ TPanelCaption }

function TPanelCaption.CloseBtnRect: TRect;
begin
  Result := Rect(ClientWidth - ClientHeight, 0, ClientWidth, ClientHeight);
end;

procedure TPanelCaption.CMMouseLeave(var Message: TMessage);
begin
  if FCloseBtnHot or FCloseBtnDown then
  begin
    FCloseBtnHot := False;
    FCloseBtnDown := False;
    InvalidateRect(Handle, CloseBtnRect, False);
  end;
end;

procedure TPanelCaption.CMTextChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

constructor TPanelCaption.Create(AOwner: TComponent);
begin
  inherited;
  Color := clActiveCaption;
  FTextColor := clCaptionText;
end;

procedure TPanelCaption.DoCloseBtnClicked;
begin
  if Assigned(FCloseBtnClicked) then
    FCloseBtnClicked(Self);
end;

procedure TPanelCaption.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if Button = mbLeft then
  begin
    FCloseBtnDown := CloseBtnRect.Contains(Point(X, Y));
    if FCloseBtnDown then
      InvalidateRect(Handle, CloseBtnRect, False);
  end;
end;

procedure TPanelCaption.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LCloseButtonHot: Boolean;
begin
  LCloseButtonHot := CloseBtnRect.Contains(Point(X, Y));
  if LCloseButtonHot <> FCloseBtnHot then
  begin
    FCloseBtnHot := LCloseButtonHot;
    InvalidateRect(Handle, CloseBtnRect, False);
  end;
end;

procedure TPanelCaption.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if FCloseBtnDown then
  begin
    FCloseBtnDown := False;
    InvalidateRect(Handle, CloseBtnRect, False);
    if CloseBtnRect.Contains(Point(X, Y)) then
      DoCloseBtnClicked;
  end;
end;

procedure GetActualTextHeight(DC: HDC; out H: Integer);
var
  m: TTextMetric;
begin
  if GetTextMetrics(DC, m) then
    H := m.tmHeight - m.tmDescent - m.tmExternalLeading - m.tmInternalLeading
  else
    H := Scale(20);
end;

procedure TPanelCaption.Paint;
var
  R: TRect;
  S: string;
  XHeight: Integer;
  SizeReduction: Integer;
begin
  inherited;

  Canvas.Brush.Color := Color;
  Canvas.Font.Assign(Font);
  Canvas.Font.Color := FTextColor;

  R := ClientRect;
  Dec(R.Right, ClientHeight);
  Canvas.FillRect(R);

  S := #32 + Caption;
  Canvas.TextRect(R, S, [tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis]);

  R := CloseBtnRect;
  Canvas.Brush.Color := IfThen(FCloseBtnHot, IfThen(FCloseBtnDown, clBlack, clWhite), Color);
  Canvas.FillRect(R);
  GetActualTextHeight(Canvas.Handle, XHeight);
  SizeReduction := R.Height - XHeight;
  if SizeReduction > 0 then
    R.Inflate(-SizeReduction div 2, -SizeReduction div 2);
  Canvas.Pen.Color := IfThen(FCloseBtnHot, IfThen(FCloseBtnDown, clWhite, clBlack), Font.Color);
  Canvas.Pen.Width := Scale(2);
  Canvas.MoveTo(R.Left, R.Top);
  Canvas.LineTo(R.Right, R.Bottom);
  Canvas.MoveTo(R.Right, R.Top);
  Canvas.LineTo(R.Left, R.Bottom);

end;

procedure TPanelCaption.Resize;
begin
  inherited;
  Invalidate;
end;

procedure TPanelCaption.SetTextColor(const Value: TColor);
begin
  if FTextColor <> Value then
  begin
    FTextColor := Value;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TPanelCaption]);
end;

end.

这里我选择在代码中手动实现关闭按钮。改用TSpeedButton 控件将不再困难。事实上，它会更简单，但您无法完全控制它的外观和行为。

【讨论】：