Delphi XE2 VCL样式，更改窗口图标不会在标题栏上更新，直到重新创建

问题描述

使用VCL样式的另一个奇怪的故障：

更改表单的图标只会更新其任务栏按钮，标题中的图标不会更新，除非您使用RecreateWnd。 （使用VCL样式时）

  ImageList3.GetIcon（0，Form1.Icon）; 
  

有没有办法解决它，而不必使用RecreateWnd？ （实际上可以创建）

解决方案

VCL样式中的（另一个）错误。 TFormStyleHook.GetIconFast 函数返回一个过时的图标句柄。我将通过用 TFormStyleHook.GetIcon 替换 TFormStyleHook.GetIconFast 来解决这个问题。将其添加到您的单位之一，一切都很好。

  procedure PatchCode（Address：Pointer; const NewCode; Size：Integer ）; 
 var 
 OldProtect：DWORD; 
 begin 
如果VirtualProtect（Address，Size，PAGE_EXECUTE_READWRITE，OldProtect）然后
 begin 
 Move（NewCode，Address ^，Size）; 
 FlushInstructionCache（GetCurrentProcess，Address，Size）; 
 VirtualProtect（Address，Size，OldProtect，@OldProtect）; 
结束
结束
 
 type 
 PInstruction = ^ TInstruction; 
 TInstruction =打包记录
操作码：字节; 
偏移：整数; 
结束
 
程序RedirectProcedure（OldAddress，NewAddress：Pointer）; 
 var 
 NewCode：TInstruction; 
 begin 
 NewCode.Opcode：= $​​ E9; // jump relative 
 NewCode.Offset：= NativeInt（NewAddress）-NativeInt（OldAddress）-SizeOf（NewCode）; 
 PatchCode（OldAddress，NewCode，SizeOf（NewCode））; 
结束
 
 type 
 TFormStyleHookHelper = TFormStyleHook的类帮助
函数GetIconFastAddress：Pointer; 
函数GetIconAddress：指针; 
结束
 
函数TFormStyleHookHelper.GetIconFastAddress：指针; 
 var 
 MethodPtr：function：TIcon的对象; 
 begin 
 MethodPtr：= Self.GetIconFast; 
结果：= TMethod（MethodPtr）.Code; 
结束
 
函数TFormStyleHookHelper.GetIconAddress：指针; 
 var 
 MethodPtr：function：TIcon的对象; 
 begin 
 MethodPtr：= Self.GetIcon; 
结果：= TMethod（MethodPtr）.Code; 
结束
 
初始化
 RedirectProcedure（
 Vcl.Forms.TFormStyleHook（nil）.GetIconFastAddress，
 Vcl.Forms.TFormStyleHook（nil）.GetIconAddress 
）; 
  

Another weird glitch with VCL styles:

Changing a form's Icon updates only its taskbar button, the Icon in the caption doesn't update unless you use RecreateWnd. (when using VCL styles)

ImageList3.GetIcon(0,Form1.Icon);

Is there a way to fix it without having to use RecreateWnd? (which can actually create other issues)

解决方案

It's (yet another) bug in VCL styles. The TFormStyleHook.GetIconFast function is returning a stale icon handle. I'd fix it by replacing TFormStyleHook.GetIconFast with TFormStyleHook.GetIcon. Add this to one of your units and all is well again.

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

type
  TFormStyleHookHelper = class helper for TFormStyleHook
    function GetIconFastAddress: Pointer;
    function GetIconAddress: Pointer;
  end;

function TFormStyleHookHelper.GetIconFastAddress: Pointer;
var
  MethodPtr: function: TIcon of object;
begin
  MethodPtr := Self.GetIconFast;
  Result := TMethod(MethodPtr).Code;
end;

function TFormStyleHookHelper.GetIconAddress: Pointer;
var
  MethodPtr: function: TIcon of object;
begin
  MethodPtr := Self.GetIcon;
  Result := TMethod(MethodPtr).Code;
end;

initialization
  RedirectProcedure(
    Vcl.Forms.TFormStyleHook(nil).GetIconFastAddress,
    Vcl.Forms.TFormStyleHook(nil).GetIconAddress
  );

这篇关于Delphi XE2 VCL样式，更改窗口图标不会在标题栏上更新，直到重新创建的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！