Question

VCL风格的另一个奇怪的故障：

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

ImageList3.GetIcon(0,Form1.Icon);

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

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

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

1 个答案: