How to modernize the look of the TJvCaptionPanel buttons?

Question

I use a TJvCaptionPanel in Delphi 10.4 to show a panel with a caption and buttons:

(TJvCaptionPanel is part of the OpenSource JEDI Visual Component Library available from GetIt)

This is the object code of the JvCaptionPanel1 object instance, so you can paste it in the Form Designer:

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

Although JvCaptionPanel1.FlatButtons = True, as you can see from the above screenshot, the buttons have an old-fashioned "stone-age" "Atari" pixelized look:

This contrasts with the otherwise modern look of my application.

Is it possible to "modernize" the look of the buttons to make them appear more "modern"? How could this be done?

I suppose you are aware of the new (but buggy) [custom title bar feature in 10.4](http://docwiki.embarcadero.com/RADStudio/Sydney/en/Custom_Title_Bar_for_VCL_Forms) but isn't happy with it? If so, you might possibly find https://stackoverflow.com/questions/6550249/how-best-to-create-a-tpanel-with-a-close-cross-button-in-the-top-right interesting. — Andreas Rejbrand, Aug 30 '20 at 12:36
@AndreasRejbrand I have already tried `TTitleBarPanel`, but it seems it does not work on a `TPanel`. `TTitleBarPanel` seems can only replace a Form's TitleBar. — user1580348, Aug 30 '20 at 17:29
@AndreasRejbrand I have also looked at your nice `TCloseButton` component. But what I would need is an optimal organic combination of a CaptionPanel and a Close button. So I ended up using a `Tpanel` and a `TSpeedButton`: https://i.imgur.com/y2XyOub.png It is not optimal because I have to repeat that on each `TCard` and chances are good that some difference will happen. What I would also need in this case to keep all those component combinations synchronized. Maybe I should write a `TSynchronizer` component... — user1580348, Aug 30 '20 at 18:05
You can create your own custom control that looks and behaves exactly like your panel + button. That way, you can drop a new such panel on a container as easily as you can drop any other component, and you are guaranteed that they will all look the same. — Andreas Rejbrand, Aug 30 '20 at 18:08
I have found something here: https://stackoverflow.com/questions/45722476/creating-a-new-component-by-combining-two-controls-tedit-and-ttrackbar-in-delp - let's try it out... — user1580348, Aug 30 '20 at 18:15
The most simple way would be 1. Select the two controls in Form Designer 2. In the context menu select "Combine the selected controls into a new control" 3. This would then AUTOMATICALLY create a new component containing these two controls. but sigh... this context menu entry does not exist :-( — user1580348, Aug 30 '20 at 18:19
BTW, am I allowed to create a descendant of `TCard`/`TCardPanel` and put that on GitHub for example? — user1580348, Aug 30 '20 at 18:43

Andreas Rejbrand · Answer 1 · 2020-08-30T21:07:48.880

If I were you, I'd create a custom control:

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.

Here I chose to implement the close button manually in code. It wouldn't be any more difficult to use a TSpeedButton control instead. In fact, it would be simpler, but then you wouldn't get full control over its appearance and behaviour.

How to modernize the look of the TJvCaptionPanel buttons?

1 Answers1