码农的笔记

Delphi虽好，但已不流行； 博客真好，可以做笔记
博客园 首页 新随笔 联系 订阅 管理
Delphi中对象和类空间虚拟方法表之一

----开发环境Delphi7

---

这个例子还没有写完

---

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

 

 

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

 

 

 ------------------------------这几行代码是纠错用的

1 procedure TForm1.Button1Click(Sender: TObject);
2 var
3   vp:Pointer;
4 begin
5   vp:=pinteger(Integer(TMyclassA)-76); //Integer(TMyclassA)得到的不是虚拟方法表的地址，而是这个TMyclassA的地址；这个地址-76就是虚拟方法表地址
6   ShowMessage(TObject(vp).ClassName);
7 end;

----------------------这几行代码是纠错下面的例子，虽然下面的一些解释已经改正过来了，这个还是保留着

 

 

 

 

 

 

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

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))); //类地址,类地址-76是虚拟方法表地址
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类的类地址也刚好是第一个虚拟函数的地址(父类是Tobject才是这样)
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结束 

 

 

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

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

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

随便测试

 

 

 

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     Button1: TButton;
 12     Memo1: TMemo;
 13     Button2: TButton;
 14     Button3: TButton;
 15     procedure Button1Click(Sender: TObject);
 16     procedure Button2Click(Sender: TObject);
 17     procedure Button3Click(Sender: TObject);
 18   private
 19     { Private declarations }
 20   public
 21     { Public declarations }
 22   end;
 23 
 24   TMYCALSS=class
 25   private
 26     FInstanceName:String;
 27 
 28     procedure MyCommonProc(Sender:TObject );
 29 
 30     protected
 31 
 32     public
 33       constructor Create;
 34       procedure MyBasevirtual(Sender:TObject );virtual;
 35   end;
 36 
 37   TMyClassDerive=class(TMYCALSS)
 38   private
 39     procedure MyCommonProc(Sender:TObject );
 40   public
 41     procedure MyBasevirtual(Sender:TObject );override;
 42   end;
 43 var
 44   Form1: TForm1;
 45 
 46 
 47 implementation
 48 
 49 
 50 
 51 {$R *.dfm}
 52 
 53 
 54 procedure TForm1.Button1Click(Sender: TObject);
 55 var
 56   vClass:TMYCALSS ;
 57   vmy:TNotifyEvent;
 58   vs:string;
 59   vp:Pointer;
 60 begin
 61   vClass:=TMYCALSS.Create  ;
 62   Memo1.Lines.Add(IntToStr(Integer(@TMYCALSS.MyCommonProc)));//vClass.MyCommonProc的地址
 63   Vmy:=vClass.MyCommonProc;
 64   Memo1.Lines.Add(IntToStr(Integer(@Vmy)));//vClass.MyCommonProc的地址  //明显是跟类走得
 65   vs:=vClass.FInstanceName;
 66   Memo1.Lines.Add(IntToStr(Integer(@vClass.FInstanceName))); //FInstanceName的地址
 67   vp:=@vClass.FInstanceName;
 68   Memo1.Lines.Add(IntToStr(Integer(vp)));//FInstanceName的地址
 69   Memo1.Lines.Add(IntToStr(Integer(vClass)));//对象的地址
 70 
 71   FreeAndNil(vClass);
 72 end;
 73 
 74 { TMYCALSS }
 75 
 76 constructor TMYCALSS.Create;
 77 begin
 78   inherited Create;
 79   FInstanceName:='MYCALSS1';
 80 end;
 81 
 82 procedure TMYCALSS.MyBasevirtual(Sender:TObject );
 83 begin
 84   ShowMessage('TMYCALSS.MyBasevirtual');
 85 end;
 86 
 87 procedure TMYCALSS.MyCommonProc(Sender:TObject);
 88 begin
 89   ShowMessage('TMYCALSS.MyCommonProc');
 90 end;
 91 
 92 procedure TForm1.Button2Click(Sender: TObject);
 93 var
 94   vClass:TMyClassDerive ;
 95   vmy:TNotifyEvent;
 96 begin
 97   vClass:=TMyClassDerive.Create  ;
 98   //Memo1.Lines.Add(IntToStr(Integer(TMyClassDerive)));
 99   Memo1.Lines.Add(IntToStr(Integer(@TMyClassDerive.MyBasevirtual)));
100   Vmy:=TMyCalss(vClass).MyBasevirtual; //强制转换后  虚方法被覆盖  //这个MyBasevirtual和上面的地址一样
101   Memo1.Lines.Add(IntToStr(Integer(@Vmy)));
102 
103 
104   FreeAndNil(vClass);
105 end;
106 
107 { TMyClassDerive }
108 
109 procedure TMyClassDerive.MyBasevirtual(Sender:TObject );
110 begin
111   //inherited;
112   ShowMessage('TMyClassDerive.MyBasevirtual');
113 end;
114 
115 procedure TForm1.Button3Click(Sender: TObject);
116 var
117   vClass:TMyClassDerive ;
118   vmy:TNotifyEvent;
119 begin
120   vClass:=TMyClassDerive.Create  ;
121 
122   //这里的两个地址不一样，静态方法的这个例子，和虚方法的那个例子对比下，，这也是虚方法能实现多态的原因
123   Memo1.Lines.Add(IntToStr(Integer(@TMyClassDerive.MyCommonProc)));//静态方法  注意声明
124   //Vmy:=vClass.MyCommonProc;
125   Vmy:=TMyCalss(vClass).MyCommonProc;//静态方法    注意声明
126   Memo1.Lines.Add(IntToStr(Integer(@Vmy)));
127   FreeAndNil(vClass);
128 end;
129 
130 procedure TMyClassDerive.MyCommonProc(Sender: TObject);
131 begin
132   inherited;
133   //
134 end;
135 
136 end.

 

 

 1 object Form1: TForm1
 2   Left = 822
 3   Top = 398
 4   Width = 369
 5   Height = 360
 6   Caption = 'Form1'
 7   Color = clBtnFace
 8   Font.Charset = DEFAULT_CHARSET
 9   Font.Color = clWindowText
10   Font.Height = -11
11   Font.Name = 'MS Sans Serif'
12   Font.Style = []
13   OldCreateOrder = False
14   PixelsPerInch = 96
15   TextHeight = 13
16   object Button1: TButton
17     Left = 8
18     Top = 24
19     Width = 75
20     Height = 25
21     Caption = 'Button1'
22     TabOrder = 0
23     OnClick = Button1Click
24   end
25   object Memo1: TMemo
26     Left = 8
27     Top = 64
28     Width = 305
29     Height = 217
30     ImeName = '中文(简体) - 搜狗拼音输入法'
31     ScrollBars = ssBoth
32     TabOrder = 1
33   end
34   object Button2: TButton
35     Left = 104
36     Top = 24
37     Width = 75
38     Height = 25
39     Caption = 'Button2'
40     TabOrder = 2
41     OnClick = Button2Click
42   end
43   object Button3: TButton
44     Left = 192
45     Top = 24
46     Width = 75
47     Height = 25
48     Caption = 'Button3'
49     TabOrder = 3
50     OnClick = Button3Click
51   end
52 end

 

posted on 2021-08-24 17:36  码农的笔记  阅读(65)  评论(0)  编辑  收藏  举报