副标题#e#

如何在Delphi 10.2中实现以下目标：我需要Delphi自动设置大图标,而不是每个窗口的大小图标.我需要有机会,对于某些表单,以及TApplication,在运行时更改图标.我希望在不修改VCL.Forms.pas的情况下完成此操作(小图标是在窗口标题栏中显示的图标,从窗口标题向左).

TCustomForm中有一个函数：

function GetIconHandle: HICON;

不幸的是,Delphi只设置了大图标句柄,例如,这里引用了VCL.Forms.pas：

SendMessage(Handle,WM_SETICON,ICON_BIG,GetIconHandle);

如您所见,上面的代码只设置了大图标句柄,但我还需要设置小图标句柄,因为我使用的.ICO文件包含大小图标的不同图像.

让我总结一下大图标和小图标之间的区别,因为即使是微软的文档也几乎没有说明它.以下是主要区别：

>窗口标题栏上显示小图标图像.
>如果任务栏很粗,则在Windows任务栏中显示大图标图像(通常位于屏幕的底部);按Alt Tab时也会显示大图标图像.

有关大图标和小图标的更多信息,请参见https://blog.barthe.ph/2009/07/17/wmseticon/.

Delphi通过仅设置大窗口句柄,有效地逐步取出替代图像,以获得窗口标题上显示的较小图标.如果只给出大图标而不是小图标,则Windows会将图像从较大的图标重新采样到较小的图标,质量会恶化,并且会丢失更小,更简单图像的主要概念.

请参阅示例图片courtesy sanyok.标有v7.4.16的左栏是使用设置ICON_BIG和ICON_SMALL的代码编译的程序的屏幕截图.标题为v7.4.16.22的右栏是来自同一程序的屏幕截图,它没有明确设置小图标和大图标,只是将TIcon分配给表单,然后Delphi使用其标准代码只分配大图标,因此窗口标题栏中的图像由Windows从大图标调整大小.您可能会看到标准Delphi行为导致质量变差.

在过去,我正在将VCL.Forms.pas的接口部分中的GetIconHandle从静态更改为虚拟,将其从函数更改为过程并添加两个参数：

procedure GetIconHandle(var Big,Small: HICON); virtual;

所以VCL.Forms.pas中的后续代码如下所示：

var
  Big,Small: HICON;
begin    
  [...]
  GetIconHandle(Big,Small);
  SendMessage(Handle,LParam(Big));
  SendMessage(Handle,ICON_SMALL,LParam(Small));
  [...]

是否可以在不修改VCL.Forms.pas的情况下轻松完成此操作？

我通过修改VCL单元解决了Delphi 2007中的问题,但由于以下原因,我无法再在Delphi 10.20 Tokyo中修改VCL单元：

> VCL单元编译,但是,当我编译我的应用程序时,我得到“内部错误：AV0047C6C7-R000004CC-0”,无论目标目标(Win32 / Win64;调试/发布),请参阅https://quality.embarcadero.com/browse/RSP-18455 – 第一部分错误号(地址)不同,但第二个 – R000004CC-0 – 始终相同.
>我必须手动添加(TObject)到不从任何类继承的每个类;否则我产生一个错误,即在基类中找不到Create或Destroy.在Delphi的早期版本中,简单地编写没有任何祖先的类从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,LR_DEFAULTCOLOR);
    Small := LoadImage(hInstance,16,LR_DEFAULTCOLOR);
  end;
end;

此代码可以进一步改进：32×32和16×16的硬编码大小可以更改,如https://blog.barthe.ph/2009/07/17/wmseticon/所示,
用于大图标的GetSystemMetrics(SM_CXICON),GetSystemMetrics(SM_CYICON)和用于小图标的GetSystemMetrics(SM_CXSMICON)和GetSystemMetrics(SM_CYSMICON).

因此,每个表单基本上都称为LoadIconPair,然后通过覆盖的过程GetIconHandle(var Big,Small：HICON)返回句柄;覆盖;.

所以问题如下：

>是否有可能让Delphi设置小图标和大图标而不会有太多麻烦并且无需修改VCL.Forms.pas？ (这是主要问题) – 我需要有机会,在运行时更改图标.
>如果没有,如何将修改后的源VCL单元添加到Delphi 10.2 Tokyo下的应用程序中,其中单元的接口部分被修改？有没有说明或官方指南？如果有人设法做到这一点,你是如何做到的？你是否从GUI IDE编译它们？或者使用命令行dcc32 / dcc64？还是使用msbuild？或者其他？您是否还必须手动添加(TObject)到不从任何类继承的类,以避免在基类错误中找不到Create或Destroy？

更新#1：在VCL.Forms.pas设置之后再次设置图标不是一个完整的解决方案：我们还必须关注应用程序图标,而不仅仅是表单图标;除此之外,VCL.Forms.pas无论如何设置图标,但只有ICON_BIG,我们必须再次设置图标,这次设置既小又大.您是否知道我们如何修补VCL.Forms.pas以在设置大图标时添加设置ICON_SMALL,因此我们只修补实现部分,并调用一些消息,甚至WM_USER N来请求图标句柄从表单,我们的TForm后代将实现这个消息处理程序？

更新#2：TApplication和TForm在图标方面有类似的接口,但TApplication是TComponent的后代,它没有窗口句柄,并且分别没有消息处理程序.我们可以用TForm做什么,我们不能用TApplication做.

更新#3：我已经实现了一个解决方案,它是kobik suggested in his post和Sertac Akyuz suggested in his later post的混合解决方案.还要感谢在评论中做出贡献的其他人.我已编译程序并将其交给beta测试人员,他们已经确认问题已得到解决,图标现在看起来很好,也可以通过计时器更改图标来实现TApplication中图标的动画也正常工作.谢谢你们！

解决方法

不允许(理论上)修补Delphi的核心VCL / RTL源的接口部分.您之前设法这样做的事实现在作为回旋镖返回.在大多数情况下,您可以根据需要执行操作而无需修补源,例如通过使用继承,类助手,在运行时修补代码,绕路,以及在其他情况下(IMO是最后的手段)修补实现部分并为您允许的项目使用本地副本 – 另请参阅
How to recompile modifications to VCL source file和
How to change VCL code?

我建议在应用程序中为所有表单创建一个祖先基类(我认为任何大型项目应该这样做)并覆盖CreateWnd：

#p#副标题#e##p#分页标题#e#

procedure TBaseForm.CreateWnd;
var
  Big,Small: HICON;
begin
  inherited;
  if BorderStyle <> bsDialog then
  begin
    GetIconHandles(Big,Small);
    if Big <> 0 then
      SendMessage(Handle,LParam(Big));
    if Small <> 0 then
      SendMessage(Handle,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),GetSystemMetrics(SM_CXICON),GetSystemMetrics(SM_CYICON),0);
  Small := LoadImage(HInstance,GetSystemMetrics(SM_CXSMICON),GetSystemMetrics(SM_CYSMICON),0);
end;

您在子类中所需要做的就是覆盖GetIconResName.

即：

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个大小(16×16和32×32)32位深度的图标(如果需要使用其他格式),我没有任何问题,Windows将显示正确的图标.即系统在ALT TAB对话框中显示大图标,在窗口标题中显示小图标.即使只将ICON_BIG发送到表单/应用程序窗口句柄. (Delphi7的/ Win7的). (这就是我要求MCVE的原因.包括有关你的图标格式的信息.而不仅仅是你所做的代码碎片……)

由于我对您的确切要求感到困惑,并且您仍然拒绝提供MCVE,我将尝试提供另一种方法：

你说你还需要处理应用程序图标.创建应用程序时,应用程序图标会尽早设置 – 在表单中处理起来并不简单,因为它们尚未创建.但是每当Application.Icon被更改时,应用程序都会通过CM_ICONCHANGED通知表单(参见：procedure TApplication.IconChanged(Sender：TObject);).所以你可以通过SendMessage(Application.Handle,WM_SETICON ……(这不会触发CM_ICONCHANGED)或直接设置Application.Icon(也会触发CM_ICONCHANGED)重新设置该消息处理程序中的Application图标.通过WM_SETICON消息设置大小图标.您还需要设置类图标：

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);
...

如果您需要在应用程序的早期设置该图标(我认为不需要),请仅在主窗体创建中执行上述操作.

要捕获/处理表单图标,请使用表单中的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,FSmallIcon);
    end else
      inherited;
  end
  else
    inherited;
end;

这应该可以让你了解所有情况.