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

----开发环境Delphi7

---

这个例子还没有写完

---

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

 

 

-----------------效果图:

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     procedure Button1Click(Sender: TObject);
 20     procedure Button2Click(Sender: TObject);
 21     procedure Button3Click(Sender: TObject);
 22     procedure Button4Click(Sender: TObject);
 23   private
 24     { Private declarations }
 25   public
 26     { Public declarations }
 27   end;
 28 
 29   TmyClass_A=class
 30   private
 31     FName:string;
 32   public
 33     procedure SetName(const vName: string);virtual;
 34     procedure SetName01(const vName: string);virtual;
 35     procedure SetName02(const vName: string);
 36     function GetName:string;
 37   property
 38     Name:String read GetName write SetName;
 39   end;
 40 
 41   TmyClassA=class
 42   private
 43     FName:string;
 44     FAge:Integer;
 45   end;
 46 
 47   TMyClassA_1=class(TmyClassA)
 48   private
 49     FColor:string;
 50   end;
 51 
 52   ///////////////////测试对象空间、类空间问题、虚拟方法表///////////////////////
 53   TmyProcedure=procedure(const sName :string) of object;
 54   TMyClassB=class
 55   private
 56     FName:String;
 57   public
 58     procedure SetName(const sName: string);virtual;
 59     procedure SetName02(const sName: string);
 60   end;
 61   TMyClassB_1=class(TMyClassB)
 62   private
 63     FAge:Integer;
 64     FColor:String;
 65   public
 66     procedure SetNameB(const sName: string);virtual;
 67     procedure SetNameB02(const sName: string);
 68   end;
 69   //////////////////////////////////////////
 70 var
 71   Form1: TForm1;
 72 
 73 implementation
 74 
 75 {$R *.dfm}
 76 
 77 procedure TForm1.Button1Click(Sender: TObject);
 78 var
 79   vClassA:TmyClass_A;
 80 begin
 81   vClassA:=TmyClass_A.Create;
 82   vClassA.SetName02(AAAA);
 83   vClassA.SetName(AABB);
 84   vClassA.SetName01(AACC);
 85   //vClassA.Name:=‘AAAA‘;
 86   ShowMessage(vClassA.Name);
 87 end;
 88 
 89 { TmyClass_A }
 90 
 91 function TmyClass_A.GetName: string;
 92 begin
 93   Result:=FName;
 94 end;
 95 
 96 procedure TmyClass_A.SetName(const vName: string);
 97 begin
 98   FName:=vName;
 99 end;
100 
101 procedure TmyClass_A.SetName01(const vName: string);
102 begin
103   FName:=vName;
104 end;
105 
106 procedure TmyClass_A.SetName02(const vName: string);
107 begin
108   FName:=vName;
109 end;
110 
111 procedure TForm1.Button2Click(Sender: TObject);
112 var
113  vClassA:TmyClassA;
114 begin
115   try
116     vClassA:=TmyClassA.Create;
117     TMyClassA_1(vClassA).FColor:=红色;
118     ShowMessage(TMyClassA_1(vClassA).FColor);
119   finally
120     FreeAndNil(vClassA);
121   end;
122 end;
123 
124 procedure TForm1.Button3Click(Sender: TObject);
125 var
126   vClassB:TMyClassB;
127   vPro:TmyProcedure;
128   vp:Pointer;
129 begin
130   Memo1.Lines.Add(---开始--------------Button3--TMyClassB-----------------);
131   try
132     vClassB:=TMyClassB.Create;
133     Memo1.Lines.Add(TMyClassB实例的地址(vClassB指向的地址):+IntToStr(Integer(vClassB)));
134     Memo1.Lines.Add(TMyClassB类地址:+IntToStr(PInteger(vClassB)^));
135     Memo1.Lines.Add(TMyClassB类地址:+IntToStr(Integer(TMyClassB)));
136     Memo1.Lines.Add(TMyClassB类的虚拟方法表地址:+IntToStr(Pinteger(PInteger(vClassB)^)^));
137     vClassB.SetName(555);
138     Memo1.Lines.Add(FName地址:+IntToStr(Integer(vClassB)+$4)+   内容:+vClassB.Fname);
139     vPro:=vClassB.SetName02;
140     vp:=@vPro;
141     if vp<>nil then
142     begin
143       vPro(999);
144     end;
145     Memo1.Lines.Add(SetName02地址:+IntToStr(integer(vp)) +   内容:+vClassB.Fname);
146     vPro:=vClassB.SetName;
147     vp:=@vPro;
148     if vp<>nil then
149     begin
150       vPro(AAA);
151     end;
152     Memo1.Lines.Add(SetName地址:+IntToStr(integer(vp)) +   内容:+vClassB.Fname); //TMyClassB类的虚拟方法表地址 也刚好第一个虚拟函数的地址
153   finally
154     FreeAndNil(vClassB);
155     Memo1.Lines.Add(---结束--------------Button3--TMyClassB-----------------);
156   end;
157 end;
158 
159 { TMyClassB }
160 
161 procedure TMyClassB.SetName(const sName: string);
162 begin
163   FName:=TMyClassB.SetName_virtual_+sName;
164 end;
165 
166 procedure TMyClassB.SetName02(const sName: string);
167 begin
168   FName:=TMyClassB.SetName02_+sName;
169 end;
170 
171 { TMyClassB_1 }
172 
173 procedure TMyClassB_1.SetNameB(const sName: string);
174 begin
175   FName:=TMyClassB_1.SetNameB_virtual_+sName;
176 end;
177 
178 procedure TMyClassB_1.SetNameB02(const sName: string);
179 begin
180   FName:=TMyClassB_1.SetNameB02_+sName;
181 end;
182 
183 procedure TForm1.Button4Click(Sender: TObject);
184 var
185   vClassB:TMyClassB_1;
186   vPro:TmyProcedure;
187   vp:Pointer;
188 begin
189   Memo1.Lines.Add(--开始-------Button4------TMyClassB_1=class(TMyClassB)--------);
190   try
191     vClassB:=TMyClassB_1.Create;
192     Memo1.Lines.Add(TMyClassB_1实例的地址(vClassB指向的地址):+IntToStr(Integer(vClassB)));
193     Memo1.Lines.Add(TMyClassB_1类地址:+IntToStr(PInteger(vClassB)^));
194     vClassB.SetName(555);
195     Memo1.Lines.Add(FName地址:+IntToStr(Integer(vClassB)+$4)+   内容:+vClassB.Fname);
196     vPro:=vClassB.SetName02;
197     vp:=@vPro;
198     if vp<>nil then
199     begin
200       vPro(999);
201     end;
202     Memo1.Lines.Add(SetName02地址:+IntToStr(integer(vp)) +   内容:+vClassB.Fname);
203     vPro:=vClassB.SetName;
204     vp:=@vPro;
205     if vp<>nil then
206     begin
207       vPro(AAA);
208     end;
209     Memo1.Lines.Add(SetName地址:+IntToStr(integer(vp)) +   内容:+vClassB.Fname);
210   finally
211     FreeAndNil(vClassB);
212     Memo1.Lines.Add(--结束-------Button4------TMyClassB_1=class(TMyClassB)--------);
213   end;
214 end;
215 
216 end.
217 //虚拟方法表在System单元
218 //Delphi7在146行开始
219 { Virtual method table entries }
220 
221   vmtSelfPtr           = -76;
222   vmtIntfTable         = -72;
223   vmtAutoTable         = -68;
224   vmtInitTable         = -64;
225   vmtTypeInfo          = -60;
226   vmtFieldTable        = -56;
227   vmtMethodTable       = -52;
228   vmtDynamicTable      = -48;
229   vmtClassName         = -44;
230   vmtInstanceSize      = -40;
231   vmtParent            = -36;
232   vmtSafeCallException = -32 deprecated;  // don‘t use these constants.
233   vmtAfterConstruction = -28 deprecated;  // use VMTOFFSET in asm code instead
234   vmtBeforeDestruction = -24 deprecated;
235   vmtDispatch          = -20 deprecated;
236   vmtDefaultHandler    = -16 deprecated;
237   vmtNewInstance       = -12 deprecated;
238   vmtFreeInstance      = -8 deprecated;
239   vmtDestroy           = -4 deprecated;
240 
241   vmtQueryInterface    = 0 deprecated;
242   vmtAddRef            = 4 deprecated;
243   vmtRelease           = 8 deprecated;
244   vmtCreateObject      = 12 deprecated;

 

Unit结束

 

Form开始

 1 object Form1: TForm1
 2   Left = 799
 3   Top = 313
 4   BorderStyle = bsDialog
 5   Caption = Form1
 6   ClientHeight = 508
 7   ClientWidth = 537
 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   PixelsPerInch = 96
16   TextHeight = 13
17   object Bevel1: TBevel
18     Left = 0
19     Top = 104
20     Width = 529
21     Height = 5
22     Shape = bsTopLine
23     Style = bsRaised
24   end
25   object Shape1: TShape
26     Left = 0
27     Top = 88
28     Width = 537
29     Height = 9
30     Pen.Color = clPurple
31     Pen.Width = 5
32   end
33   object Label1: TLabel
34     Left = 200
35     Top = 16
36     Width = 257
37     Height = 13
38     AutoSize = False
39     Caption = 这两个按钮不用管,本人测试用的
40   end
41   object Button1: TButton
42     Left = 16
43     Top = 8
44     Width = 75
45     Height = 25
46     Caption = Button1
47     TabOrder = 0
48     OnClick = Button1Click
49   end
50   object Button2: TButton
51     Left = 104
52     Top = 8
53     Width = 75
54     Height = 25
55     Caption = Button2
56     TabOrder = 1
57     OnClick = Button2Click
58   end
59   object Button3: TButton
60     Left = 448
61     Top = 152
62     Width = 75
63     Height = 25
64     Caption = Button3
65     TabOrder = 2
66     OnClick = Button3Click
67   end
68   object Button4: TButton
69     Left = 448
70     Top = 200
71     Width = 75
72     Height = 25
73     Caption = Button4
74     TabOrder = 3
75     OnClick = Button4Click
76   end
77   object Memo1: TMemo
78     Left = 0
79     Top = 112
80     Width = 433
81     Height = 369
82     ImeName = 中文(简体) - 搜狗拼音输入法
83     ScrollBars = ssBoth
84     TabOrder = 4
85   end
86 end

 

Form结束 

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

上一篇:DelphiXE10 String、ANSIString及TBytes之间的转换


下一篇:WebApi 使用Swagger