关于 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;