Delphi XE2 VCL styles, changing window Icon doesn't update on the caption bar until RecreateWnd

偶尔善良 提交于 2019-12-04 12:55:30

问题


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)


回答1:


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


来源:https://stackoverflow.com/questions/10257353/delphi-xe2-vcl-styles-changing-window-icon-doesnt-update-on-the-caption-bar-un

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!