Using Delphi XE7 on a Windows 7 Pro 64-bit system. If I choose \'Charcoal Dark Slate\' VCL style, the 16x16 pixel titel bar icon down-sized from the 32x32 program icon looks
@James Johnston,
Thank you! It works fine for me although there was a small glitch in the posted code:
Message.Result = SendMessage(this->Control->Handle, WM_GETICON,
ICON_SMALL2, Message.LParam);
PreventRecursion = false;
this->Handled = true;
Remove PreventRecursion = false;
Here is the Delphi port of your code:
unit FixIconHook;
interface
uses
WinAPI.Windows,
WinAPI.Messages,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Themes;
type
TFixedFormStyleHook = class(TFormStyleHook)
private
PreventRecursion: Boolean;
strict protected
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AControl: TWinControl); override;
end;
implementation
constructor TFixedFormStyleHook.Create(AControl: TWinControl);
begin
inherited Create(AControl);
PreventRecursion := False;
end;
procedure TFixedFormStyleHook.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_GETICON) and (Message.WParam = ICON_SMALL) and
(not PreventRecursion) and (Assigned(Control) and
Control.HandleAllocated) then
begin
// Just in case some future Windows version decides to call us again
// with ICON_SMALL as response to being called with ICON_SMALL2.
PreventRecursion := true;
Message.Result := SendMessage(Control.Handle,
WM_GETICON, ICON_SMALL2, Message.LParam);
Handled := true;
exit;
end;
inherited WndProc(Message);
end;
end.
Then in your DPR project:
TStyleManager.Engine.RegisterStyleHook(TForm, TFixedFormStyleHook);
TStyleManager.Engine.RegisterStyleHook(TCustomForm, TFixedFormStyleHook);