Delphi中对象和类空间虚拟方法表之一

----开发环境Delphi7

---

这个例子还没有写完

---

---Delphi多态性的实现有点资料，仅供参考！

-----------------效果图：

----------------------

Unit开始

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls, ExtCtrls, TypInfo ;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     Button1: TButton;
 12     Button2: TButton;
 13     Button3: TButton;
 14     Button4: TButton;
 15     Bevel1: TBevel;
 16     Shape1: TShape;
 17     Memo1: TMemo;
 18     Label1: TLabel;
 19     Button5: TButton;
 20     Button6: TButton;
 21     procedure Button1Click(Sender: TObject);
 22     procedure Button2Click(Sender: TObject);
 23     procedure Button3Click(Sender: TObject);
 24     procedure Button4Click(Sender: TObject);
 25     procedure Button5Click(Sender: TObject);
 26     procedure Button6Click(Sender: TObject);
 27   private
 28     { Private declarations }
 29   public
 30     { Public declarations }
 31   end;
 32 
 33   TmyClass_A=class
 34   private
 35     FName:string;
 36   public
 37     procedure SetName(const vName: string);virtual;
 38     procedure SetName01(const vName: string);virtual;
 39     procedure SetName02(const vName: string);
 40     function GetName:string;
 41   property
 42     Name:String read GetName write SetName;
 43   end;
 44 
 45   TmyClassA=class
 46   private
 47     FName:string;
 48     FAge:Integer;
 49   end;
 50 
 51   TMyClassA_1=class(TmyClassA)
 52   private
 53     FColor:string;
 54   end;
 55 
 56   ///////////////////测试对象空间、类空间问题、虚拟方法表///////////////////////
 57   TmyProcedure=procedure(const sName :string) of object;
 58   TMyClassB=class
 59   private
 60     FName:String;
 61   public
 62     procedure SetName(const sName: string);virtual;
 63     procedure SetName02(const sName: string);
 64   end;
 65   TMyClassB_1=class(TMyClassB)
 66   private
 67     FAge:Integer;
 68     FColor:String;
 69   public
 70     procedure SetNameB(const sName: string);virtual;
 71     procedure SetNameB02(const sName: string);
 72   end;
 73 
 74   TMyClassS=class of TMyClassB;
 75   //////////////////////////////////////////
 76 var
 77   Form1: TForm1;
 78 
 79 implementation
 80 
 81 {$R *.dfm}
 82 
 83 procedure TForm1.Button1Click(Sender: TObject);
 84 var
 85   vClassA:TmyClass_A;
 86 begin
 87   vClassA:=TmyClass_A.Create;
 88   vClassA.SetName02('AAAA');
 89   vClassA.SetName('AABB');
 90   vClassA.SetName01('AACC');
 91   //vClassA.Name:='AAAA';
 92   ShowMessage(vClassA.Name);
 93 end;
 94 
 95 { TmyClass_A }
 96 
 97 function TmyClass_A.GetName: string;
 98 begin
 99   Result:=FName;
100 end;
101 
102 procedure TmyClass_A.SetName(const vName: string);
103 begin
104   FName:=vName;
105 end;
106 
107 procedure TmyClass_A.SetName01(const vName: string);
108 begin
109   FName:=vName;
110 end;
111 
112 procedure TmyClass_A.SetName02(const vName: string);
113 begin
114   FName:=vName;
115 end;
116 
117 procedure TForm1.Button2Click(Sender: TObject);
118 var
119  vClassA:TmyClassA;
120 begin
121   try
122     vClassA:=TmyClassA.Create;
123     TMyClassA_1(vClassA).FColor:='红色';
124     ShowMessage(TMyClassA_1(vClassA).FColor);
125   finally
126     FreeAndNil(vClassA);
127   end;
128 end;
129 
130 procedure TForm1.Button3Click(Sender: TObject);
131 var
132   vClassB:TMyClassB;
133   vPro:TmyProcedure;
134   vp:Pointer;
135 begin
136   Memo1.Lines.Add('---开始--------------Button3--TMyClassB-----------------');
137   try
138     Memo1.Lines.Add('TObject类地址(TObject虚拟方法表地址):'+IntToStr(Integer(TObject)));
139     Memo1.Lines.Add('vClassB变量地址：'+IntToStr(Integer(@vClassB)));
140     vClassB:=TMyClassB.Create;
141     Memo1.Lines.Add('---猜测测试---开始--------');
142     Memo1.Lines.Add('TMyClassB实例的大小：'+IntToStr(PInteger(Integer(TMyClassB) + vmtInstanceSize)^));
143     Memo1.Lines.Add('TMyClassB实例的大小：'+IntToStr(vClassB.InstanceSize ));
144     Memo1.Lines.Add('保存TMyClassB实例的大小的地址：'+IntToStr(Integer(Integer(TMyClassB) + vmtInstanceSize)));
145     Memo1.Lines.Add('TMyClassB的VMT中vmtSelfPtr的地址：'+IntToStr(Integer(Integer(TMyClassB) + vmtSelfPtr)));
146     Memo1.Lines.Add('TMyClassB的VMT中vmtSelfPtr指向的地址：'+IntToStr(PInteger(Integer(TMyClassB) + vmtSelfPtr)^));
147     Memo1.Lines.Add('---猜测测试---开始--------');
148     Memo1.Lines.Add('TMyClassB实例的地址(vClassB指向的地址)：'+IntToStr(Integer(vClassB)));
149     Memo1.Lines.Add('TMyClassB类地址：'+IntToStr(PInteger(vClassB)^));
150     Memo1.Lines.Add('TMyClassB类地址：'+IntToStr(Integer(TMyClassB))); //类地址也就是类空间,也是虚拟方法表地址
151     vClassB.SetName('555');
152     Memo1.Lines.Add('FName地址：'+IntToStr(Integer(vClassB)+$4)+'   内容：'+Pstring(Integer(vClassB)+$4)^);
153     Memo1.Lines.Add('FName地址：'+IntToStr(integer(@vClassB.FName))+'   内容：'+Pstring(integer(@vClassB.FName))^);
154     vPro:=vClassB.SetName02;
155     vp:=@vPro;
156     if vp<>nil then
157     begin
158       vPro('999');
159     end;
160     Memo1.Lines.Add('SetName02地址：'+IntToStr(integer(vp)) +'   内容：'+vClassB.Fname);
161     vPro:=vClassB.SetName;
162     vp:=@vPro;
163     if vp<>nil then
164     begin
165       vPro('AAA');
166     end;
167     Memo1.Lines.Add('SetName地址：'+IntToStr(integer(vp)) +'   内容：'+vClassB.Fname); //TMyClassB类的虚拟方法表地址 也刚好第一个虚拟函数的地址
168   finally
169     FreeAndNil(vClassB);
170     Memo1.Lines.Add('---结束--------------Button3--TMyClassB-----------------');
171   end;
172 end;
173 
174 { TMyClassB }
175 
176 procedure TMyClassB.SetName(const sName: string);
177 begin
178   FName:='TMyClassB.SetName_virtual_'+sName;
179 end;
180 
181 procedure TMyClassB.SetName02(const sName: string);
182 begin
183   FName:='TMyClassB.SetName02_'+sName;
184 end;
185 
186 { TMyClassB_1 }
187 
188 procedure TMyClassB_1.SetNameB(const sName: string);
189 begin
190   FName:='TMyClassB_1.SetNameB_virtual_'+sName;
191 end;
192 
193 procedure TMyClassB_1.SetNameB02(const sName: string);
194 begin
195   FName:='TMyClassB_1.SetNameB02_'+sName;
196 end;
197 
198 procedure TForm1.Button4Click(Sender: TObject);
199 var
200   vClassB:TMyClassB_1;
201   vPro:TmyProcedure;
202   vp:Pointer;
203 begin
204   Memo1.Lines.Add('--开始-------Button4------TMyClassB_1=class(TMyClassB)--------');
205   try
206     vClassB:=TMyClassB_1.Create;
207     Memo1.Lines.Add('TMyClassB_1实例的地址(vClassB指向的地址)：'+IntToStr(Integer(vClassB)));
208     Memo1.Lines.Add('TMyClassB_1类地址：'+IntToStr(PInteger(vClassB)^));
209     vClassB.SetName('555');
210     Memo1.Lines.Add('FName地址：'+IntToStr(Integer(vClassB)+$4)+'   内容：'+Pstring(Integer(vClassB)+$4)^);
211     Memo1.Lines.Add('FName地址：'+IntToStr(integer(@vClassB.FName))+'   内容：'+Pstring(integer(@vClassB.FName))^);
212     vPro:=vClassB.SetName02;
213     vp:=@vPro;
214     if vp<>nil then
215     begin
216       vPro('999');
217     end;
218     Memo1.Lines.Add('SetName02地址：'+IntToStr(integer(vp)) +'   内容：'+vClassB.Fname);
219     vPro:=vClassB.SetName;
220     vp:=@vPro;
221     if vp<>nil then
222     begin
223       vPro('AAA');
224     end;
225     Memo1.Lines.Add('SetName地址：'+IntToStr(integer(vp)) +'   内容：'+vClassB.Fname);
226   finally
227     FreeAndNil(vClassB);
228     Memo1.Lines.Add('--结束-------Button4------TMyClassB_1=class(TMyClassB)--------');
229   end;
230 end;
231 
232 procedure TForm1.Button5Click(Sender: TObject);
233 var
234   vArray:array[0..5] of Integer ;
235   vp2,vp3:PInteger;
236   vInt:Integer;
237 begin
238   //GetMem(vp2,SizeOf(vArray));
239   ShowMessage(IntToStr(SizeOf(vArray)));
240   vp2:=GetMemory(SizeOf(vArray));
241   vp3:=vp2;
242   vArray[0]:=91;
243   vArray[1]:=99;
244   vp2:=@vArray;
245   vInt:=Pinteger(vp2)^;
246   ShowMessage(IntToStr(vInt));
247   Inc(vp2);
248   vInt:=Pinteger(vp2)^;
249   ShowMessage(IntToStr(vInt));
250   FreeMemory(vp3);
251   //FreeMem(vp3);
252 end;
253 
254 procedure TForm1.Button6Click(Sender: TObject);
255 var
256   vArray:array[0..5] of String ;
257   vp2,vp3:^String;
258   vStr:String;
259 begin
260   //GetMem(vp2,SizeOf(vArray));
261   ShowMessage(IntToStr(SizeOf(vArray)));
262   vp2:=GetMemory(SizeOf(vArray));
263   vp3:=vp2;
264   vArray[0]:='91';
265   vArray[1]:='99';
266   vp2:=@vArray;
267   vStr:=vp2^;
268   ShowMessage(vStr);
269   Inc(vp2);
270   vStr:=vp2^;
271   ShowMessage(vStr);
272   FreeMemory(vp3);
273   //FreeMem(vp3);
274 end;
275 
276 end.
277 //虚拟方法表在System单元
278 //Delphi7在146行开始
279 { Virtual method table entries }
280 
281   vmtSelfPtr           = -76;
282   vmtIntfTable         = -72;
283   vmtAutoTable         = -68;
284   vmtInitTable         = -64;
285   vmtTypeInfo          = -60;
286   vmtFieldTable        = -56;
287   vmtMethodTable       = -52;
288   vmtDynamicTable      = -48;
289   vmtClassName         = -44;
290   vmtInstanceSize      = -40;
291   vmtParent            = -36;
292   vmtSafeCallException = -32 deprecated;  // don't use these constants.
293   vmtAfterConstruction = -28 deprecated;  // use VMTOFFSET in asm code instead
294   vmtBeforeDestruction = -24 deprecated;
295   vmtDispatch          = -20 deprecated;
296   vmtDefaultHandler    = -16 deprecated;
297   vmtNewInstance       = -12 deprecated;
298   vmtFreeInstance      = -8 deprecated;
299   vmtDestroy           = -4 deprecated;
300 
301   vmtQueryInterface    = 0 deprecated;
302   vmtAddRef            = 4 deprecated;
303   vmtRelease           = 8 deprecated;
304   vmtCreateObject      = 12 deprecated;

Unit结束

Form开始

  1 object Form1: TForm1
  2   Left = 686
  3   Top = 309
  4   BorderStyle = bsDialog
  5   Caption = 'Form1'
  6   ClientHeight = 508
  7   ClientWidth = 624
  8   Color = clBtnFace
  9   Font.Charset = DEFAULT_CHARSET
 10   Font.Color = clWindowText
 11   Font.Height = -11
 12   Font.Name = 'MS Sans Serif'
 13   Font.Style = []
 14   OldCreateOrder = False
 15   Position = poDesktopCenter
 16   PixelsPerInch = 96
 17   TextHeight = 13
 18   object Bevel1: TBevel
 19     Left = 0
 20     Top = 104
 21     Width = 529
 22     Height = 5
 23     Shape = bsTopLine
 24     Style = bsRaised
 25   end
 26   object Shape1: TShape
 27     Left = 0
 28     Top = 88
 29     Width = 537
 30     Height = 9
 31     Pen.Color = clPurple
 32     Pen.Width = 5
 33   end
 34   object Label1: TLabel
 35     Left = 128
 36     Top = 72
 37     Width = 257
 38     Height = 13
 39     AutoSize = False
 40     Caption = #32447#26465#20197#19978#25353#38062#19981#29992#31649#65292#26412#20154#27979#35797#29992#30340
 41   end
 42   object Button1: TButton
 43     Left = 16
 44     Top = 8
 45     Width = 75
 46     Height = 25
 47     Caption = 'Button1'
 48     TabOrder = 0
 49     OnClick = Button1Click
 50   end
 51   object Button2: TButton
 52     Left = 104
 53     Top = 8
 54     Width = 75
 55     Height = 25
 56     Caption = 'Button2'
 57     TabOrder = 1
 58     OnClick = Button2Click
 59   end
 60   object Button3: TButton
 61     Left = 448
 62     Top = 152
 63     Width = 75
 64     Height = 25
 65     Caption = 'Button3'
 66     TabOrder = 2
 67     OnClick = Button3Click
 68   end
 69   object Button4: TButton
 70     Left = 448
 71     Top = 200
 72     Width = 75
 73     Height = 25
 74     Caption = 'Button4'
 75     TabOrder = 3
 76     OnClick = Button4Click
 77   end
 78   object Memo1: TMemo
 79     Left = 0
 80     Top = 112
 81     Width = 433
 82     Height = 369
 83     ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
 84     ScrollBars = ssBoth
 85     TabOrder = 4
 86   end
 87   object Button5: TButton
 88     Left = 208
 89     Top = 8
 90     Width = 75
 91     Height = 25
 92     Caption = 'Button5'
 93     TabOrder = 5
 94     OnClick = Button5Click
 95   end
 96   object Button6: TButton
 97     Left = 296
 98     Top = 8
 99     Width = 75
100     Height = 25
101     Caption = 'Button6'
102     TabOrder = 6
103     OnClick = Button6Click
104   end
105 end

Form结束 

【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/dmqhjp/p/15181436.html