Delphi XE2 VCL样式,更改窗口Icon在标题栏上不会更新,直到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
  );