如何替换VCL的代码

一般情况下，我们并不需要替换VCL的代码，但是，如果有某些特别的目的需要更改VCL中默认的执行逻辑的话，下面的东西应该有用。另一种方法是用Inject，但是，如果是你自己的程序，且有源码，用下面的办法就会省事的多了

Procedure PatchVCLCode(ProcOld, ProcNew: Pointer);
var
  newCode : packed record
    JmpRel32  : Byte;
    Offset32  : Integer;
  end;
begin
  newCode.JmpRel32  := $E9;
  newCode.Offset32  := Integer(procNew) - Integer(procOld) - 5;
  WriteProcessMemory(
      GetCurrentProcess,
      procOld,
      @newCode,
      SizeOf(newCode),
      DWORD(nil^) );

end;

使用方法

  PatchVCLCode(@TMouseWheelPatcher.IsControlMouseMsg, @TMouseWheelPatcher.NewIsControlMouseMsg);

TMouseWheelPatcher的声明

  TMouseWheelPatcher  = class(TWinControl)
    function NewIsControlMouseMsg(var Msg: TWMMouse): Boolean;
  end;

效果就是，把TWinControl.IsControlMouseMsg用TMouseWheelPatcher.NewIsControlMouseMsg替换掉，相当于你重新改写了VCL的TWinControl.IsControlMouseMsg的实现。

 

上面的东西是从2ccc中的一文章修改而来的，把它总结成一个函数方便自己日后使用,原文标题为: vcl中处理WM_MOUSEWHEEL的bug,作者:egust (欢迎访问newsmth.org Delphi版)

 

主要代码为

  TMouseWheelPatcher  = class(TWinControl)
    function NewIsControlMouseMsg(var Msg: TWMMouse): Boolean;
    procedure DoPatch;
  end;


procedure TMouseWheelPatcher.DoPatch;
var
  procOld, procNew  : Pointer;
  newCode : packed record
    JmpRel32  : Byte;
    Offset32  : Integer;
  end;
begin
  procOld := @TMouseWheelPatcher.IsControlMouseMsg;
  procNew := @TMouseWheelPatcher.NewIsControlMouseMsg;
  newCode.JmpRel32  := $E9;
  newCode.Offset32  := Integer(procNew) - Integer(procOld) - 5;
  WriteProcessMemory(
      GetCurrentProcess,
      procOld,
      @newCode,
      SizeOf(newCode),
      DWORD(nil^) );
end;

//
function TMouseWheelPatcher.NewIsControlMouseMsg(var msg: TWMMouse): Boolean;
var
  Control, CaptureControl : TControl;
  P: TPoint;
begin
  if GetCapture = Handle then
  begin
    CaptureControl  := GetCaptureControl;   ///不知道会不会有副作用
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl
    else
      Control := nil;
  end
  else
  begin
    P := SmallPointToPoint(msg.Pos);
    if(msg.Msg=WM_MOUSEWHEEL)then
      P := ScreenToClient(P);
    Control := ControlAtPos(P, False);
  end;
  Result := False;

  if Control <> nil then
  begin
    if(msg.Msg=WM_MOUSEWHEEL)then
    begin
      with TMessage(msg) do
        Result := Control.Perform(Msg, WParam, LParam);
    end else
    with msg do
    begin
      P.X := XPos - Control.Left;
      P.Y := YPos - Control.Top;
      Result := Control.Perform(Msg, Keys, Longint(PointToSmallPoint(P)));
    end;
    Result := True;
  end;
end;