delphi - Delphi XE2 VCL 样式，更改窗口图标不会在标题栏上更新，直到 RecreateWnd

Question

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

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

ImageList3.GetIcon(0,Form1.Icon);

有没有办法在不使用 RecreateWnd 的情况下修复它？（这实际上会产生其他问题）

Answer 1

这是 VCL 样式中的（又一个）错误。该TFormStyleHook.GetIconFast函数正在返回一个陈旧的图标句柄。我会通过替换来修复TFormStyleHook.GetIconFast它TFormStyleHook.GetIcon。将此添加到您的一个单位中，一切都很好。

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