在使用VB6编写类或控件时,有一个不如意的地方,那就是无法在属性或函数中返回结构体。一般情况下,我们可以使用一个新的类来模拟结构体,比如有一个表格类,类名为clsGrid,它包含一个行属性Rows,而Rows又包含Height等成员属性,此时,我们需要定义一个类clsRows,代码大致如下:
类clsGrid:
Dim m_objRows As clsRows
Private Sub Class_Initialize()
Set m_objRows = New clsRows
End Sub
Private Sub Class_Terminate()
Set m_objRows = Nothing
End Sub
Public Property Get Rows(Optional ByVal Index as Long) As clsRows
Set Rows = m_objRows
End Property
类clsRows:
Dim m_lngHeight As Long
Public Property Get Height() As Long
Height = m_lngHeight
End Property
Public Property Let Height(ByVal New_Value As Long)
m_lngHeight = New_Value
End Property
OK,一切看上去很不错,但问题来了,当类clsRow的成员属性Height改变时,需要通知类clsGrid,以便类clsGrid在Class_Paint事件中按新的Height属性绘制,怎么办?
相信大家已经想到了答案,那就是让clsRows抛出事件,或者定义一个全局变量,让clsGrid和clsRows都可以读写。
如果只是一个clsRows实例,抛出事件也是一个不错的选择,然而,这是一个表格类,行对象(即clsRows可能会超过10万个),很明显,抛出事件是一种低效的选择,而且更重要的是,由于事件无法使用Friend而进行内部封装,会对应用程序员编写应用代码时造成不必要的误解。
那么,就用全局变量吧。
我们先增加一个标准模块,然后定义一个全局变量。
标准模块modDeclare:
Global g_lngHeight() As Long
类clsGrid:
Private Sub Class_Initialize()
Set m_objRows = New clsRows
Redim g_lngHeight(1000)
End Sub
Private Sub Class_Terminate()
Set m_objRows = Nothing
End Sub
Public Property Get Rows(Optional ByVal Index as Long) As clsRows
m_objRows.RowIndex = Index
Set Rows = m_objRows
End Property
Public Sub Class_Paint()
Dim i as Long
For i=0 To UBound(g_lngHeight)
'绘图代码略
Next
End Sub
类clsRows:
Public RowIndex As Long
Public Property Get Height() As Long
Height = g_lngHeight(RowIndex)
End Property
Public Property Let Height(ByVal New_Value As Long)
g_lngHeight(RowIndex) = New_Value
End Property
到这里,代码基本实现了设计任务,看来可以编译打包后交差了,打包工程暂命名为MYGrid。
接下来,我们将使用MYGrid.Grid编写一个应用,先建一个测试工程,工程里只包含一个标准模块,测试代码如下:
Sub Main()
Dim o As MYGrid.Grid
Set o = New MYGrid.Grid
o.Rows(1).Height = 100
Debug.Print o.Rows(1).Height
Set o = Nothing
End Sub
运行后,立即窗口如愿输出了100,结果正确。
我们再将代码修改一下:
Sub Main()
Dim o1 As MYGrid.Grid
Dim o2 As MYGrid.Grid
Set o1 = New MYGrid.Grid
Set o2 = New MYGrid.Grid
o1.Rows(1).Height = 100
o2.Rows(1).Height = 200
Debug.Print o1.Rows(1).Height,o2.Rows(1).Height
Set o1 = Nothing
Set o2 = Nothing
End Sub
立即窗口输出200,200,这个结果明显是错的,为什么会这样呢?
原来问题出在全局变量里,在ActiveX DLL工程里,不管应用程序创建了多个接口实例,而工程实例只有一个,也就是说,全局变量g_lngRows将被实例o1和o2共同使用,这样一来,o1和o2的属性值就成了一个了。
如何解决这个问题呢?
答案当然是避免在ActiveX DLL 工程中使用全局变量,而是在类clsGrid中声明数组lngHeight(),然而这样一来,类clsRows却无法访问lngHeight()了,怎么办?
我们也许会想到在clsGrid中传递一个引用给clsRows,比如:
类clsGrid:
Dim m_lngHeight() As Long
Private Sub Class_Initialize()
Set m_objrows = New clsRows
ReDim m_lngHeight(1000)
m_objrows.BindArray m_lngHeight
End Sub
Private Sub Class_Terminate()
Set m_objrows = Nothing
End Sub
Public Property Get Rows(Optional ByVal Index As Long) As clsRows
m_objrows.RowIndex = Index
Set Rows = m_objrows
End Property
Public Sub Class_Paint()
Dim i As Long
For i = 0 To UBound(m_lngHeight)
'绘图代码略
Next
End Sub
类clsRows:
Public RowIndex As Long
Dim m_lngHeight() As Long
Public Property Get Height() As Long
Height = m_lngHeight(RowIndex)
End Property
Public Property Let Height(ByVal New_Value As Long)
m_lngHeight(RowIndex) = New_Value
End Property
Friend Sub BindArray(ByRef v() As Long)
m_lngHeight = v
End Sub
按我们的思路,当修改clsRows中的m_lngHeight()时,clsGrid中的m_lngHeight()应该一起改变,因为clsRows中的m_lngHeight()是clsGrid中的m_lngHeight()一个引用。
其实不然,在BindArray(ByRef v() As Long)中,只有v()是正确的引用,当使用m_lngHeight = v语句时,结果是m_lngHeight按照v构建了一个新的数组。
那么,怎么实现clsRows中的m_lngHeight()是clsGrid中的引用呢?
正确的办法是将clsRows中的m_lngHeight这个安全数组的pvData成员指针指向clsGrid中的m_lngHeight中的pvData成员(具体可参才SAFEARRAY结构),为此,我们可以使用CopyMemory进行构造,然而,由于SAFEARRAY结构体是变长的,其长度随维数而变化,从而导致CopyMemory不知源数据的长度。其实,我们可以巧用VARIANT,因为VARIANT结构体是定长的,这样就可以实现通用的引用来代替全局变量,需要注意的是,不要忘了在类销毁前还原VARIANT,修正后的clsRows代码如下:
类clsRows:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public RowIndex As Long
Dim m_lngHeight As Variant
Public Property Get Height() As Long
Height = m_lngHeight(RowIndex)
End Property
Public Property Let Height(ByVal New_Value As Long)
m_lngHeight(RowIndex) = New_Value
End Property
Friend Sub BindArray(ByRef v As Variant)
CopyMemory m_lngHeight, v, 16 'VARIANT结构体长度为16
End Sub
Private Sub Class_Terminate()
Dim v As Variant
CopyMemory m_lngHeight, v, 16 '还原m_lngHeight
End Sub