如何在Delphi 10.2 Tokyo中实现以下目标:我需要Delphi不仅为每个窗口自动设置大图标,而且还要自动设置大图标和小图标。对于某些表格和TApplication,我需要有一个在运行时更改图标的机会。我希望做到这一点而无需修改VCL.Forms.pas
(小图标是显示在窗口标题栏中的一个标题,位于窗口标题的左侧)。TCustomForm
中有一个函数:
function GetIconHandle: HICON;
不幸的是,Delphi只设置了大图标句柄,例如,这是
VCL.Forms.pas
的引号: SendMessage(Handle, WM_SETICON, ICON_BIG, GetIconHandle);
如您所见,以上代码仅设置了大图标句柄,但是我还需要设置小图标句柄,因为我使用的.ICO文件包含用于大图标和小图标的不同图像。
让我简短地总结一下大图标和小图标之间的区别,因为即使Microsoft文档也几乎什么也没说。主要区别如下:
有关大小图标的更多信息,请参见https://blog.barthe.ph/2009/07/17/wmseticon/。
通过仅设置大的窗口句柄,Delphi可以有效地逐步淘汰窗口标题上显示的较小图标的替代图像。如果只给出大图标而不给出小图标,则Windows会将图像从大图标重新采样到较小的图标,质量变差,并且丢失了较小,更简单的图像的主要思想。
参见示例图像sanyok。左侧标记为v7.4.16的列是使用设置
ICON_BIG
和ICON_SMALL
的代码编译的程序的屏幕截图。右栏标记为v7.4.16.22,是同一程序的屏幕快照,该程序没有显式设置大小图标,而只是将TIcon
分配给表单,然后使用其标准代码的Delphi仅分配大图标,因此Windows会通过大图标调整Windows标题栏中的图像大小。您可能会看到,由于标准的Delphi行为,质量变得很差。过去,我将
VCL.Forms.pas
的接口(interface)部分中的GetIconHandle从静态更改为虚拟,将其从function
更改为procedure
并添加了两个参数:procedure GetIconHandle(var Big, Small: HICON); virtual;
因此,VCL.Forms.pas中的后续代码如下所示:
var
Big, Small: HICON;
begin
[...]
GetIconHandle(Big, Small);
SendMessage(Handle, WM_SETICON, ICON_BIG, LParam(Big));
SendMessage(Handle, WM_SETICON, ICON_SMALL, LParam(Small));
[...]
是否可以轻松完成此操作而无需修改
VCL.Forms.pas
?我确实通过修改VCL单元解决了Delphi 2007中的问题,但是由于以下原因,我无法再在Delphi 10.20 Tokyo中修改VCL单元:
Create
或Destroy
。在以前的Delphi版本中,仅编写class
而没有任何祖先隐式地从TObject
继承了它,但是当我使用dcc32
命令行选项通过dcc32 -Q -M -$D- -$M+
从命令行编译代码时,会发生此错误,即在基类中找不到Create
或Destroy
。 这是我过去加载图标的方式:
procedure LoadIconPair(var Big, Small: hIcon; AName: PChar);
begin
if Win32MajorVersion < 4 then
begin
Big := LoadIcon(hInstance, AName);
Small := 0;
end
else
begin
Big := LoadImage(hInstance, AName, IMAGE_ICON, 32, 32, LR_DEFAULTCOLOR);
Small := LoadImage(hInstance, AName, IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);
end;
end;
可以进一步改进此代码:如https://blog.barthe.ph/2009/07/17/wmseticon/所示,可以将32x32和16x16的硬编码大小更改为
GetSystemMetrics(SM_CXICON)
,GetSystemMetrics(SM_CYICON)
用于大图标,GetSystemMetrics(SM_CXSMICON)
和GetSystemMetrics(SM_CYSMICON)
用于小图标。因此,每种形式实质上都称为
LoadIconPair
,然后通过覆盖的procedure GetIconHandle(var Big, Small: HICON); override;
返回句柄。因此,问题如下:
VCL.Forms.pas?
(这是主要问题)-我需要有机会(对于某些表格和TApplication)更改图标在运行时。 Create
或Destroy
吗? 更新#1:在VCL.Forms.pas设置之后,再次设置图标并不是一个完整的解决方案:我们还必须注意Application图标,不仅是表单图标;除此之外,VCL.Forms.pas仍然设置图标,但是只有
ICON_BIG
,我们必须再次设置图标,这一次设置大小。您是否知道如何修补VCL.Forms.pas以在设置大图标时添加设置ICON_SMALL
的想法,所以我们仅修补implementation
部分,并将调用一些消息,甚至是WM_USER + N来请求图标从表单处理,我们的TForm后代将实现此消息处理程序?更新#2:TApplication和TForm在图标方面具有相似的接口(interface),但是TApplication是TComponent的后代,它们没有窗口句柄,并且分别没有消息处理程序。我们可以用TForm做什么,我们不能用TApplication。
更新#3:我实现了一个解决方案,它混合了kobik和suggested in his post的Sertac Akyuz。也感谢在评论中做出贡献的其他人。我已经编译了程序并将其交给Beta测试人员,他们已经确认问题已解决,图标现在看起来不错,而且TApplication中通过按计时器更改图标的动画在TApplication中也可以正常工作。谢谢你们!
最佳答案
从理论上讲,不允许修补Delphi核心VCL/RTL源的interface
部分。您以前这样做的事实现在以回旋镖的形式返回。在大多数情况下,您可以在不打补丁的情况下做所需的事情,例如通过使用继承,类助手,在运行时修补代码,绕行,以及在其他情况下(后者是IMO的最后手段)修补implementation
部分,并为您的项目使用本地副本,这是允许的-另请参见 How to recompile modifications to VCL source file
和 How to change VCL code?
我建议在应用程序中为所有表单(我认为任何大型项目都应该这样做)创建一个祖先基类,并覆盖CreateWnd
:
procedure TBaseForm.CreateWnd;
var
Big, Small: HICON;
begin
inherited;
if BorderStyle <> bsDialog then
begin
GetIconHandles(Big, Small);
if Big <> 0 then
SendMessage(Handle, WM_SETICON, ICON_BIG, LParam(Big));
if Small <> 0 then
SendMessage(Handle, WM_SETICON, ICON_SMALL, LParam(Small));
end;
end;
介绍两种虚拟方法:
procedure TBaseForm.GetIconResName(var Name: string);
begin
Name := 'MAINICON';
end;
procedure TBaseForm.GetIconHandles(var Big, Small: HICON);
var
ResName: string;
begin
Big := 0;
Small := 0;
GetIconResName(ResName);
if ResName = '' then Exit;
Big := LoadImage(HInstance, PChar(ResName), IMAGE_ICON,
GetSystemMetrics(SM_CXICON),
GetSystemMetrics(SM_CYICON),
0);
Small := LoadImage(HInstance, PChar(ResName), IMAGE_ICON,
GetSystemMetrics(SM_CXSMICON),
GetSystemMetrics(SM_CYSMICON),
0);
end;
您子类中需要做的就是重写
GetIconResName
。IE:
TMyChildForm = class(TBaseForm)
protected
procedure GetIconResName(var Name: string); override;
end;
procedure TMyChildForm.GetIconResName(var Name: string);
begin
Name := 'SPIDERMAN';
end;
This is not a complete solution...
我试图给您一些线索,以表明不需要修补VCL源。
无论如何,如果我使用Icon属性(应用程序和窗体)并提供至少具有2种尺寸(16x16和32x32)的图标,则没有任何问题 32位深度(如果需要,请使用其他格式),Windows将显示正确的图标。即系统在ALT + TAB对话框中显示大图标,在窗口标题中显示小图标。即使只有
ICON_BIG
发送到窗体/应用程序窗口句柄。 (Delphi7/Win7)。 (这就是为什么我要求 MCVE 的原因。包括有关您的Icons格式的信息。而不仅仅是像您一样的代码片段...)由于我对您的确切要求感到困惑,并且您仍然拒绝提供MCVE,因此,我将尝试提供另一种方法:
您说您还需要处理“应用程序图标”。 “应用程序”图标是在创建应用程序时提早设置的-由于尚未创建,因此在表单中处理起来并不容易。但是只要更改
Application.Icon
,应用程序就会使用CM_ICONCHANGED
通知表单(请参阅:procedure TApplication.IconChanged(Sender: TObject);
)。因此您可以通过SendMessage(Application.Handle, WM_SETICON...
(这不会触发CM_ICONCHANGED
)或直接设置Application.Icon
(也将触发CM_ICONCHANGED
)在该消息处理程序中重新设置Application图标。如果需要,通过WM_SETICON
消息设置大小图标。您还需要设置类(class)图标:SetClassLong(Application.Handle, GCL_HICON, FIcon);
因此,只要更改应用程序图标,表单中的
CM_ICONCHANGED
就会覆盖它。TBaseForm = class(TForm)
private
procedure CMIconChanged(var Message: TMessage); message CM_ICONCHANGED;
...
procedure TBaseForm.CMIconChanged(var Message: TMessage);
...
如果您需要在应用程序中尽早设置该Icon(我认为这不是必需的),请仅在Main表单创建中执行上述操作。
要捕获/处理表单图标,请在表单中使用
WM_SETICON
消息处理程序:TBaseForm = class(TForm)
private
procedure WMSetIcon(var Message: TWMSetIcon); message WM_SETICON;
...
procedure TBaseForm.WMSetIcon(var Message: TWMSetIcon);
begin
if (Message.Icon <> 0) and (BorderStyle <> bsDialog) then
begin
// this big icon is being set by the framework
if Message.BigIcon then
begin
// FBigIcon := LoadImage/LoadIcon...
// if needed set Message.Icon to return a different big icon
// Message.Icon := FBigIcon;
// in practice create a virtual method to handle this section so your child forms can override it if needed
inherited;
FSmallIcon := LoadImage/LoadIcon...
// set small icon - this will also re-trigger WMSetIcon
Perform(WM_SETICON, ICON_SMALL, FSmallIcon);
end else
inherited;
end
else
inherited;
end;
这应该使您在所有情况下都可以覆盖。
关于windows - 除了ICON_BIG之外,如何使Delphi 10.2 Tokyo荣誉ICON_SMALL(窗口标题栏图标)?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/44746352/