How to modernize the look of the TJvCaptionPanel buttons? - delphi

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?

Answer 1

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.