Two missing parts of the standard VCL Styles is the lack of the capacity to theme the popup menus and the standard Windows dialogs. I started to work a year ago in the dialogs area, but due to my limited time I was not able to finish that. But a few months ago I receive a very interesting mail from Mahdi Safsafi (SMP3) that show me his own work on this topic. So we decided merge the code of his project and the VCL Styles Utils. So finally the VCL Styles Utils project was updated to support standard dialogs, popup and system menus.
How it works?
The key is using a WH_CBT Hook, detecting the HCBT_CREATEWND and HCBT_DESTROYWND codes and then checking if the class of the window is #32770 (the class for a dialog box.) or the #32768 (the class for a popupmenu) from here you can replace the window procedure (WndProc) using the SetWindowLongPtr function with the GWL_WNDPROC index. Now we have the control of the messages sent by the windows dialogs and menus and we can iterate over the child controls and replace the window procedure again using the GWL_WNDPROC index. Finally depending of the class of the control (button, syslistview32, Combobox and so on) a Wrapper class (like the VCL does) is created to handle the messages related to the paint of the control.
Check the next source code which install the hook and process the Win32 controls
unit Vcl.Styles.SysControls;
interface
implementation
uses
Winapi.Windows,
System.Generics.Collections,
System.SysUtils,
Vcl.Controls,
Vcl.Dialogs,
Vcl.Styles,
Vcl.Themes,
Vcl.Styles.PopupWnd,
Vcl.Styles.EditWnd,
Vcl.Styles.StaticWnd,
Vcl.Styles.ThemedDialog,
Vcl.Styles.ToolbarWindow32Wnd,
Vcl.Styles.SysListView32Wnd,
Vcl.Styles.ButtonWnd,
Vcl.Styles.UnknownControlWnd,
Vcl.Styles.ControlWnd,
Vcl.Styles.ComboBoxWnd,
Vcl.Styles.ToolTipsWnd;
type
TThemedSysControls = class
private
class var
FBalloonHint: TBalloonHint;
FPreviousSysBtn: Integer;
FPreviousHandle: THandle;
FHook: HHook;
protected
class function HookActionCallBack(Code: Integer; wParam: wParam;
lParam: lParam): LRESULT; stdcall; static;
procedure InstallHook;
procedure RemoveHook;
public
constructor Create; overload;
destructor Destroy; override;
end;
var
MenuItemInfoArray: array of TMenuItemInfo;
TooltipsWndList: TObjectDictionary<HWND, TooltipsWnd>;
PopupWndList: TObjectDictionary<HWND, TPopupWnd>;
StaticWndList: TObjectDictionary<HWND, TStaticWnd>;
DialogWndList: TObjectDictionary<HWND, TDialogWnd>;
EditWndList: TObjectDictionary<HWND, TEditWnd>;
ComboBoxWndList: TObjectDictionary<HWND, TComboBoxWnd>;
UnknownControlList: TObjectDictionary<HWND, TUnknownControlWnd>;
ToolbarWindow32WndList : TObjectDictionary<HWND, TToolbarWindow32Wnd>;
SysListView32WndList : TObjectDictionary<HWND, TSysListView32Wnd>;
BtnWndArrayList : TObjectDictionary<HWND, TButtonWnd>;
ThemedSysControls: TThemedSysControls;
{ TThemedSysControls }
constructor TThemedSysControls.Create;
begin
inherited;
FBalloonHint := TBalloonHint.Create(nil);
FBalloonHint.Style := bhsStandard;
FBalloonHint.Delay := 1500;
FBalloonHint.HideAfter := 3000;
FPreviousHandle := 0;
FHook := 0;
InstallHook;
PopupWndList:= TObjectDictionary<HWND, TPopupWnd>.Create([doOwnsValues]);
TooltipsWndList:= TObjectDictionary<HWND, TooltipsWnd>.Create([doOwnsValues]);
StaticWndList:= TObjectDictionary<HWND, TStaticWnd>.Create([doOwnsValues]);
DialogWndList:= TObjectDictionary<HWND,TDialogWnd>.Create([doOwnsValues]);
EditWndList:= TObjectDictionary<HWND, TEditWnd>.Create([doOwnsValues]);
ComboBoxWndList:= TObjectDictionary<HWND, TComboBoxWnd>.Create([doOwnsValues]);
UnknownControlList:= TObjectDictionary<HWND, TUnknownControlWnd>.Create([doOwnsValues]);
ToolbarWindow32WndList:= TObjectDictionary<HWND, TToolbarWindow32Wnd>.Create([doOwnsValues]);
SysListView32WndList := TObjectDictionary<HWND, TSysListView32Wnd>.Create([doOwnsValues]);
BtnWndArrayList := TObjectDictionary<HWND, TButtonWnd>.Create([doOwnsValues]);
end;
destructor TThemedSysControls.Destroy;
begin
RemoveHook;
PopupWndList.Free;
TooltipsWndList.Free;
StaticWndList.Free;
DialogWndList.Free;
EditWndList.Free;
ComboBoxWndList.Free;
UnknownControlList.Free;
ToolbarWindow32WndList.Free;
SysListView32WndList.Free;
BtnWndArrayList.Free;
FBalloonHint.Free;
inherited;
end;
class function TThemedSysControls.HookActionCallBack(Code: Integer;
wParam: wParam; lParam: lParam): LRESULT;
var
Msg: TMOUSEHOOKSTRUCT;
C: array [0 .. 256] of Char;
procedure HideSysToolTip;
var
hSysToolTip: THandle;
begin
For hSysToolTip := 65550 To 65600 do
begin
If IsWindowVisible(hSysToolTip) then
begin
GetClassName(hSysToolTip, C, 256);
ShowWindow(hSysToolTip, SW_HIDE);
end;
end;
end;
procedure ShowToolTip(HintTitle: String);
begin
HideSysToolTip;
if FPreviousSysBtn <> Integer(Msg.wHitTestCode) then
begin
FBalloonHint.HideHint;
FBalloonHint.Title := HintTitle;
FPreviousSysBtn := Msg.wHitTestCode;
FBalloonHint.ShowHint(Msg.pt);
end;
end;
var
CBTSturct: TCBTCreateWnd;
sClassName : string;
begin
if (StyleServices.Enabled) and not (StyleServices.IsSystemStyle) then
begin
if Code = HCBT_SYSCOMMAND then
begin
FBalloonHint.HideHint;
FPreviousSysBtn := 0;
end
else
if Code = HCBT_DESTROYWND then
begin
sClassName := GetWindowClassName(wParam);
if sClassName = '#32768' then
{PopupMenu}
begin
if PopupWndList.ContainsKey(wParam) then
PopupWndList.Remove(wParam);
//OutputDebugString(PChar('remove PopupWndList count '+IntToStr(PopupWndList.Count)));
end
else
if sClassName = '#32770' then
{Dialog}
begin
if DialogWndList.ContainsKey(wParam) then
DialogWndList.Remove(wParam);
//OutputDebugString(PChar('remove DialogWndList count '+IntToStr(DialogWndList.Count)));
end
else
if sClassName = 'Button' then
{Button}
begin
if BtnWndArrayList.ContainsKey(wParam) then
BtnWndArrayList.Remove(wParam);
//OutputDebugString(PChar('remove BtnWndArrayList count '+IntToStr(BtnWndArrayList.Count)));
end
else
if (sClassName = 'ScrollBar') or (sClassName = 'ReBarWindow32') {or (sClassName = 'ToolbarWindow32')} then
begin
if UnknownControlList.ContainsKey(wParam) then
UnknownControlList.Remove(wParam);
end
else
if sClassName = 'SysListView32' then
begin
if SysListView32WndList.ContainsKey(wParam) then
SysListView32WndList.Remove(wParam);
end
else
if sClassName = 'ToolbarWindow32' then
begin
if ToolbarWindow32WndList.ContainsKey(wParam) then
ToolbarWindow32WndList.Remove(wParam);
end
else
if sClassName = 'Edit' then
begin
if EditWndList.ContainsKey(wParam) then
EditWndList.Remove(wParam);
end
else
if sClassName = 'Static' then
begin
if StaticWndList.ContainsKey(wParam) then
StaticWndList.Remove(wParam);
end
else
if sClassName = 'ComboBox' then
begin
if ComboBoxWndList.ContainsKey(wParam) then
ComboBoxWndList.Remove(wParam);
end
else
if sClassName = 'tooltips_class32' then
begin
if TooltipsWndList.ContainsKey(wParam) then
TooltipsWndList.Remove(wParam);
end
end
else
if Code = HCBT_CREATEWND then
begin
CBTSturct := PCBTCreateWnd(lParam)^;
sClassName := GetWindowClassName(wParam);
//PopupMenu
if Integer(CBTSturct.lpcs.lpszClass) = 32768 then
PopupWndList.Add(wParam, TPopupWnd.Create(wParam))
else
//Dialog
if Integer(CBTSturct.lpcs.lpszClass) = 32770 then
begin
if (CBTSturct.lpcs.cx <> 0) and (CBTSturct.lpcs.cy <> 0) then
DialogWndList.Add(wParam, TDialogWnd.Create(wParam))
end
else
if sClassName = 'Button' then
BtnWndArrayList.Add(wParam, TButtonWnd.Create(wParam))
else
if (sClassName = 'ScrollBar') or (sClassName = 'ReBarWindow32') {or (sClassName = 'ToolbarWindow32')} then
UnknownControlList.Add(wParam, TUnknownControlWnd.Create(wParam))
else
if sClassName = 'SysListView32' then
SysListView32WndList.Add(wParam, TSysListView32Wnd.Create(wParam))
else
if sClassName = 'ToolbarWindow32' then
begin
if not UseLatestCommonDialogs then
ToolbarWindow32WndList.Add(wParam, TToolbarWindow32Wnd.Create(wParam));
end
else
if sClassName = 'Edit' then
EditWndList.Add(wParam, TEditWnd.Create(wParam))
else
if sClassName = 'Static' then
begin
{ This condition can solve the Edit animated cursor : see ColorDialog !! }
if (CBTSturct.lpcs.Style and SS_ICON <> SS_ICON) and
(CBTSturct.lpcs.Style and SS_BITMAP <> SS_BITMAP) and
(CBTSturct.lpcs.Style and SS_GRAYRECT <> SS_GRAYRECT) and
(CBTSturct.lpcs.Style and SS_GRAYFRAME <> SS_GRAYFRAME) then
StaticWndList.Add(wParam, TStaticWnd.Create(wParam));
end
else
if sClassName = 'ComboBox' then
ComboBoxWndList.Add(wParam, TComboBoxWnd.Create(wParam))
else
if sClassName = 'tooltips_class32' then
TooltipsWndList.Add(wParam, TooltipsWnd.Create(wParam))
end
end;
Result := CallNextHookEx(FHook, Code, wParam, lParam);
end;
procedure TThemedSysControls.InstallHook;
begin
FHook := SetWindowsHookEx(WH_CBT, @TThemedSysControls.HookActionCallBack, 0, GetCurrentThreadId);
end;
procedure TThemedSysControls.RemoveHook;
begin
if FHook <> 0 then
UnhookWindowsHookEx(FHook);
end;
initialization
ThemedSysControls:=nil;
if StyleServices.Available then
ThemedSysControls := TThemedSysControls.Create;
finalization
if Assigned(ThemedSysControls) then
ThemedSysControls.Free;
end.
Menus
Standard TMainMenu with VCL Styles Enabled.
using the Vcl.Styles.SysControls unit
SysMenu with VCL Styles Enabled.
using the Vcl.Styles.SysControls unit
System menu with VCL Styles Enabled.
System menu using the Vcl.Styles.SysControls unit
Dialogs
Open Dialog With VCL Styles enabled
Open Dialog using the Vcl.Styles.SysControls unit
Even the shell menu inside of the dialog is themed
Others Dialogs
You can activate this functionality in your apps just adding the Vcl.Styles.SysControls unit to your project. Also a new sample project was added to test all the new features.
As always all your comments and suggestions are welcome.
The Road to Delphi 