在内部CTL方式下引用VB6 UserControl对象

本文来自 这个帖子和 这个帖子与 赵老虎等同学的讨论，感谢 赵老虎耐心指点。

1、问题的提出

有一个activex控件，原来是单独做的一个ocx，现在我把它拿到工程内部。之后我在form中用form.controls.add()添加这个对象，结果发现控件的left,top,width,height,tabindex等属性通通不能用了。

比如像上面这样做工程，那就不会有left,tabindex等属性，很有点奇怪。这时候只有把要添加的对象声明为control，才可以用上述属性，但是同时usercontrol特有的属性却丢失了，看下面的代码： Private Sub Form_Load()
'声明为UserControl类型，编译通不过
Dim myCtl As ShapeLabel

’ Set myCtl = Me.Controls.Add(" ControlDemo.ShapeLabel"," sl3") ‘编译通不过 '例0
Set myCtl = Me.Controls.Add(" Project1.ShapeLabel"," sl3") ‘例1
myCtl.Caption = " asdfad" ‘例2
myCtl.Visible = True '以下各句都报编译错：没相应属性 ‘例3
Debug.Print myCtl.Name,myCtl.Left

''声明为Control，有extender的各种属性，但是没办法得到用户控件特有的属性
Dim ctl As Control
Set ctl = Me.Controls.Add(" Project1.ShapeLabel"," sl5") ‘例4
ctl.Caption = " asdfad" '运行时错误，说没这个属性。 ‘例5
ctl.Visible = True ‘例6
Debug.Print ctl.Left,ctl.TabIndex,ctl.Width '这句可以正常运行
End

2、理解Extender对象

要理解上面这个问题，先看下面这个图：

这里给我们带来麻烦的Name,Top,and Left等属性其实来自Extender对象。To the user of a control,extender properties — such as Name,and Left — appear to be part of your control. However,extender properties are really provided by the container your control is placed on. The Extender object of the UserControl gives you,the control designer,access to these properties from within your control. （The read-only Name property of the Extender object returns the name the container (or the user) gives to a specific instance of your control.）

也就是说，我们通常得到的UserControl对象其实包含两套接口，一套是Extender的接口，一套是UserControl特有的接口，不妨 称这时这个对象双毒俱全。很显然，我们在第一节的例子中，没取到Extender接口。

3、为何取不到Extender接口？（例7-例8）

先重复一下我们的问题。在VB6里建个Standard Exe工程，以两种不同方式测试如下这段代码：

Private Sub Form_Load()
Dim aa As ShapeLabel
Set aa = Me.ShapeLabel1 ‘例7
Debug.Print aa.Left ‘例8
Set aa = Nothing
End Sub

（1）第一种方式，直接在你的部件对话框里直接引用ShapeLabel对应的OCX；第二种方式，把部件里ShapeLabel对应的OCX取消掉，而直接如第一节中的图里那样把ShapeLabel对应的CTL文件加入你的工程。不妨称第一种方式为外部OCX方式；称第二种方式为内部CTL方式。

（2）之后，你的部件工具箱里会出现ShapeLabel的图标，在你的Form1上加入一个ShapeLabel控件，命名为ShapeLabel１。

（3）在Form1的模块里添加以上代码，然后运行你的程序。

你会发现直接引用OCX的话，那么整个过程没有任何问题；而把CTL文件加入工程的话，那么aa.Left这一句通不过编译，报没有这样的属性或方法，显然这时我们没得到UserControl的Extender接口。这是为什么呢？

我觉得可以这样理解：CTL是个类文件，当我们以Add类文件的方式把ShapeLabel对象引入工程，我们得到的是一个纯ShapeLabel类的对象，它只有ShapeLabel类的独特接口，而不具有上面说的Extender接口。 不妨称这种对象为纯类对象，它所具有的接口为纯类接口。

4、通过Controls.Add得到的对象，在内部CTL方式下如何得到其Extender接口（例9-例11、例0）

首先，我们要明白一点，即使是在内部CTL方式下，我们从工具箱里添加的用户控件也仍然是如假包换的用户控件的，它的两套接口是俱全滴。

Private Sub Form_Load()
Dim aa As ShapeLabel
Set aa = Me.ShapeLabel1
Debug.Print Me.ShapeLabel1.Left ‘内部CTL方式下，这一句仍然有效 ‘ 例9
Set aa = Nothing
End Sub

这其实是我们很熟悉的常识。以前我们用ActiveX控件的时候，从来也没遇到过Left啥的不能用的问题嘛。那么何来“在内部CTL方式下如何得到Extender接口”这么一问呢？其实还是第1节我们提到的问题，当我们用Controls.Add的时候，麻烦就出现了。Controls.Add添加的控件虽然是如假包换的用户控件，可是我们却没办法在内部CTL方式下双毒俱全地引用它。你可能会说，那怎么可能呢？表着急，看下面的代码：

Option Explicit

Private Sub Form_Load()
Dim myCtl As MyControl

Set myCtl = Me.Controls.Add(" Project1.MyControl"," ct2") ‘例10
Debug.Print myCtl.Left ‘编译通不过 ‘例11
End Sub

看出来了么，在内部CTL方式下，Controls.Add得到的控件和你直接在设计视图上添加的用户控件的区别在于，前者你没办法以双毒俱全的方式引用它，你一引用Controls.Add返回的对象，得到的就是纯纯的用户控件类实例，不带Extender接口滴。我们不妨 称Controls.Add得到的用户控件为隐双毒控件 。那么，请问在内部CTL方式下，如何得到隐双毒控件的Extender接口呢？

方法一：用Control对象引用Controls.Add的返回对象

Option Explicit

Private Sub Form_Load()
Dim myCtl As MyControl
Dim ctl As Control

Set ctl = Me.Controls.Add(" Project1.MyControl"," ctl") ‘例12
ctl.Move 120,120 ‘例13
ctl.Visible = True

Set myCtl = ctl ‘例14
myCtl.Caption = " hello" ‘例15
End Sub

方法二：用VBControlExtender对象引用Controls.Add的返回对象

Private Sub Form_Load()
Dim myCtl As ShapeLabel
Dim ceCtl As VBControlExtender

Set ceCtl = Controls.Add(" Project1.ShapeLabel"," sss") ‘例16
ceCtl.Visible = True
Debug.Print ceCtl.Left ‘例17

Set myCtl = ceCtl. object ‘例18
Debug.Print myCtl.Caption ‘例19

Set myCtl = Nothing
Set ceCtl = Nothing
End Sub

值得注意的是，上述代码中Me.Controls.Add(" Project1.ShapeLabel","sl3")不能写作Me.Controls.Add("ControlDemo.ShapeLabel","sl3") 。前者是在创建Project1.ShapeLabel类型的控件，而后者是在创建ControlDemo.ShapeLabel类型的控件。如果用后者（像例0那样），由于阴影效果，内部声明的纯类对象是缺省为Project1.ShapeLabel类型的，这样之后的类型转换会导致Tyoe Mismatch：原来是创立的ControlDemo.ShapeLabel控件，要把它赋给Project1.ShapeLabel类型的变量，能不Tyoe Mismatch么？

5、在内部CTL方式下，如何双毒俱全地引用隐双毒控件？（例12-例19）

其实就像第4节那两个方法就可以了，其实这两种办法的关键点是一样的，就是“ 两套接口用两个变量”。方法一是用Control对象得到Extender接口，然后用纯类对象获得纯类接口；方法二是用VBControlExtender对象得到Extender接口，然后用纯类对象获得纯类接口。

我们先观察语法比较清晰的方法二。这里有两个关键的语句： Set ceCtl = Controls.Add(……)，这是用VBControlExtender变量引用隐双毒控件；然后 Set myCtl = ceCtl. object，这是用纯类对象引用VBControlExtender的成员变量Object。

再观察稍有点费解的方法一。也是有两个关键的语句： Set ctl = Me.Controls.Add(……)，这是用Control变量引用隐双毒控件；然后 Set myCtl = ctl，这里可以理解为用纯类对象引用ctl的缺省成员变量，该成员变量的类型是纯类。

6、用Set语句的时候发生了什么？（例20-例23、例1-例6）

看看第5节的分析，可以发现Set语句貌似很神奇，你可以把不同类型的对象变量互相Set，VB貌似在后台自动做转换。这时候你也许忍不住要试试这个Set能有多NB，尝试以下的代码：

Option Explicit

Private Sub Form_Load()
Dim myCtl As MyControl
Dim ctl As Control

'*****这个可以
Set ctl = Me.Controls.Add(" Project1.MyControl"," ctl") ‘例20
Set myCtl = ctl ‘例21

'*****这个不可以
Set myCtl = Me.Controls.Add(" Project1.MyControl"," ct2") ‘例22
Set ctl = myCtl '这一句运行时错误：Type mismatch ‘例23
End Sub

可以用UserControl类型的变量去引用control类型的变量，反之却不行。这不是很奇怪么？其实不奇怪，Set语句的实质是对被引用的对象计数加一， 只要是同一个对象（有“继承”关系的），通常可以在实现的接口之间自由转化；但是如果不是同一个对象，那就不能转化了。用这个理论来解释上面这段代码如下：

（1）例20：Control和隐双毒对象之间有某种继承关系，因此可通过Set语句自由转化、互相引用。

（2）例21：隐双毒对象有个成员变量具有MyControl纯类型，因此可以通过Set语句用纯类变量引用到这个特别的成员变量。

（3）例22：同上

（4）例23：纯类变量和隐双毒对象不是同一个对象，因而和Control对象不具有继承关系，因而无法实现相互转化。

现在我们可以试试来解释第一节里的语句了：

（1）例1：隐双毒对象有个成员变量具有ShapeLabel纯类型，因此可以通过Set语句用纯类变量引用到这个特别的成员变量。

（2）例2：纯类变量当然有纯类接口，可以访问纯类的属性。

（3）例3：纯类变量当然没有Extender接口，当然不可以访问Extender的属性。

（4）例4：Control和隐双毒对象之间有某种继承关系，因此可通过Set语句自由转化、互相引用。

（5）例5：Control对象没有纯类接口，当然不可以访问纯类的属性；

（6）例6：Control对象有Extender接口，当然可以访问Extender的属性。

7、当我们对不同类型的对象用Set语句进行互相引用时发生了什么？

如果细心些，你也许会觉得诧异，何以具有“继承”关系的对象之间（ 我们不妨称它们为同系不同类的对象）就可以互相Set，而不具有的就不能。这个Set是何其“智能”啊？当同系不同类的对象互相Set时，对象指针是如何变化的？当同系同类的对象互相Set时，对象指针又是如何变化的？为了弄明白这些疑问，我们不妨做以下实验，先说明如下：
（1）每一段VB Code表示位于一个工程里的代码。
（2）AbstractClasses、PolyOne、PolyTwo都是ActiveX Dll，分别编译链接为Dll；PolyClient是引用了这3个Dll的标准EXE。
（3）AbstractClasses以两个抽象类的方式定义了两个接口
（4）PolyOne引用了AbstractClasses.Dll，其类模块MyDll1实现了接口一 ITest1
（5）PolyTwo引用了AbstractClasses.Dll，其类模块MyDll2实现了接口一 ITest1 和接口二 ITest2
（6）在PolyClient中观察对象互相转换的效果，没通过的我都注释掉了，并加了注释说明。

VB code

'---------------------------------------------------------------------------------------
' Module : AbstractClasses.ITest1
'---------------------------------------------------------------------------------------
Option Explicit

Public Sub Method1()
End Sub

'---------------------------------------------------------------------------------------
' Module : AbstractClasses.ITest2
'---------------------------------------------------------------------------------------
Option Explicit

Public Sub Method2()
End Sub

VB code

'---------------------------------------------------------------------------------------
' Module : PolyOne.MyDll1
'---------------------------------------------------------------------------------------
Option Explicit

Implements ITest1

Private Sub ITest1_Method1()
MsgBox " ones' method1"
End Sub

'
' Public Sub M1()
' MsgBox " PolyOne's method"
' End Sub

VB code

'---------------------------------------------------------------------------------------
' Module : PolyTwo.MyDll2
'---------------------------------------------------------------------------------------
Option Explicit

Implements ITest1
Implements ITest2

Private Sub ITest1_Method1()
MsgBox " TWO implements i1"
End Sub

Private Sub ITest2_Method2()
MsgBox " TWO implements i2"
End Sub

' Public Sub M2()
' MsgBox " PolyTwo's method"
' End Sub

VB code

'---------------------------------------------------------------------------------------
' Module : PolyClient. Module1
'---------------------------------------------------------------------------------------
Option Explicit

Public Sub test()
Dim aa As PolyOne.MyDll1
Dim bb As PolyTwo.MyDll2
Dim bb2 As PolyTwo.MyDll2
Dim cc1 As AbstractClasses.ITest1
Dim cc2 As AbstractClasses.ITest2

Set aa = New PolyOne.MyDll1
Set cc1 = aa ‘例24
Call cc1.Method1
Set cc1 = Nothing
Set cc2 = aa 'Type Mismatch 因为MyDll1没有实现接口1 ‘例25
Call cc2.Method2
Set cc2 = Nothing
' Set bb = aa 'Type Mismatch
Set aa = Nothing

Set bb = New PolyTwo.MyDll2
Set cc1 = bb ‘例26
Debug.Print " After Set cc1 = bb,ObjPtr(bb)=",ObjPtr(bb)
Debug.Print " After Set cc1 = bb,ObjPtr(cc1)=",ObjPtr(cc1) ‘例27
Call cc1.Method1
Set cc2 = bb '这里可以通过，因为MyDll2实现了接口2 ‘例28

Debug.Print " After Set cc2 = bb,ObjPtr(bb)
Debug.Print " After Set cc2 = bb,ObjPtr(cc2)=",ObjPtr(cc2) ‘例29
Set bb = cc2 ‘例30
Debug.Print " After Set bb = cc2,ObjPtr(bb)
Debug.Print " After Set bb = cc2,ObjPtr(cc2) ‘例31
Call cc2.Method2

Set bb2 = bb
Debug.Print " After Set bb2 = bb,ObjPtr(bb)
Debug.Print " After Set bb2 = bb,ObjPtr(bb2)=",ObjPtr(bb2) ‘例32

Debug.Assert bb Is cc1 ‘例33
Debug.Assert cc1 Is cc2 ‘例34

Set cc1 = Nothing
Set cc2 = Nothing
' Set aa = bb 'Type Mismatch ’例35
Set bb2 = Nothing
Set bb = Nothing
End Sub

从上面的例子可以看出

（1）同系不同类的对象可以互相引用，比如；例24、例26、例28、例30；

（2）不同系的对象不能互相引用，比如：例25、例35；

（3）同系不同类的对象互相引用后，对象地址并不相同，比如：例27、例29、例31。
（4）同系同类的对象互相引用后，对象地址维持不变。比如：例32和例31中bb和bb2的地址互相相同，并在反复Set的过程中维持不变。

（5）同系不同类的对象互相引用后，用Is函数检查，表明它们指向同一对象。如例33、例34。

8、用VTable来理解同系不同类对象的互相引用

从第7节的例子可以看出，同系不同类的对象在Set互相引用后，对象地址并不相同，但是用Is函数去检查，却可以发现它们属于同一对象。这看起来有点费解。其实，如果大致知道多态对象（在VB里也就是继承了）在内存的存在形式，也就不会奇怪了。 这个网页里有些图可以帮助理解。

简单的说，如果类中有虚函数，那么它就会有一个虚函数表的指针__vfptr，在类对象最开始的内存数据中。之后是类中的成员变量的内存数据。对于子类，最开始的内存数据记录着父类对象的拷贝（包括父类虚函数表指针和成员变量），之后是子类自己的成员变量数据。对于子类的子类，也是同样的原理。

所以，对于一个子类对象而言，它在内存中相当于分段保存了多个对象，从它的各个父类、到它自己。当我们用它的父类对象变量来引用它的时候，我们得到的指针地址是它在内存中的父类对象的地址，当然和它自己的地址不同了。

9、小结：

（1）用户控件的接口实际上由用户控件类（包含用户控件特有的属性方法）和Extender对象两套接口构成。当以内部CTL方式引入用户控件类，并在代码里直接声明用户控件类对象的时候，我们得到的实际上只是用户控件类实例，该实例只具有用户控件类的接口，通过该实例无法直接访问到Extender对象接口的属性。具体看第2节的图和说明。

（2）在内部CTL方式下要想双毒俱全地引用Controls.Add的返回对象，就要“两套接口用两个变量”。见第4节的方法一和方法二。

（3）内部CTL方式下创建隐双毒对象，Class String要用Project1.限定，详见第4节最后。

（4）Set语句的实质是对被引用的对象计数加一，并传递对象地址。只要是同一个对象，通常可以在实现的接口之间自由转化；但是如果不是同一个对象，那就不能转化了。见第7节的例子。

（5）在同系列不同类的对象之间互相Set时，传递的是同一对象不同接口对应的不同对象的指针位置。因此，检查两个对象是否为同一对象，用Is，而不要用ObjPtr。同系同类的对象互相Set引用后，对象指针保持不变。见第7节和第8节。

（6）子类对象的内存里分段存储了它的各个父类和它自己的数据。见第8节。

（7）各代码段中需要理解的语句在随后的注释中都加了’ 例n的字样，如果从 例0到 例35的语句全部能理解为何没错或为何错误，则本文可以不细看了。

注意：本文的各种结论更多的是经过试验验证的推测，不保证完全正确，因为VB的内部实现资料是无从查阅的。把这些“推测”记下来是为了有助于写更加鲁棒的程序。