正如@TLama 建议的那样,简单的方法是将VirtualTrees
单元的源代码修改为类似
function TVTColors.GetBackgroundColor: TColor;
begin
// XE2 VCL Style
{$IF CompilerVersion >= 23 }
if FOwner.VclStyleEnabled and not (Self.Owner is TVirtualStringTree) then
Result := StyleServices.GetStyleColor(scTreeView)
else
{$IFEND}
Result := FOwner.Color;
end;
现在,如果您不想修改源代码,您可以使用 detour 和类助手修补该函数以访问私有成员。
尝试下一个代码
unit VirtualTreesHooks;
interface
implementation
Uses
Winapi.Windows,
System.SysUtils,
Vcl.Themes,
Vcl.Graphics,
VirtualTrees;
type
TJumpOfs = Integer;
PPointer = ^Pointer;
PXRedirCode = ^TXRedirCode;
TXRedirCode = packed record
Jump: Byte;
Offset: TJumpOfs;
end;
PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
OpCode: Word;
Addr: PPointer;
end;
TVTColorsHelper = class helper for TVTColors
private
function GetOwner: TBaseVirtualTree;
public
function GetBackgroundColorAddress : Pointer;
property Owner: TBaseVirtualTree read GetOwner;
end;
var
GetBackgroundColorBackup: TXRedirCode; //Store the original address of the function to patch
type
TBaseVirtualTreeClass= class(TBaseVirtualTree);
//this is the implementation of the new function GetBackgroundColor
function GetBackgroundColorHook(Self : TVTColors): TColor;
begin
if TBaseVirtualTreeClass(Self.Owner).VclStyleEnabled and not (Self.Owner is TVirtualStringTree) then
Result := StyleServices.GetStyleColor(scTreeView)
else
Result := TBaseVirtualTreeClass(Self.Owner).Color;
end;
//get the address of a procedure or method of a function
function GetActualAddr(Proc: Pointer): Pointer;
begin
if Proc <> nil then
begin
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
Result := PAbsoluteIndirectJmp(Proc).Addr^
else
Result := Proc;
end
else
Result := nil;
end;
//patch the original function or procedure
procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
n: {$IFDEF VER230}NativeUInt{$ELSE}DWORD{$ENDIF};
Code: TXRedirCode;
begin
Proc := GetActualAddr(Proc);
Assert(Proc <> nil);
//store the address of the original procedure to patch
if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
begin
Code.Jump := $E9;
Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
//replace the target procedure address with the new one.
WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
end;
end;
//restore the original address of the hooked function or procedure
procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
n: {$IFDEF VER230}NativeUInt{$ELSE}Cardinal{$ENDIF};
begin
if (BackupCode.Jump <> 0) and (Proc <> nil) then
begin
Proc := GetActualAddr(Proc);
Assert(Proc <> nil);
WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
BackupCode.Jump := 0;
end;
end;
//get the address of the private method GetBackgroundColor
function TVTColorsHelper.GetBackgroundColorAddress : Pointer;
var
MethodAddr: function : TColor of object;
begin
MethodAddr := Self.GetBackgroundColor;
Result := TMethod(MethodAddr).Code;
end;
function TVTColorsHelper.GetOwner: TBaseVirtualTree;
begin
Result:= Self.FOwner;
end;
initialization
HookProc(TVTColors(nil).GetBackgroundColorAddress, @GetBackgroundColorHook, GetBackgroundColorBackup);
finalization
UnhookProc(TVTColors(nil).GetBackgroundColorAddress, GetBackgroundColorBackup);
end.