关于 class helper for ... 语法

转载于万一的博客https://www.cnblogs.com/del/archive/2009/10/13/1582789.html

class helper 可能是从 Delphi 2007 增加的新语法, 因为感觉不太实用, 直到今天才测试了一下.
试过之后才知道: 挺有意思的! 基本功能就是修改已存在的类.

Txxx = class helper for T... {T... 表示已存在的类}
  {可以替换已存在的方法}
  {也可以有新的方法、成员}
end;
 
//这之后再使用 T... 类及其子孙类时, 都会优先使用 Txxx 的修改

例一:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;
 
  TMyClass = class
    function func1: string;
    function func2: string;
  end;
 
  TMyClassHelper = class helper for TMyClass
    function func1: string; {将把 TMyClass 的同名方法替换掉}
    function func3: string; {将为 TMyClass 及其子类增加这个方法}
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TMyClass }
 
function TMyClass.func1: string;
begin
  Result := 'TMyClass.func1';
end;
 
function TMyClass.func2: string;
begin
  Result := 'TMyClass.func2';
end;
 
{ TMyClassHelper }
 
function TMyClassHelper.func1: string;
begin
  Result := 'TMyClassHelper.func1';
end;
 
function TMyClassHelper.func3: string;
begin
  Result := 'TMyClassHelper.func3';
end;
 
//测试
procedure TForm1.Button1Click(Sender: TObject);
var
  obj: TMyClass;
begin
  obj := TMyClass.Create;
 
  ShowMessage(obj.func1); {TMyClassHelper.func1}
  ShowMessage(obj.func2); {TMyClass.func2}
  ShowMessage(obj.func3); {TMyClassHelper.func3}
 
  obj.Free;
end;
 
end.

例二: 本例为 TControl 类增加了一个方法, 之后 TControl 及其所有子孙类就都拥有了这个方法.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;
 
  TMyClassHelper = class helper for TControl
    procedure MyMsg;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TMyClassHelper }
 
procedure TMyClassHelper.MyMsg;
begin
  ShowMessageFmt('%s 的类名是 %s', [Name,ClassName]);
end;
 
//测试: 这里测试了当前窗体和当前按钮, 它们都是从 TControl 继承来的
procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.MyMsg;            {Form1 的类名是 TForm1}
  TButton(Sender).MyMsg; {Button1 的类名是 TButton1}
end;
 
end.

　菜根大神的方法

type
  TMyObject = class
  private
    FX : Integer;
  public
    property X: Integer read FX write FX;
  end;
 
type
  TMyObjectHelper = class helper for TMyObject
  type
    PMyObjHelperData = ^TMyObjHelperData;
    TMyObjHelperData = record
    public
      FY: Integer;
    end;
  private
    class constructor Create;
  public
    function GetData: PMyObjHelperData;
    function GetXYValue : Integer;
    procedure SetY(Y: Integer);
  end;
 
class constructor TMyObjectHelper.Create;
var
  P: Pointer;
  ASize: Integer;
  T: NativeUInt;
begin
  P := PByte(TMyObject) + vmtInstanceSize;
  ReadProcessMemory(GetCurrentProcess, P, @ASize, SizeOf(ASize), T);
  Inc(ASize, SizeOf(TMyObjHelperData));
  WriteProcessMemory(GetCurrentProcess, P, @ASize, SizeOf(ASize), T);
end;
 
function TMyObjectHelper.GetData: PMyObjHelperData;
begin
  Result :=
    Pointer(PByte(Self) + InstanceSize - hfFieldSize + hfMonitorOffset - SizeOf(TMyObjHelperData));
end;
 
function TMyObjectHelper.GetXYValue : Integer;
var
  AData: PMyObjHelperData;
begin
  AData := GetData;
  Result:= FX + AData.FY;
end;
 
procedure TMyObjectHelper.SetY(Y: Integer);
var
  AData: PMyObjHelperData;
begin
  AData := GetData;
  AData.FY := Y;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
var
  AObj: TMyObject;
begin
  AObj := TMyObject.Create;
  AObj.X := 200;
  AObj.SetY(100);
  ShowMessage(AObj.GetXYValue.ToString);
  AObj.Free;
end;