I am using the TForm.CustomTitleBar property and new TTitleBarPanel control, which allow you to customize a VCL form's native title bar similar to Windows Explorer, Google Chrome, or other applications.
The WMClose() handler is not working anymore, whereas the old title bar with the default close button works fine, but now it's not automatically hitting the WMClose(). Here I am using the new customeTitle bar provided by Delphi with SystemButton set as False.
.PAS
unit CodeTreeForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
System.Actions,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ComCtrls,
Vcl.TitleBarCtrls,
Vcl.Menus,
Vcl.StdActns,
Vcl.ExtActns,
Vcl.ActnList,
Vcl.PlatformDefaultStyleActnCtrls,
Vcl.ActnMan,
Vcl.ToolWin,
Vcl.ActnCtrls,
Vcl.ActnMenus,
Vcl.Imaging.pngimage,
Vcl.ExtCtrls;
type
TfrmCodeTree = class(TForm)
TitleBarPanel1: TTitleBarPanel;
ActionManager1: TActionManager;
DialogOpenPicture1: TOpenPicture;
DialogSavePicture1: TSavePicture;
DialogColorSelect1: TColorSelect;
DialogFontEdit1: TFontEdit;
DialogPrintDlg1: TPrintDlg;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
EditSelectAll1: TEditSelectAll;
EditUndo1: TEditUndo;
EditDelete1: TEditDelete;
FileOpen1: TFileOpen;
FileOpenWith1: TFileOpenWith;
FileSaveAs1: TFileSaveAs;
FilePrintSetup1: TFilePrintSetup;
FilePageSetup1: TFilePageSetup;
FileRun1: TFileRun;
FileExit1: TFileExit;
BrowseForFolder1: TBrowseForFolder;
InternetBrowseURL1: TBrowseURL;
InternetDownLoadURL1: TDownLoadURL;
InternetSendMail1: TSendMail;
SearchFind1: TSearchFind;
SearchFindNext1: TSearchFindNext;
SearchReplace1: TSearchReplace;
SearchFindFirst1: TSearchFindFirst;
ActionMainMenuBar1: TActionMainMenuBar;
Action1: TAction;
Action2: TAction;
Image1: TImage;
procedure pgcRepositoriesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ActionMainMenuBar1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure WMClose(var Message: TWMClose); message WM_CLOSE;
private
public
end;
var
frmCodeTree: TfrmCodeTree;
implementation
{$R *.dfm}
procedure TfrmCodeTree.FormCreate(Sender: TObject);
begin
// The ActionMainMenuBar does not draw correctly in the title bar area. So DoubleBuffered must be enabled, and
// Transparent must be set to False
ActionMainMenuBar1.DoubleBuffered := True;
ActionMainMenuBar1.Transparent := False;
end;
procedure TfrmCodeTree.ActionMainMenuBar1Paint(Sender: TObject);
begin
// Paint the background of the ActionMainMenuBar. Please note that for this app, the title bar is always the
// same color regardless of whether or not the app is active or inactive.
ActionMainMenuBar1.Canvas.Brush.Color := CustomTitleBar.BackgroundColor;
ActionMainMenuBar1.Canvas.FillRect( ActionMainMenuBar1.ClientRect );
end;
procedure TfrmCodeTree.pgcRepositoriesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
sc_DragMove = $F012;
begin
// This event handler allows the user to drag the form around when clicking on the background area of the tab control
ReleaseCapture;
Perform( wm_SysCommand, sc_DragMove, 0 );
end;
procedure TfrmCodeTree.WMClose(var Message: TWMClose);
begin
;
end;
end.
.DFM
object frmCodeTree: TfrmCodeTree
Left = 353
Top = 0
Caption = 'CodeTree'
ClientHeight = 598
ClientWidth = 1101
Color = clBtnFace
CustomTitleBar.Control = TitleBarPanel1
CustomTitleBar.Enabled = True
CustomTitleBar.Height = 58
CustomTitleBar.SystemHeight = False
CustomTitleBar.SystemColors = False
CustomTitleBar.SystemButtons = False
CustomTitleBar.BackgroundColor = 7875840
CustomTitleBar.ForegroundColor = clWhite
CustomTitleBar.InactiveBackgroundColor = 7875840
CustomTitleBar.InactiveForegroundColor = clWhite
CustomTitleBar.ButtonForegroundColor = clWhite
CustomTitleBar.ButtonBackgroundColor = 7875840
CustomTitleBar.ButtonHoverForegroundColor = clWhite
CustomTitleBar.ButtonHoverBackgroundColor = 7875840
CustomTitleBar.ButtonPressedForegroundColor = clWhite
CustomTitleBar.ButtonPressedBackgroundColor = 7875840
CustomTitleBar.ButtonInactiveForegroundColor = clWhite
CustomTitleBar.ButtonInactiveBackgroundColor = 7875840
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
FormStyle = fsMDIForm
GlassFrame.Enabled = True
GlassFrame.Top = 58
OldCreateOrder = True
Position = poDesigned
ShowHint = True
StyleElements = [seFont, seClient]
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 15
object TitleBarPanel1: TTitleBarPanel
Left = 0
Top = 0
Width = 1101
Height = 57
CustomButtons = <>
object Image1: TImage
AlignWithMargins = True
Left = 3
Top = 3
Width = 24
Height = 26
Margins.Right = 10
Align = alLeft
AutoSize = True
Picture.Data = {
0954506E67496D61676589504E470D0A1A0A0000000D49484452000000180000
001808020000006F15AAAF0000002B744558744372656174696F6E2054696D65
005475652039204E6F7620323032312030343A33363A3230202D30363030BE05
0EFB0000000774494D4507E50B090A320919BE3709000000097048597300000B
1200000B1201D2DD7EFC0000000467414D410000B18F0BFC6105000002064944
415478DA6364775FC6400DC088DF20415E3609414E20E3C5FBEFEF3FFF22D920
0E36E6FA38DD440F65011E36B8E0872FBFD61F795C39E70290419441C66A42F3
4A2DD565F9B0DAFCF4CDB7CC09A7769D794EC0207753C969F966D2225C787CF1
F8D5B7EC49E866A11824C2CF0E34C5CF4A8660D06E38FA386BE2E9779F7E6237
C8CB5C6A5DA33D9A47F69C7B0164B81A4B4A0973224BE54E3E3D7BEB1DEC064D
CA3149F35185730F5D7A15DB7EF4E5FB1F40B6A410E7926A6B6B6D51B8ECB44D
B78AA69DC56ED0EE6E675B5D3108FBFF7F06FFDA03C801E16126B5A109E1DEFD
175E7A56ECC36ED0DD25FEF060061AA410B51EE21C08007AEDD6227F38F7DFFF
FF7C3E2B89725140DDC19DA79FC1651D0CC4A7E79BC1B927AEBF49EC3A4E5418
1DB9F21A18462FDE7E07B285F9D9ABA274B4E4F9E1B29B8E3D0106137683C2EC
E517555A21470DD06BD71F7DBCF5F8132303033B1B335C1CE8DE55071FEE0547
28168384F9D8A71598F9634B47DF7EFE59B6F7C133B0EB80E0E6A34FDB4E3EFD
FEEB2F768380C0CD0494B26544B1A4EC072FBEB62CBD0C32F4C79FE3D7DE3C87
198ADD200670B29C5D6C01741DA6592EA57BFFFEFB7FFFF99717EFBEA34961CF
FD405326E79A06D9CAA289CB45AE07668B3F7FFF636AC1591E3132327CDF1E89
2C020C604ECFE50C38C04834080852BD55C4051145C7CBF7DF91CB0D120C2209
50CD2000A463F8F9066871280000000049454E44AE426082}
Transparent = True
ExplicitLeft = 0
ExplicitTop = 0
ExplicitHeight = 24
end
object ActionMainMenuBar1: TActionMainMenuBar
Left = 0
Top = 32
Width = 1101
Height = 25
UseSystemFont = False
ActionManager = ActionManager1
Align = alBottom
AllowHiding = True
Caption = 'ActionMainMenuBar1'
Color = clMenuBar
ColorMap.DisabledFontColor = 7171437
ColorMap.HighlightColor = clWhite
ColorMap.BtnSelectedFont = clBlack
ColorMap.UnusedColor = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
Spacing = 0
OnPaint = ActionMainMenuBar1Paint
end
end
object ActionManager1: TActionManager
ActionBars = <
item
Items = <
item
Items = <
item
Action = FileOpen1
ImageIndex = 7
ShortCut = 16463
end
item
Action = FileOpenWith1
Caption = 'O&pen with...'
end
item
Action = FileSaveAs1
ImageIndex = 30
end
item
Action = FilePrintSetup1
end
item
Action = FilePageSetup1
Caption = 'Pa&ge Setup...'
end
item
Action = FileRun1
end
item
Action = FileExit1
ImageIndex = 43
end
item
Action = BrowseForFolder1
Caption = '&BrowseForFolder1'
end>
Caption = '&File'
end
item
Items = <
item
Action = EditCut1
ImageIndex = 0
ShortCut = 16472
end
item
Action = EditCopy1
ImageIndex = 1
ShortCut = 16451
end
item
Action = EditPaste1
ImageIndex = 2
ShortCut = 16470
end
item
Action = EditSelectAll1
ShortCut = 16449
end
item
Action = EditUndo1
ImageIndex = 3
ShortCut = 16474
end
item
Action = EditDelete1
ImageIndex = 5
ShortCut = 46
end>
Caption = '&Edit'
end
item
Items = <
item
Action = DialogOpenPicture1
ShortCut = 16463
end
item
Action = DialogSavePicture1
ShortCut = 16467
end
item
Action = DialogColorSelect1
end
item
Action = DialogFontEdit1
end
item
Action = DialogPrintDlg1
ImageIndex = 14
ShortCut = 16464
end>
Caption = '&View'
end
item
Items = <
item
Action = SearchFind1
ImageIndex = 34
ShortCut = 16454
end
item
Action = SearchFindNext1
ImageIndex = 33
ShortCut = 114
end
item
Action = SearchReplace1
ImageIndex = 32
end
item
Action = SearchFindFirst1
end>
Caption = '&Repository'
end
item
Items = <
item
Action = InternetBrowseURL1
end
item
Action = InternetDownLoadURL1
end
item
Action = InternetSendMail1
end>
Caption = '&Actions'
end
item
Items = <
item
Action = Action1
Caption = '&Options'
end>
Caption = '&Tools'
end
item
Items = <
item
Action = Action2
Caption = '&About CodeTree'
end>
Caption = '&Help'
end>
ActionBar = ActionMainMenuBar1
end>
Left = 600
Top = 270
StyleName = 'Platform Default'
object DialogOpenPicture1: TOpenPicture
Category = 'View'
Caption = '&Open Picture...'
Hint = 'Open Picture'
ShortCut = 16463
end
object DialogSavePicture1: TSavePicture
Category = 'View'
Caption = '&Save Picture...'
Hint = 'Save Picture'
ShortCut = 16467
end
object DialogColorSelect1: TColorSelect
Category = 'View'
Caption = 'Select &Color...'
Hint = 'Color Select'
end
object DialogFontEdit1: TFontEdit
Category = 'View'
Caption = 'Select &Font...'
Dialog.Font.Charset = DEFAULT_CHARSET
Dialog.Font.Color = clWindowText
Dialog.Font.Height = -11
Dialog.Font.Name = 'Tahoma'
Dialog.Font.Style = []
Hint = 'Font Select'
end
object DialogPrintDlg1: TPrintDlg
Category = 'View'
Caption = '&Print...'
ImageIndex = 14
ShortCut = 16464
end
object EditCut1: TEditCut
Category = 'Edit'
Caption = 'Cu&t'
Hint = 'Cut|Cuts the selection and puts it on the Clipboard'
ImageIndex = 0
ShortCut = 16472
end
object EditCopy1: TEditCopy
Category = 'Edit'
Caption = '&Copy'
Hint = 'Copy|Copies the selection and puts it on the Clipboard'
ImageIndex = 1
ShortCut = 16451
end
object EditPaste1: TEditPaste
Category = 'Edit'
Caption = '&Paste'
Hint = 'Paste|Inserts Clipboard contents'
ImageIndex = 2
ShortCut = 16470
end
object EditSelectAll1: TEditSelectAll
Category = 'Edit'
Caption = 'Select &All'
Hint = 'Select All|Selects the entire document'
ShortCut = 16449
end
object EditUndo1: TEditUndo
Category = 'Edit'
Caption = '&Undo'
Hint = 'Undo|Reverts the last action'
ImageIndex = 3
ShortCut = 16474
end
object EditDelete1: TEditDelete
Category = 'Edit'
Caption = '&Delete'
Hint = 'Delete|Erases the selection'
ImageIndex = 5
ShortCut = 46
end
object FileOpen1: TFileOpen
Category = 'File'
Caption = '&Open...'
Hint = 'Open|Opens an existing file'
ImageIndex = 7
ShortCut = 16463
end
object FileOpenWith1: TFileOpenWith
Category = 'File'
Caption = 'Open with...'
FileName = ''
end
object FileSaveAs1: TFileSaveAs
Category = 'File'
Caption = 'Save &As...'
Hint = 'Save As|Saves the active file with a new name'
ImageIndex = 30
end
object FilePrintSetup1: TFilePrintSetup
Category = 'File'
Caption = 'Print Set&up...'
Hint = 'Print Setup'
end
object FilePageSetup1: TFilePageSetup
Category = 'File'
Caption = 'Page Set&up...'
Dialog.MinMarginLeft = 0
Dialog.MinMarginTop = 0
Dialog.MinMarginRight = 0
Dialog.MinMarginBottom = 0
Dialog.MarginLeft = 1000
Dialog.MarginTop = 1000
Dialog.MarginRight = 1000
Dialog.MarginBottom = 1000
Dialog.PageWidth = 8500
Dialog.PageHeight = 11000
end
object FileRun1: TFileRun
Category = 'File'
Browse = False
BrowseDlg.Title = 'Run'
Caption = '&Run...'
Hint = 'Run|Runs an application'
Operation = 'open'
ShowCmd = scShowNormal
end
object FileExit1: TFileExit
Category = 'File'
Caption = 'E&xit'
Hint = 'Exit|Quits the application'
ImageIndex = 43
end
object BrowseForFolder1: TBrowseForFolder
Category = 'File'
Caption = 'BrowseForFolder1'
DialogCaption = 'BrowseForFolder1'
BrowseOptions = []
BrowseOptionsEx = []
end
object InternetBrowseURL1: TBrowseURL
Category = 'Actions'
Caption = '&Browse URL'
Hint = 'Browse URL'
end
object InternetDownLoadURL1: TDownLoadURL
Category = 'Actions'
Caption = '&Download URL'
Hint = 'Download from URL'
end
object InternetSendMail1: TSendMail
Category = 'Actions'
Caption = '&Send Mail...'
Hint = 'Send email'
end
object SearchFind1: TSearchFind
Category = 'Repository'
Caption = '&Find...'
Hint = 'Find|Finds the specified text'
ImageIndex = 34
ShortCut = 16454
end
object SearchFindNext1: TSearchFindNext
Category = 'Repository'
Caption = 'Find &Next'
Hint = 'Find Next|Repeats the last find'
ImageIndex = 33
ShortCut = 114
end
object SearchReplace1: TSearchReplace
Category = 'Repository'
Caption = '&Replace'
Hint = 'Replace|Replaces specific text with different text'
ImageIndex = 32
end
object SearchFindFirst1: TSearchFindFirst
Category = 'Repository'
Caption = 'F&ind First'
Hint = 'Find First|Finds the first occurance of specified text'
end
object Action1: TAction
Category = 'Tools'
Caption = 'Options'
end
object Action2: TAction
Category = 'Help'
Caption = 'About CodeTree'
end
end
end
