----开发环境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 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结束