有3个类 A,B,C,继承关系 A-->B-->C,
A中有一个虚拟对象方法 Fun、B、C分别重载这个方法,
现在C要继承 A.Fun 而不是 B.Fun.
如何才能做到?type
  A = class
  public
    procedure Fun; virtual;
  end;  B = class(A)
  public
    procedure Fun; override;
  end;  C = class(B)
  public
    procedure Fun; override;
  end;implementationprocedure A.Fun;
begin
  ShowMessage('A');
end;procedure B.Fun;
begin
  ShowMessage('B');
end;procedure C.Fun;
begin
  //在这里调用A中的Fun,怎么可以做到???
  //这样试过:
  //1  (Self as A).Fun 可以编译通过,但结果不对。
  //2  A(Self).Fun;    可以编译通过,但结果不对。
end;

解决方案 »

  1.   

    瞎试的unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;type
      TA = class
      public
        procedure Fun; virtual;
      end;  TB = class(TA)
      public
        procedure Fun; override;
      end;  TC = class(TB)
      public
        procedure Fun; override;
      end;  TMainForm = class(TForm)
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      MainForm: TMainForm;implementation{$R *.dfm}procedure TMainForm.Button1Click(Sender: TObject);
    var
      a: TA;
    begin
      a := TC.Create;
      a.Fun;
      a.Free;
    end;{ TC }procedure TC.Fun;
    begin
      asm
        call TA.Fun
      end;
      ShowMessage('TC.Fun');
    end;{ TA }procedure TA.Fun;
    begin
      ShowMessage('TA.Fun');
    end;{ TB }procedure TB.Fun;
    begin
      ShowMessage('TB.Fun');
    end;end.
      

  2.   


    程序如下
    procedure c.Fun;
    begin
       c:=A.Create;
       c.Fun;
    end;
      

  3.   

    请问(Self as A).Fun结果是什么?
      

  4.   

    procedure C.Fun;
    var e:a;
    begin
     e:=a.Create;
     e.Fun;
     e.Free;
    end;(Self as A).Fun这个方法不可以,会导致delphi6无响应
      

  5.   

    谢谢大家的关注!大家可能误解了我的意思,我的目的是:
    我想操作一个从A继承下来的私有变量。A,B 在一个单元,C 在另一个单元,因此我在C中不能访问从A继承下来
    的私有变量,但是我现在要对这个私有变量操作,而A中有一个虚拟的
    公有方法.Fun,这个A.Fun就实现了这对私有变量的操作,因此我就想
    重载这个方法,先调用A.Fun 再做其他的事情!
      

  6.   

    摩托~~~
    你的理解有点问题(呵呵,没关系,只一点点~~)
    按你的写法,c的fun是和a的fun是没有关系的~~
    b已经把a的fun屏蔽掉了~~
    这个整个过程一句两句说不清~
    给你一种
    最解决方案:  TA = class
      public
        procedure Fun;  overload; virtual;
      end;  TB = class(TA)  public
        procedure Fun; overload;override;
        procedure fun(i:integer); overload;
      end;  TC = class(TB)
      public
        procedure Fun; override;
      end;  TForm1 = class(TForm)
        Button1: TButton;
        procedure FormCreate(Sender: TObject);
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
    beginend;{ TA }procedure TA.Fun;
    begin
    showmessage('a');
    end;{ TB }procedure TB.Fun;
    begin
    showmessage('b');end;procedure TB.fun(i: integer);
    begin
     inherited fun;
    end;{ TC }procedure TC.Fun;
    begin
    inherited fun(1);end;procedure TForm1.Button1Click(Sender: TObject);
    var
     c:tc;
    begin
     c:=tc.Create ;
     c.Fun ;
    end;
      

  7.   

    摩托想强调的是delphi和java在这个地方不同~~~,大家要注意这一点~~
      

  8.   

    还有上面的那位兄弟--》请问(Self as A).Fun结果是什么?这个语句正确与否我们不讨论,不过这种写法本身就摒弃了“继承”两个字
      

  9.   

    谢谢关注!xzgyb(老达摩):
      高明!
      我对汇编不太熟悉,确切的说是压根不懂,您能解释一下那一句的意思吗?
      这样可以了,
      但是当我在Fun过程里面加一个参数就不行了,会报错!del_c_sharp(摩托~◎~◎~◎):
      我不希望用 overload 啊,您看C++中的实现:class A Class B : public AClass C : public B在C的此虚函数中
    C::Fun
    {
      A::Fun;
    }为什么在 Object Pascal 中就不能这样呢?
    按道理应该也可以的吧!我的测试代码://类申明单元:
    unit uClass;interface
    uses Dialogs;type
      TA = class
      private
        FNote: string;
      public
        procedure Fun(S: string); virtual;
      end;  TB = class(TA)
      public
        procedure Fun(S: string); override;
      end;implementation{ A }procedure TA.Fun(S: string);
    begin
      FNote := 'A' + S;
      ShowMessage(FNote);
    end;{ B }procedure TB.Fun(S: string);
    begin
      FNote := 'B' + S;
      ShowMessage(FNote);
    end;end.//子类单元
    type
      TC = class(TB)
      public
        procedure Fun(S: string); override;
      end;implementation{ C }procedure TC.Fun(S: string);
    begin
      //这里,我希望给私有变量赋值 FNote := 'A';
      //如果直接继承 inherited; 那么继承的是B的: FNote := 'B' + S;
    end;
      

  10.   

    测试:
    procedure TForm1.Button1Click(Sender: TObject);
    var
      X: TC;
    begin
      X := TC.Create;
      X.Fun('X');
      X.Free;
    end;我希望弹出的信息是: ‘AX’,而不是‘BX’
      

  11.   

    //这样写就可以了。
    procedure C.Fun;
    var
      tmp: pointer;
    begin
      tmp := A;
      asm
        mov eax, self
        mov edx, [tmp]
        call dword ptr[edx + VMTOFFSET a.fun]
      end;
    end;
      

  12.   

    louislingjjw(云 意) :
    asm
     call TA.Fun
    end;
    就是调用直接调用TA.Fun
    直接写这条指令就会直接跑到TA.Fun处执行
    如果
    TA.Fun里有对成员的操作出错是因为这时EAX为零
    TA.Fun对数据成员的操作是根据self的偏移量执行的,在这里这个self
    也就是EAX
    改成这样
    procedure TC.Fun(s: string);
    begin
      asm
        push eax
        mov eax, self
        call TA.Fun
        pop eax
      end;
    end;
    可以出来你要的那个效果,主要是存一下EAX值
    刚学了点汇编,瞎写的,也不知对不对,有没有什么别的副作用
      

  13.   

    直接写 Inherited;就可以了呀!!
    我测试过
      

  14.   

    Sorry,我看错了直接写 Inherited;是不行的
      

  15.   

    xzgyb(老达摩):
      非常谢谢您!
      回头我也去买本汇编的书来看看,看来汇编在关键时刻还是很有用的!
      您说除了汇编,还有其他解决办法吗?
      

  16.   

    findcsdn(findcsdn):
      谢谢您!
      我刚刚试了,您这样也可以!
      很惭愧,我没有学过汇编呢,真是很羡慕你们,利用汇编来解决这个问题,
    我遇到这个问题时,实在是一点头绪也没有!
      

  17.   

    louislingjjw(云 意) :
    不用谢
    我也是瞎用
    根本就不懂
    除了汇编,好像没有别的方法
    因为Inherited只能调用父类的东西
      

  18.   

    楼上各位,强~
    xzgyb(老达摩) :TA.Fun对数据成员的操作是根据self的偏移量执行的,在这里这个self
    也就是EAX
    这句话怎么理解?
      

  19.   

    摩托兄:
      呵呵,我只是瞎试的,不知道对不对
      而且跟FindCsdn学了一招
      VMTOFFSET和DMTINDEX指令
      VMTOFFSET返回虚方法在虚表中的偏移量
      DMTINDEX返回动态方法的Index值
    而且帮助中的那个例子也挺有意思program Project2;type
      TExample = class
        procedure DynamicMethod; dynamic;
        procedure VirtualMethod; virtual;
      end;
    procedure TExample.DynamicMethod;
    begin
    end;
    procedure TExample.VirtualMethod;
    begin
    end;
    procedure CallDynamicMethod(e: TExample);
    asm
      // Save ESI register
      PUSH    ESI
      // Instance pointer needs to be in EAX
      MOV     EAX, e
      // DMT entry index needs to be in (E)SI
      MOV     ESI, DMTINDEX TExample.DynamicMethod
      // Now call the method
      CALL    System.@CallDynaInst  // Restore ESI register
      POP ESI
    end;
    procedure CallVirtualMethod(e: TExample);
    asm
      // Instance pointer needs to be in EAX
      MOV     EAX, e
      // Retrieve VMT table entry
      MOV     EDX, [EAX]
      // Now call the method at offset VMTOFFSET
      CALL    DWORD PTR [EDX + VMTOFFSET TExample.VirtualMethod]
    end;
    var
      e: TExample;
    begin
      e := TExample.Create;
      try
        CallDynamicMethod(e);
        CallVirtualMethod(e);
      finally
        e.Free;
      end;
    end.goodloop:  就是这样如
     TTest = class
      private
        FTest: Integer;
        FTest1: Integer;
      public
        constructor Create; 
        procedure ShowTest;
      end;
    ...implementation
    constructor TTest.Create;
    begin
      FTest := 20;
      FTest1 := 30;
    end;procedure TTest.ShowTest;
    begin
      ShowMessage(IntToStr(FTest));
      ShowMessage(IntToStr(FTest1));
    end;procedure TMainForm.Button2Click(Sender: TObject);
    var
      a: TTest;
    begin
      a := TTest.Create;
      a.ShowTest;
      a.Free;
    end;
      
    对于 a := TTest.Create;汇编如下
    mov dl, $01
    mov eax, [$0046afbc]
    call TTest.Create
    mov ebx, eax   //ebx保存了实例的引用值a.ShowTest 如下mov eax, ebx
    call TTest.ShowTest因为object pascal函数的调用默认是Fastcall 的,也就是参数先传到EAX,EDX,ECX,剩下的在压栈,而在类的函数里用的self值其实是隐藏的传过来
    的第一个参数,也就是EAX里的值
    在看一下TTest.ShowTest
    ...
    mov ebx,eax
    ...
    //对应于ShowMessage(IntToStr(FTest))
    lea eax, [ebp-$04]  //这是一个临时的字符串变量
    mov edx, [ebx+$04] 
    call IntToStr//[ebx+$04]即为FTest的值,[ebx]为vptr, [ebx+$08]为FTest1, 所以是访问类里的数据成员是通过相对于self的值的偏移量来访问这些可以打开cpu窗口来察看
      

  20.   

    呵呵,不用汇编,不用overload,真是很困难~想用pascal间接控制eax,难~
    达摩兄有没有做这样的尝试~~
      

  21.   

    问题已经解决了!
    这几天我都上不登陆不上 csdn !
    过几天来结帖吧,我还想问xzgyb(老达摩):一个问题!xzgyb(老达摩):
       非常谢谢您,您说得不错,希望您别介意啊,到时候我把结果整理一下,其实不用汇编来实现,就是找到 Self 在 VMT 的入口就可以,相信您也已经知道了,这是 xeen 告诉我的,我觉得这个问题比较有趣,我对汇编一窍不通,以前根本没看过,因此这两天我正在狠看汇编,对了,如果情况变化一下,就是把那几个类变化一下,如果还用您的汇编来实现,代码是不是需要相应地改变呢?//假设类的声明改变成如下:type
      TA = class(Tobject)
      private
        FNum1: string;
        FNum2: Integer;
        FNum3: Float;
        FNum4: DateTime;
        FNum5: string;
        FNum6: string; 
      public
        function temp1(X: string;): string; virtual;
        procedure temp2(X: Integer; Y: TDateTime): string; virtual;
        procedure fun(X: string; Y: Integer; Z: TDateTime);virtual;
      end;  TB = class(TA)
      private
       FNote1: string;
       FNote2: TDateTime;
       FNote3: Integer;
      protected
       X1: Integer;
      public
        function temp3(S: string): string; virtual;
        procedure temp4(I: Integer): string; virtual;
        procedure fun(X: string; Y: Integer; Z: TDateTime);override;
      end;  TC = class(TB)
      private
       FNote4: string;
       FNote5: TDateTime;
       FNote6: Integer;    
      protected
       X2: string;
      public
        function temp5(S: string): string; 
        procedure temp6(S: string); string;
        procedure fun(X: string; Y: Integer; Z: TDateTime);override;
      end;
      

  22.   

    louislingjjw(云 意):
    没关系,我也学到挺多东西。
    其实看汇编能知道很多编译器内部的东西
    虽然不用汇编来做程序,但了解一些东西还是比较有意思的
    不改到也可以
    也可以正确调用到TA的FUN
    但返回时有个错误,我还不太明白
    可能是堆栈不平衡造成的
    哎,这可能就是我汇编不懂,瞎用的结果,呵呵
      

  23.   

    louislingjjw(云 意):用xeen的方法就可以
    但不知你注意没,有个问题,比如这样TA = class(Tobject)
      private
        FNum1: string;
        FNum2: Integer;
        FNum3: Float;
        FNum4: DateTime;
        FNum5: string;
        FNum6: string; 
      public
        function temp1(X: string;): string; virtual;
        procedure temp2(X: Integer; Y: TDateTime): string; virtual;
        procedure fun(X: string; Y: Integer; Z: TDateTime);virtual;
        procedure ShowNum1;
      end;在实现时procedure TA.fun(X: string; Y: Integer; Z: TDateTime);
    begin
      FNum1 := X;
      ShowMessage(X + IntToStr(Y) + DateToStr(Z));
    end;
    然后
    procedure TA.ShowNum1;
    begin
      ShowMessage(FNum1);
    end;FNum1为空,也就是说用这种方法起不到设值数据成员的作用,只是调用
    那个函数,这还不是一个完美的解决方法
      

  24.   

    个人觉得Another_eYes的方法不错,但需要声明一下类型
    综合了Another_eYes和findcsdn的
    不需要键TA对象TCallFun = procedure (X: string; Y: Integer; Z: TDateTime) of object;procedure TC.fun(X: string; Y: Integer; Z: TDateTime);
    var
      m: TMethod;
      voffset: Integer;
    begin
      asm
        mov voffset, VMTOFFSET TA.fun
      end;
      m.Code := Pointer(Pointer((Integer(Classparent.ClassParent) + voffset))^);
      m.Data := self;
      TCallFun(m)(X, Y, Z);
    end;
      

  25.   

    xzgyb(老达摩):
      您说得不错,刚开始我还没明白这句的意思: TCallFun = procedure (X: string; Y: Integer; Z: TDateTime) of object; 所以到处翻书,现在明白了!
      

  26.   

    louislingjjw(云 意) :
      太客气了,'您您'的称呼真不敢当
      哈,
     不用客气,大家互相学习
      

  27.   

    xzgyb(老达摩):
      谢谢你这几天来的耐心指点,说句心里话,我真的很敬佩像你这样热心
    的高手,我现在总算明白了。这个问题最大的收获并不在于解决这个问题本身,而是大家在帮我分析这个问题时所涉及的相关知识,因为我遇到这个问题时,一时没找到解决办法,于是仔细想了想,觉得A,B,C三个类设计得有问题,于是改为C直接从A继承,多写了几行代码,问题就没有了,但是过后,心里还是在想:究竟怎么跨过父类去访问祖先类的私有方法呢?想了久没有思路,于是就来这里提问了,自己也不断去翻资料,现在对delphi比起以前有了略微清晰一点的认识!明天再来结贴吧!
      

  28.   

    louislingjjw(云 意):
      不用谢
      我水平很差,称不上高手,根本就不会编程序。
      有时候就是想瞎试试,瞎弄弄。
      其实通过这个贴子,我也学到了很多。
      其实有很多东西就是这样,真正的研究起来可以学到很多东西。
      真的是学无止境!
      

  29.   

    没有用手工做过
    不过如果要跨越中间去继承
    最简单就是用ROSE AND UML
    哈哈
      

  30.   

    谢谢各位的热心帮助!这个问题几天前已经解决了,方法有四种,其中有些原理是一样的。方法一:(指针)1)
    procedure C.Fun;
    var
      P: Pointer;
    begin
      P := Pointer(ClassParent.ClassParent); 
      //获得祖先类虚拟方法表入口地址;
      if Integer(P) <> 0 then
        A(Integer(P) - 76).Fun;              
      //取得self指针,强制类型转换.
    end;2) 
      只要知道Self指针就指向了虚拟方法表的入口, Self指针负的偏移量是
      一些类方法和RTTI信息的地址就行了
    procedure TC.fun(X: string; Y: Integer; Z: TDateTime);
    var
      p: pointer;
    begin
      p := Pointer(classparent.ClassParent);
      //获得祖父类虚拟方法表入口地址;
      if integer(p) <> 0 then
           ta(@p).Fun(x,y,z);                
      //取得self指针,强制类型转换.
    end;
    方法二:(汇编)
    1) 没有参数时
    procedure TC.Fun;
    begin
      asm
        call TA.Fun; //直接跑到TA.Fun处执行
      end;
    end;2) 有参数时,主要是存一下 EAX 值
    如果 TA.Fun 里有对成员的操作出错是因为这时 EAX 为零
    TA.Fun对数据成员的操作是根据 self 的偏移量执行的,
    在这里这个 self 也就是EAX改成这样procedure TC.Fun(s: string);
    begin
      asm
        push eax
        mov eax, self
        call TA.Fun
        pop eax
      end;
    end;3) 
    procedure C.Fun;
    var
      tmp: pointer;
    begin
      tmp := A;
      asm
        mov eax, self
        mov edx, [tmp]
        call dword ptr[edx + VMTOFFSET a.fun]
      end;
    end;说明:
    寄存器的用法:
    对于一般的 procedure ,function:
    在入口:     
     eax: 保存 procedure or function 的第一个参数值(如果存在的话)
     edx: 保存 procedure or function 的第二个参数值
     ecx: 保存 procedure or function 的第三个参数值
     ebx: 保存 procedure or function 的地址  在出口:
     eax: 对于function是保存结果;对于procedure一般是保存相关的自定义错误代码
     ebx: 仍是保存procedure or function的地址  对于对象的方法:
    在入口:    
     eax 保存parent对象的地址
     ebx 保存 procedure or function 的地址  
     ecx 保存第二个参数值
     edx 保存第一个参数值
    在出口:
     eax: 对于function是保存结果;对于procedure一般是保存相关的自定义错误代码
     ebx: 仍是保存procedure or function的地址  方法三:(参考类)
    1.
        A,B两个类与C在不同的单元内,那么C中Fun不要override,因为A,B中的Fun是在Public或
    Protected中,所以C的Fun中也可以用Inherited Fun,即在C中调用父类(即B)中的Fun。
    如果要跨过B直接调用A中的Fun,我们一般定义一个参考类,如:
    TARef=class(A)
    public
      procedure Fun;
    end;
    ...
    procedure TARef.Fun;
    begin
      Inherited Fun;
    end;procedure TC.Fun;
    begin
      TARef(Self).Fun  
    end;2.
        更多的情况,我们只是为了要在C中改变A中的私有变量,即改变不在同一单元中类的私有
    变量。解决这个问题,我们也是定义一个参考类。假设A类如下:
    A=class
    private
      X:Integer;
      Y:string;
    ....
    end;
    参考类则:
    TARef=class             //这里老子不是A,而是A的老子
    private
      X:Integer;
      Y:string;
    ...
    end;
    其实就是将A的定义搬过来,只是改了类名(注意只要私有域,不要私有方法)。
    这样在C的Fun中(或其它需要的地方)可以:
      TARef(Self).X:=123;
      TARef(Self).Y:='123';不过,这种方法有一个问题就是:一旦A的定义改了,我们的源程序也得改。这也是
    每次Delphi升级时我们的程序必须检查的地方。所谓定义参考类和指针操作private变量是一个原理。 
    定义的参考类其实就是为了确定你所关心的变量相对于实例入口的偏移。
    和指针操作的唯一区别就是参考类方法是由编译器帮你决定访问的指针偏移量,
    我的方法是由你自己计算这个指针偏移量而已。
    比如要在TC中访问TA.FNum3的话:  TA = class(Tobject)
      private
        FNum1: string;
        FNum2: Integer;
        FNum3: Float;
        FNum4: DateTime;
        FNum5: string;
        FNum6: string; 
      public
        function temp1(X: string;): string; virtual;
        procedure temp2(X: Integer; Y: TDateTime): string; virtual;
        procedure fun(X: string; Y: Integer; Z: TDateTime);virtual;
      end;  TB = class(TA)
      private
       FNote1: string;
       FNote2: TDateTime;
       FNote3: Integer;
      protected
       X1: Integer;
      public
        function temp3(S: string): string; virtual;
        procedure temp4(I: Integer): string; virtual;
        procedure fun(X: string; Y: Integer; Z: TDateTime);override;
      end;  TC = class(TB)
      private
       FNote4: string;
       FNote5: TDateTime;
       FNote6: Integer;    
      protected
       X2: string;
      public
        function temp5(S: string): string; 
        procedure temp6(S: string); string;
        procedure fun(X: string; Y: Integer; Z: TDateTime);override;
      end;指针: 
    type
      TRefRecord=record      // TB里我们所要跳过的私有变量
        FNum1: string;
        FNum2: Integer;
        FNum3: Float;
      end;
      PRefRecord=^TRefRecord;var
      pt: PRefRecord;
      c: TC;
    ...
    pt := Pointer(Integer(c)+TObject.InstanceSize);
    pt^.FNum3 := 5.5;参考类:
      TRef = class
      private
        FNum1: string;
        FNum2: Integer;
        FNum3: Float;
      end;
    var
      c: TC;
    ...
    TRef(c).FNum3 := 5.5这两种方法操作的都是TA.FNum3这个私有变量同理: 要访问TB.FNote2的话指针:
    type
      TRefRecord=record
        FNote1: string;
        FNote2: TDateTime;
      end;
    var
      pt: ^TRefRecord;
      c: TC;
    pt := pointer(integer(c)+TA.InstanceSize);
    pt^.FNote2 := now;参考类:
      TRef = class(TA)
      private
        FNote1: string;
        FNote2: TDateTime;
      end;var
      c: TC;TRef(c).FNote2 := now;方法四:(汇编+指针)
    TCallFun = procedure (X: string; Y: Integer; Z: TDateTime) of object;procedure TC.fun(X: string; Y: Integer; Z: TDateTime);
    var
      m: TMethod;
      voffset: Integer;
    begin
      asm
        mov voffset, VMTOFFSET TA.fun
      end;
      m.Code := Pointer(Pointer((Integer(Classparent.ClassParent) + voffset))^);
      m.Data := self;
      TCallFun(m)(X, Y, Z);
    end;注:修改父类的指针变量//修改父类的私有变量
    procedure TC.Fun(S: string);
    var
      P: PString;
    begin
      P := Pointer(Integer(Self) + TObject.InstanceSize);  // p 现在指向TA.FNode
      P^ := 'A' + S;
      ShowMessage(P^);
    end;//说明
    这个self指的是TC的实例所在的地址,在那里数据是这样排列的:
    TC.VMT入口地址
    TObject所有的Private,protected,public变量
    TA所有private,protected,public变量
    TB所有private,protected,public变量
    TC所有private,protected,public变量
    ...(是否还有其他的就不知道了)这样的话要获得TA某个private变量的地址只要跳过它前面的所有变量的偏移量即可。
    Integer(self)-> 入口地址 + TObject.InstanceSize-->跳过所有TObject的变量和VMT
    这时指针已经指向TA第一个private变量了。这里恰好正是我们关心的FNode
    接下来对这个指针所在的数据进行操作所修改的就是TA的Private变量值了。
      

  31.   

    参考资料:
    1 <天方夜谈VCL>
    2 <Delphi的原子世界>  TObject是所有对象的基本类,DELPHI中的任何对象都是一个指针,这个指针指明该对象
    在内存中所占据的一块空间!
        对象空间的头4个字节是指向该对象类的虚方法地址表(VMT-Vritual Method Table)。
    接下来的空间就是存储对象本身成员数据的空间,并按从该对象最原始祖先类的数据成员到
    该对象类的数据成员的总顺序,和每一级类中数据成员的定义顺序存储。
        类的虚方法地址表(VMT)保存从该类的原始祖先类派生到该类的所有类的虚方法的过程地址。
        即使,我们自己并未定义任何类的虚方法,但该类的对象仍然存在指向虚方法地址表的指针,
    只是地址项的长度为零。可是,在TObject中定义的那些虚方法,如Destroy、FreeInstance等等,
    又存储在什么地方呢?原来,他们的方法地址存储在相对VMT指针负方向偏移的空间中。
    其实,在VMT表的负方向偏移76个字节的数据空间是对象类的系统数据结构,这些数据结构是与
    编译器相关的,并且在将来的DELPHI版本中有可能被改变。
        VMT是一个从负偏移地址空间开始的数据结构,负偏移数据区是VMT的系统数据区,VMT的正偏移
    数据是用户数据区(自定义的虚方法地址表)。TObject中定义的有关类信息或对象运行时刻信息的
    函数和过程,一般都与VMT的系统数据有关,事实上,self之上就是RTTI信息。
        一个VMT数据就代表一个类,其实VMT就是类!在Object Pascal中我们用TObject、TComponent等等
    标识符表示类,它们在DELPHI的内部实现为各自的VMT数据。而用class of保留字定义的类的类型,
    实际就是指向相关VMT数据的指针。
        对我们的应用程序来说,VMT数据是静态的数据,当编译器编译完成我们的应用程序之后,这些数据
    信息已经确定并已初始化。我们编写的程序语句可访问VMT相关的信息,获得诸如对象的尺寸、类名或
    运行时刻的属性资料等等信息,或者调用虚方法或读取方法的名称与地址等等操作。 
    当一个对象产生时,系统会为该对象分配一块内存空间,并将该对象与相关的类联系起来,
    于是,在为对象分配的数据空间中的头4个字节,就成为指向类VMT数据的指针。//创建一个对象 obj := TObject.Create;
    1) 用 TObject 对应的 VMT 为依据,调用 TObject 的 Create 构造函数。
    2) 而在 Create 构造函数调用了系统的 _ClassCreate 过程,
    3) 系统的 ClassCreate 过程又通过类 VMT 调用 NewInstance 虚方法。
    4) 调用 NewInstance 方法的目的是要建立对象的实例空间,因为我们没有重载该方法,所以,
       它就是 TObject 类的 NewInstance。
    5) TObjec 类的 NewInstance 方法将根据编译器在VMT表中初始化的对象实例尺寸(InstanceSize),
       调用 GetMem 过程为该对象分配内存,
    6) 然后调用 InitInstance 方法将分配的空间初始化。
    7) InitInstance方法首先将对象空间的头4个字节初始化为指向对象类对应VMT的指针,然后将其余的空间清零。
    8) 建立对象实例之后,还调用了一个虚方法AfterConstruction。
    9) 最后,将对象实例数据的地址指针保存到AnObject变量中,这样,obj 对象就诞生了。//消灭一个对象  Obj.Destroy;
        TObject的析构函数Destroy被声明为虚方法,它也是系统固有的虚方法之一。
    1) Destory方法首先调用了 BeforeDestruction 虚方法,
    2) 然后调用系统的 _ClassDestroy过程。
    3) _ClassDestory 过程又通过类VMT调用 FreeInstance 虚方法,
    4) 由FreeInstance方法调用FreeMem过程释放对象的内存空间。就这样,一个对象就在系统中消失。在对象的构造和析构过程中,调用了NewInstance和FreeInstance两个虚函数,来创建和释放对象实例
    的内存空间。之所以将这两个函数声明为虚函数,是为了能让用户在编写需要用户自己管理内存的特殊
    对象类时(如在一些特殊的工业控制程序中),有扩展的空间。而将AfterConstruction和BeforeDestruction声明为虚函数,也是为了将来派生的类在产生对象之后,
    有机会让新诞生的对象呼吸第一口新鲜空气,而在对象消亡之前可以允许对象完成善后事宜,
    这都是合情合理的事。其实,TForm对象和TDataModule对象的OnCreate事件和OnDestroy事件,
    就是在TForm和TDataModule重载的这两个虚函数过程分别触发的。TObject的构造函数Create和析构函数Destory竟然没有写任何代码,其实,在调试状态下,
    通过Debug的CPU窗口,可清楚地反映出Create和Destory的汇编代码。因为,缔造DELPHI的大师门
    (Hejlsberg...)不想将过多复杂的东西提供给用户,他们希望用户在简单的概念上编写应用程序,
    将复杂的工作隐藏在系统的内部由他们承担。所以,在发布System.pas单元时特别将这两个函数的代码去掉,
    让用户认为TObject是万物之源,用户派生的类完全从虚无中开始,这本身并没有错。    虽然,阅读DELPHI的这些最本质的代码需要少量的汇编语言知识,但阅读这样的代码,可以让我们
    更深刻认识DELPHI世界的起源和发展的基本规律。即使看不太懂,能起码了解一些基本东西,对我
    们编写DELPHI程序也是大有帮助。  那是虚拟方法表在内存中的情况,可以清楚的看到 self 指针就指向了
    虚拟方法表的入口,而 self 指针则位于虚拟方法表的入口地址-76的位置。
    当然这不具有通用性,因为在将来的delphi版本这个位置可能会变.
      self之上就是RTTI信息。所以delphi实现RTTI是与C++不同的,C++靠宏。
    Delphi则依靠编译器,是与delphi当前版本的编译器紧密相关的。
    不过反正做Pascal编译器的就Borland一家.....虚拟方法表:$ system.pas{ Virtual method table entries }  vmtSelfPtr           = -76;
      vmtIntfTable         = -72;
      vmtAutoTable         = -68;
      vmtInitTable         = -64;
      vmtTypeInfo          = -60;
      vmtFieldTable        = -56;
      vmtMethodTable       = -52;
      vmtDynamicTable      = -48;
      vmtClassName         = -44;
      vmtInstanceSize      = -40;
      vmtParent        = -36;
      vmtSafeCallException = -32;
      vmtAfterConstruction = -28;
      vmtBeforeDestruction = -24;
      vmtDispatch          = -20;
      vmtDefaultHandler    = -16;
      vmtNewInstance       = -12;
      vmtFreeInstance      = -8;
      vmtDestroy           = -4;  vmtQueryInterface    = 0;
      vmtAddRef            = 4;
      vmtRelease           = 8;
      vmtCreateObject      = 12;
      

  32.   

    太精彩了,无论楼主还是xzgyb(老达摩)等等等等,都是太棒了向你们学习,向楼主学习,这是最好的一个楼主,很钦佩,向您学习的确是精华贴