德爾福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 
);