德尔福XE2 VCL样式，改变窗口图标的说明栏上不会更新，直到RecreateWnd

Question

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

改变形式的图标只更新它的任务栏按钮，没有在标题图标除非使用RecreateWnd更新。 （使用VCL样式时）

ImageList3.GetIcon(0,Form1.Icon); 

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

Answer 1

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

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