TObject = class
//默认是private类型的静态方法
constructor Create; //静态方法不能被重写
procedure Free;//静态方法不能被重写
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
procedure Dispatch(var Message); virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
//private不能被override（ Method ‘Destory‘ not found in base class）
//之所以还要加virtual,是为了在派生类VMT中保留方法指针
destructor Destroy; virtual;
end;
//类方法
class function TObject.ClassName: ShortString;
{$IFDEF PUREPASCAL}
begin
Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;
{$ELSE}
asm
{ -> EAX VMT }
{ EDX Pointer to result string }
PUSH ESI
PUSH EDI
MOV EDI,EDX
MOV ESI,[EAX].vmtClassName
XOR ECX,ECX
MOV CL,[ESI]
INC ECX
REP MOVSB
POP EDI
POP ESI
end;
{$ENDIF}
dynamic h和 virtual 是定义多态方法的2中形式,dynamic 方法在DMT表中, virtual 方法在VMT表中,
每个类都会有自己的VMT/DMT表 在使用上面是一样的, 区别是:
dynamic方法: DMT表不会随着类的派生而增加(如果子类没有覆盖dynamic方法则不会有DMT表,那么需要去父类DMT表中查找-调用)节省DMT表空间, 但是查找-调用效率不如virtual方法. ---- 空间占优
virtual方法: 每个派生类VMT表都会包含父类virtual方法指针和自己的virtual方法, 多子类/多重继承VMT表会很占空间,但是因为每个类VMT表包含所有Virtual方法,不需要去找父类VMT, 查找-调用virtual方法比dynamic方法快. ---- 时间占优
Unit1
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls
;
type
TForm1 = class(TForm)
test3: TButton;
Memo1: TMemo;
test1: TButton;
test2: TButton;
test4: TButton;
procedure test3Click(Sender: TObject);
procedure test1Click(Sender: TObject);
procedure test2Click(Sender: TObject);
procedure Memo1DblClick(Sender: TObject);
procedure test4Click(Sender: TObject);
private
{ Private declarations }
procedure WndProc(var msg:TMessage); override;
public
{ Public declarations }
procedure writeLog(sLog: string);
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.writeLog(sLog: string);
begin
Memo1.Lines.Add(FormatDateTime(‘yyyy-MM-dd hh:nn:ss.zzz‘, Now) + ‘ ‘ + sLog);
end;
procedure TForm1.test1Click(Sender: TObject);
var
base: TBase;
test: TTest;
obj: TObject;
begin
//如果派生类没有显示inherited父类构造/析构函数，则只会调用派生类自定义的构造/析构函数，或者TObject的。
writeLog(‘base := TBase.Create‘);
base := TBase.Create;
writeLog(‘test := TTest.Create‘);
test := TTest.Create;
writeLog(‘obj := TTest.Create‘);
obj := TTest.Create;
writeLog(‘base.s = ‘ + base.s + ‘ base.s1 =‘ + base.s1);
writeLog(‘test.s = ‘ + test.s + ‘ test.s1 =‘ + test.s1 + ‘ test.s2 = ‘ + test.s2);
writeLog(‘TBase(obj).s = ‘ + TBase(obj).s + ‘ TBase(obj).s1 =‘ + TBase(obj).s1);
writeLog(‘TTest(obj).s = ‘ + TTest(obj).s + ‘ TTest(obj).s1 =‘ + TTest(obj).s1 + ‘ TTest(obj).s2 = ‘ + TTest(obj).s2);
test.FrendClass;
writeLog(‘FreeAndNil(base)‘);
FreeAndNil(base);
writeLog(‘FreeAndNil(test)‘);
FreeAndNil(test);
writeLog(‘FreeAndNil(obj)‘);
FreeAndNil(obj);
end;
procedure TForm1.test2Click(Sender: TObject);
var
base: TBase;
test: TTest;
obj: TObject;
p1, p2, p3: Pointer;
begin
writeLog(‘base := TBase.Create‘);
base := TBase.Create;
writeLog(‘test := TTest.Create‘);
test := TTest.Create;
writeLog(‘obj := TTest.Create‘);
obj := TTest.Create;
p1 := PChar(base.s);
writeLog(‘base.s = ‘ + string(p1));
p2 := PChar(test.s);
writeLog(‘test.s = ‘ + string(p2));
p3 := PChar(TTest(obj).s2);
writeLog(‘obj.s2 = ‘ + string(p3));
writeLog(‘FreeAndNil(base)‘);
FreeAndNil(base);
writeLog(‘FreeAndNil(test)‘);
FreeAndNil(test);
writeLog(‘FreeAndNil(obj)‘);
FreeAndNil(obj);
//报错 空指针
try
writeLog(‘base.s = ‘ + string(p1));
writeLog(‘test.s = ‘ + string(p2));
writeLog(‘obj.s = ‘ + string(p3));
except
on e: Exception do
ShowMessage(e.message);
end;
end;
procedure TForm1.test3Click(Sender: TObject);
var
base: TBase;
test: TTest;
obj: TObject;
begin
writeLog(‘base := TBase.Create‘);
base := TBase.Create;
writeLog(‘test := TTest.Create‘);
test := TTest.Create;
writeLog(‘obj := TTest.Create‘);
obj := TTest.Create;
writeLog(‘test.s = ‘ + test.s + ‘ test.s1 =‘ + test.s1 + ‘ test.s2 = ‘ + test.s2);
writeLog(‘TBase before Free: ‘ + IntToStr(Integer(base)));
writeLog(‘TTest before Free: ‘ + IntToStr(Integer(test)));
writeLog(‘TObject before Free: ‘ + IntToStr(Integer(obj)));
//通过TObject.free 调用 Destroy 因为Destroy是virtual，会调用自己的VMT函数。可能是
//如果TTest未定义Destroy，那么调用的是TObject.Destroy
//如果TTest已定义Destroy，则等价于TTest.Destroy;
writeLog(‘base.Free：‘);
base.Free;
writeLog(‘test.Free：‘);
test.Free;
//不管派生类test是否定义free，调用的是TObject.free，因为free非virtual
//obj.Free 和 TTest(obj).Free 区别
// writeLog(‘obj.Free：‘);
// obj.Free;
//要调用test.free，必须显示调用TTest(obj).Free;
writeLog(‘TTest(obj).Free：‘);
TTest(obj).Free;
//对象释放，但是指针还指向它的地址
writeLog(‘TBase after Free: ‘ + IntToStr(Integer(base)));
writeLog(‘TTest after Free: ‘ + IntToStr(Integer(test)));
writeLog(‘TObject after Free: ‘ + IntToStr(Integer(obj)));
end;
procedure TForm1.Memo1DblClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
procedure TForm1.test4Click(Sender: TObject);
var
mmStream: TMemoryStream;
sFileName: string;
begin
//序列化窗体、组件
sFileName := ExtractFilePath(ParamStr(0)) + self.Name + ‘.txt‘;
mmStream := TMemoryStream.Create;
mmStream.WriteComponent(Self);
mmStream.SaveToFile(sFileName);
writeLog(sFileName);
end;
procedure TForm1.WndProc;
begin
inherited;
//重定义窗体消息处理过程
end;
end.
Unit2
unit Unit2;
interface
uses
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls;
type
TBase = class // 等价于 TBase = class(TObject)
public //便于显示设置未可见
s: string;
s1: string;
// procedure Free; override; // Cannot override a static method TObject.Free
// procedure Free; //重定义Free static 不可被重写
procedure Free; virtual; //重定义Free 可被重写
// constructor Create(); //显示定义构造器，不使用默认的TObject.create，默认静态不能被派生类重写
// destructor Destory(); //显示定义析构器，不使用默认的TObject.Destory，默认静态不能被派生类重写
constructor Create(); virtual; //virtual显示定义构造器，可被派生类重写
destructor Destory(); virtual; //virtual显示定义构造器，可被派生类重写
// constructor Create(); override; // Cannot override a static method
// destructor Destory(); override; //TObject.Destory虽可被重写，但不可见: Method ‘Destory‘ not found in base class
end;
{同一个单元定义的类互为友元类，可以互相访问private域, 否则TBase.s1为私有时TTest.s1报错：不可见}
TTest = class(TBase)
public //便于显示设置未可见
s: string; //属性同名使用TTest.s 非 TBase.s ;不同名TTest.s1是 TBase.s1
s2: string;
procedure Free; override;
constructor Create(); override;
destructor Destory(); override;
procedure FrendClass;
end;
implementation
uses Unit1;
{ TBase }
constructor TBase.Create;
begin
inherited; //必须显示调用父类构造函数
Self.s := ‘TBase.s‘;
Self.s1 := ‘TBase.s1‘;
Form1.writeLog(‘执行的是：TBase.Create‘);
end;
destructor TBase.Destory;
begin
Form1.writeLog(‘执行的是：TBase.Destory‘);
inherited; //必须显示调用父类析构函数
end;
procedure TBase.Free;
begin
Form1.writeLog(‘执行的是：TBase.Free‘);
Destory;
end;
{ TTest }
constructor TTest.Create;
begin
inherited; //必须显示调用父类构造函数
Self.s2 := ‘TTest.s2‘;
Form1.writeLog(‘执行的是：TTest.Create‘);
end;
destructor TTest.Destory;
begin
Form1.writeLog(‘执行的是：TTest.Destory‘);
inherited; //必须显示调用父类析构函数
end;
procedure TTest.Free;
begin
Form1.writeLog(‘执行的是：TTest.Free‘);
destory;
end;
procedure TTest.FrendClass;
begin
Form1.writeLog(‘执行的是：TTest.FrendClass‘);
{同一个单元定义的类互为友元类，可以互相访问private域, 否则TBase.s1为私有时Self.s1报错：不可见}
Form1.writeLog(‘TTest.s=‘ + Self.s + ‘ ;‘ + ‘TTest.s1=‘ + Self.s1 + ‘ ;‘ + ‘TTest.s2=‘ + Self.s2);
end;
end.
运行结果
原文：https://www.cnblogs.com/LwrCodingLife/p/14697904.html