用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。好 了，運行看看，是不是就可以調整左右窗格的大小了？