用Visual Basic6类模块打造控件

领测软件测试网 　　VB6因为简单易用，受到很多朋友的喜欢。可是也有人说它功能简单，没有给开发者提供足够的发挥余地。比如不能方便地继承现有控件而派生出自己的控件。（什么？写ActiveX控件？太麻烦了吧。要花大量时间在接口的设计和实现上，而且你不想让你的软件发布时带一堆OCX控件吧？）其实还是有办法的，我们可以利用VB6里的类模块实现对控件的特殊控制和事件响应。本文介绍使用类模块把普通的Label控件变成窗体动态分割条。

图1 带分隔条的窗体

　　初识类模块

　　类模块其实是一个对象的定义，封装了一些属性和方法，使用前需要生成一个实例：

’生成类模块clsTest的一个实例test Dim test as new clsTest

　　然后可以使用类模块的方法：

test.DoSomthing() ’调用test的方法DoSomthing()

　　一个简单的例子

　　做一个鼠标移上去后自动获得焦点并将内容选中的“聪明”编辑框。

　　1、新建一工程，在[工程]菜单中，选择[添加类模块]，添加一个类模块，更改其名称为clsTest。

　　2、进入类模块编辑界面（如图2）。

图2 编辑类模块

　　在左边的下拉框中选择“通用”，键入以下代码：

’定义一个带事件的文本框变量 Dim WithEvents MyText As TextBox ’保存文本框是否获得焦点的布尔变量 Dim bSetted As Boolean ’自己定义的类模块的方法，传入参数是文本框。 Public Sub BindText(t As TextBox) 　’将文本框变量设置为传入的文本框，即是对传入文本框的引用 　Set MyText = t End Sub

　　3、在左边的下拉框中选择“Class”，在右边下拉框中选择Initialize,这是类模块的初始化事件，可以在这里写自己的初始化代码。VB会自动为我们添加一个事件子程序。我们要做的就是在其中添上自己的代码。其实这一步略过也没什么影响，不过对变量进行初始化是一个好习惯。

Private Sub Class_Initialize() 　’将文本框变量初始化Nothing 　Set MyText = Nothing 　bSetted = False End Sub

　　4、在左边的下拉框中选择“MyText”，注意到了吗，它就是我们在第2步定义的带事件的文本框变量。VB把它加进来了，再到右边下拉框中点击下拉按钮，呵呵，看到什么了？原来是我们熟悉的TextBox的所有事件！只不过这里的MyText文本框并不实际存在，只是一个代
号，等着你给它指定一个实际的文本框呢。

　　添加事件响应代码，这就不用我说了吧。　

Private Sub MyText_GotFocus() 　bSetted = True End Sub Private Sub MyText_LostFocus() 　bSetted = False End Sub ’鼠标在控件上移动时，如果还没设置焦点，将它设为焦点， ’并将内容选中 Private Sub MyText_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 　If (Not bSetted) Then 　　MyText.SetFocus 　　MyText.SelStart = 0 　　MyText.SelLength = 9999 　End If End Sub

　　到此，类模块宣告完毕,保存它（.cls文件）。

　　5、下面就是类模块的使用，非常简单。现在一个窗体上放3 个TextBox控件，名称分别为Text1、Text2、Text3。

图3 测试类模块

　　在通用部分键入以下代码：

’定义类模块的实例，因为有3个TextBox所以定义3个实例 Dim t1 As New clsTest Dim t2 As New clsTest Dim t3 As New clsTest

　　在窗体的Load事件中键入以下代码：

Private Sub Form_Load() 　’调用类模块的方法BindText 参数是窗体上的TextBox们 　t1.BindText Text1 　t2.BindText Text2 　t3.BindText Text3 End Sub

　　6、 运行程序，鼠标在不同的文本框上移动时，可以看到相应的文本框自动获得焦点，并将内容选中。

　　7、在其他程序里怎么用？也很简单，在其它工程中，到[工程]菜单，选择[添加文件]，选择你以前保存的.cls文件（建议先将此文件拷到工程目录下，以便于管理）说到这里您一定对类模块有了一个大概的了解，发挥自己的想象力，可以作出更好的东西！一个复杂点的例子
——窗体动态分割条
　总体思路

　　可以用现成的控件来做分割条，如Label。一个分割条分割窗体实际上是把窗体上的控件根据分割条的位置来重新安排。要实现这个功能，首先鼠标要能移动分割条，其次分割条要知道它两侧分别有哪些控件，可以随时根据它自身的位置来计算两侧控件的新位置。

　　详细思路

　　分割条分为水平和垂直，水平分割条是水平移动，它自己是垂直的，控件在它的左右。垂直分割条则相反。

　　因此要有一个变量保存分割条的类型。

　　1、 鼠标移动分割条

　　当鼠标在Label控件上按下时，表明移动开始，当鼠标移动时，用API函数得到鼠标在屏幕上的位置，转换为窗体上的坐标，水平分割条则设置Label控件的水平位置为鼠标水平位置，垂直位置不变，垂直分割条则设置Label控件的垂直位置为鼠标垂直位置，水平位置不变，
执行步骤3，鼠标键松开，表明移动结束。

　　2、 让分割条知道它两侧有哪些控件

　　每个分割条都有一个数组，该数组保存了对分割条两侧控件的引用，同时还有该控件相对分割条的位置（左、右、上、下），水平分割条只有左右，垂直分割条只有上下。

　　3、 控件位置的计算

　　（1）水平分割条：

　　控件在左侧：

　　控件宽度 = 分割条左侧位置-控件左侧位置-控件与分割条间隔控件在右侧：

　　控件左侧位置 = 分割条左侧位置+分割条宽度+控件与分割条间隔

　　控件宽度 = 窗体宽度-分割条左侧位置-分割条

　　宽度-控件与分割条间隔

　　另外：如果控件是位于窗体最下方的控件，应将控件填满窗体下方，

　　控件高度 = 分割条顶部位置 + 分割条高度 - 控件顶部位置

　　（2）垂直分割条控件位置：

　　控件在上方：

　　控件高度 = 分割条顶部位置-控件顶部位置-控件与分割条间隔

　　控件在下方：

　　控件顶部位置 = 分割条顶部位置+分割条高度+控件与分割条间隔

　　控件高度 = 窗体高度-分割条顶部位置-分割条

　　高度-控件与分割条间隔

　　另外：如果控件是位于窗体最右方的控件，应将控件填满窗体右方：

　　控件宽度 = 分割条左侧位置 + 分割条宽度 - 控件左侧位置

　　编码

　　1、通用部分

Option Explicit ’强制变量声明 ’API与数据类型定义： ’点数据类型POINTAPI的定义 Private Type POINTAPI X As Long Y As Long End Type ’将屏幕坐标转化为窗体坐标 Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long ’将窗体坐标转化为屏幕坐标 Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long ’设置鼠标捕捉 Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long ’释放鼠标捕捉 Private Declare Function ReleaseCapture Lib "user32" () As Long ’获得鼠标在屏幕上的位置 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long ’设置鼠标在屏幕上的位置 Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

　　2、自定义数据类型

’分割条类型： 0 水平，1垂直 Dim HorV As Integer ’窗体变量 引用当前的窗体 Dim mForm As Form ’控件数组类型 Private Type BindControl 　binControl As Control ’控件 　’ 控件位置： 0左侧，1右侧，2上方，3下方 　pos As Integer End Type ’控件数组 定义了10个控件的容量 可以根据实际需要增减 Dim myBindControls(10) As BindControl ’控件数组中已有元素的数量 Dim numControls As Integer ’鼠标位置点 Dim pot As POINTAPI ’鼠标是否在移动分割条 Dim Resizing As Boolean ’分割条的最小位置和最大位置 Dim iMin As Integer Dim iMax As Integer ’带事件的控件定义 这里我们选用Label Dim WithEvents SplitBar As Label

　3、类模块方法

’给分割条控件指定所在的窗体、Label控件、分割条类型等 Public Sub Attach(f As Form, sp As Label, hv As Integer，min As Long, max As Long) 　Set mForm = f ’设置窗体变量 　’设置分割条控件变量为传入的Label控件 　Set SplitBar = sp 　’给分割条做个标记，表明这个Label是分割条 　SplitBar.Tag = "SPLIT" 　If hv = 0 Then ’如果是水平分割条 　　HorV = 0 ’设置分割条类型 　　’ 设置Label控件的鼠标光标为左右箭头 　　SplitBar.MousePointer = 9 　　’最小位置与最大位置设置 　If max < min + SplitBar.Width Then 　　iMin = 100 　　iMax = mForm.ScaleWidth - SplitBar.Width - 100 　Else 　　iMin = min 　　iMax = max 　End If Else 　HorV = 1 ’如果是水平分割条 　’设置Label控件的鼠标光标为上下箭头 　SplitBar.MousePointer = 7 　If max < min + SplitBar.Height Then 　　iMin = 100 　　iMax = mForm.ScaleWidth - SplitBar.Height - 100 　Else 　　iMin = min 　　iMax = max 　End If End If End Sub ’添加分割条左侧的控件 如果不是水平分割条则退出 Public Sub SetLeftBind(c As Control) 　If HorV = 1 Then Exit Sub 　AddBindControl c, 1 End Sub ’添加分割条上方的控件 如果不是垂直分割条则退出 Public Sub SetUpBind(c As Control) 　If HorV = 0 Then Exit Sub 　AddBindControl c, 2 End Sub ’添加分割条下方的控件 如果不是垂直分割条则退出 Public Sub SetDownBind(c As Control) 　If HorV = 0 Then Exit Sub 　AddBindControl c, 3 End Sub ’帮助函数 私有 往控件数组里加入一个控件 Private Sub AddBindControl(c As Control, ipos As Integer) 　If numControls < 10 Then ’确保控件数组不溢出 　　numControls = numControls + 1 　　Set myBindControls(numControls - 1).binControl = c 　　myBindControls(numControls - 1).pos = ipos 　End If End Sub ’计算控件位置 Public Sub ArrangePosition() 　On Error GoTo err 　Dim i As Integer 　If HorV = 0 Then 　　’水平分割条 设置高度为窗体的高度 　　SplitBar.Height = mForm.ScaleHeight - _ 　　　　SplitBar.Top - 10 　Else 　’垂直分割条 设置宽度为窗体的宽度 如果要将垂直分割条嵌入水平分割条中 则将此分支去掉（见本文例图） 　’SplitBar.Width = mForm.ScaleWidth - SplitBar. 　Left - 10 End If Dim i1 As Integer Dim i2 As Integer Dim lf1 As Integer ’控件右侧或底部的边界 Dim lf2 As Integer ’控件右侧或底部的边界 ’垂直分割 找到最右端的控件 上方为i1，下方为i2 If HorV = 1 Then 　For i = 0 To numControls - 1 　　With myBindControls(i) 　　　If .pos = 2 Then 　　　　If .binControl.Left + .binControl.Width > lf1 Then 　　　　　lf1 = .binControl.Left + .binControl.Width 　　　　　i1 = i 　　　　End If 　　　ElseIf .pos = 3 Then 　　　　If .binControl.Left + .binControl.Width > lf2 Then 　　　　　lf2 = .binControl.Left + .binControl.Width 　　　　　i2 = i 　　　　End If 　　　End If 　　End With 　Next i Else ’水平分割 找到最底部的控件 左边为i1，右边为i2 　For i = 0 To numControls - 1 　　With myBindControls(i) 　　　If .pos = 0 Then 　　　　If .binControl.Top + .binControl.Height > lf1 Then 　　　　　lf1 = .binControl.Top + .binControl.Height 　　　　　i1 = i 　　　　End If 　　　ElseIf .pos = 1 Then 　　　　If .binControl.Top + .binControl.Height > lf2 Then 　　　　　lf2 = .binControl.Top + .binControl.Height 　　　　　i2 = i 　　　　End If 　　　End If 　　End With 　Next i End If ’遍历控件数组进行位置计算 For i = 0 To numControls - 1 　With myBindControls(i) .binControl 　　Select Case myBindControls(i).pos 　　　Case 0 ’左侧控件 　　　　.Width = SplitBar.Left - .Left - 10 　　　　If i = i1 Then ’如果是最底部的控件 　　　　　.Height = SplitBar.Top + SplitBar.Height - .Top 　　　　End If 　　　Case 1 ’右侧控件 　　　　.Left = SplitBar.Left + SplitBar.Width + 10 　　　　.Width = mForm.ScaleWidth - SplitBar.Left - SplitBar.Width - 10 　　　　If i = i2 Then ’如果是最底部的控件 　　　　　.Height = SplitBar.Top + SplitBar.Height - .Top 　　　　End If 　　　Case 2 ’上方控件 　　　　.Height = SplitBar.Top - .Top - 10 　　　　If i = i1 Then ’如果是最右侧的控件 　　　　　.Width = SplitBar.Left + SplitBar.Width - .Left 　　　　End If 　　　Case 3 ’下方控件 　　　　.Top = SplitBar.Top + SplitBar.Height + 10 　　　　.Height = mForm.ScaleHeight - SplitBar.Top- SplitBar.Height - 10 　　　　If i = i2 Then ’如果是最右侧的控件 　　　　　.Width = SplitBar.Left + SplitBar.Width - .Left 　　　　End If 　　　End Select 　　End With 　Next i err: End Sub

　4、类模块及控件事件

’类模块初始化 Private Sub Class_Initialize() 　numControls = 0 ’控件数设为0 　Resizing = False ’鼠标调整设为假 End Sub ’鼠标在Label控件上按下左键,开始调整 Private Sub SplitBar_MouseDown(Button As Integer, Shift 　As Integer, X As Single, Y As Single) 　If Button = vbLeftButton Then Resizing = True End Sub ’鼠标在Label控件上抬起左键，结束调整 Private Sub SplitBar_MouseUp(Button As Integer, Shift As 　Integer, X As Single, Y As Single) 　If Button = vbLeftButton Then Resizing = False End Sub ’鼠标移动事件 Private Sub SplitBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 　’得到鼠标位置 　 　GetCursorPos pot 　’屏幕坐标转为窗体坐标 　ScreenToClient mForm.hwnd, pot 　’如果鼠标不在调整则退出 　If Not Resizing Then Exit Sub 　If HorV = 0 Then ’如果是水平分割条 　’如果鼠标在窗体上的水平位置超过最小值 　If pot.X * Screen.TwipsPerPixelX < iMin Then 　’设置鼠标位置为窗体上水平位置最小值 退出 　pot.X = iMin / Screen.TwipsPerPixelX 　ClientToScreen mForm.hwnd, pot 　SetCursorPos pot.X, pot.Y Exit Sub 　’如果鼠标在窗体上的水平位置超过最大值 　ElseIf pot.X * Screen.TwipsPerPixelX > iMax Then 　’设置鼠标位置为窗体上水平位置最大值 退出 　pot.X = iMax / Screen.TwipsPerPixelX 　ClientToScreen mForm.hwnd, pot 　SetCursorPos pot.X, pot.Y Exit Sub Else 　’设置分割条的左侧位置为鼠标水平位置减去 　’分割条宽度的二分之一 　SplitBar.Left = pot.X * Screen.TwipsPerPixelXSplitBar.Width / 2 End If Else ’如果是垂直分割条 ’如果鼠标在窗体上的水平位置超过最小值 If pot.Y * Screen.TwipsPerPixelY < iMin Then 　’设置鼠标位置为窗体上水平位置最小值 退出 　pot.Y = iMin / Screen.TwipsPerPixelY 　ClientToScreen mForm.hwnd, pot 　SetCursorPos pot.X, pot.Y 　Exit Sub 　’如果鼠标在窗体上的水平位置超过最大值 ElseIf pot.Y * Screen.TwipsPerPixelY > iMax Then 　’设置鼠标位置为窗体上水平位置最大值 退出 　pot.Y = iMax / Screen.TwipsPerPixelY 　ClientToScreen mForm.hwnd, pot 　SetCursorPos pot.X, pot.Y 　Exit Sub Else 　’设置分割条的顶部位置为鼠标垂直位置 　’减去分割条高度的二分之一 　SplitBar.Top = pot.Y * Screen.TwipsPerPixelY - SplitBar.Height / 2 　End If End If ’调用子程序计算控件位置 ArrangePosition End Sub

　　至此分割条类模块编写完毕，下面就是实际使用测试。

　　分割条的使用

　　新建一窗体，在上面放两个文本框Text1、Text2，一个标签Label1，如图4：

图4 测试分隔条

　　定义一个分割条实例：

Dim sp As New clsSplitBar

　　1、窗体Load事件

Private Sub Form_Load() sp.Attach Me, Label1, 0, 1000, 5000 sp.SetLeftBind Text1 sp.SetRightBind Text2 End Sub

　　2、窗体Resize事件

Private Sub Form_Resize() sp.ArrangePosition End Sub

　　使用类模块的优点

　　相比ActiveX控件，类模块不需要编译控件，不需要控件注册。它是将类模块直接编译到应用程序中的，所以不会被别人非法使用。提高了代码重用性。而且由于是源码级的重用，可以方便的进行修改，从而更加灵活，可以适用不同的要求。笔者还用类模块写了一个语法着色控件，使用普通的RichTextBox控件，可以定义多种文字样式（每条样式包括字体、颜色、大小、下划线、粗体、斜体），最多可定义10组样式。每组样式都可以规定采用该样式的文字组。相信大家会做出更好的控件！

　　在VB.net中，要创建带分割条的窗体非常简单。VB.net提供了一个分割条控件：Splitter。假设要创建一个可以左右调整大小的窗格，先在窗体上放一个面板Panel控件，设置其Dock 属性为Left，再从工具箱中拖动一个Splitter控件到窗体上，它会自动依靠在Panel控件的边缘，然后，再从工具箱中拖入第2 个Panel，这回，设置它的Dock属性为Fill。好了，运行看看，是不是就可以调整左右窗格的大小了？

延伸阅读

文章来源于领测软件测试网 https://www.ltesting.net/