用Visual Basic6類模塊打造控件

領測軟件測試網 　　VB6因為簡單易用，受到很多朋友的喜歡�？墒且灿腥苏f它功能簡單，沒有給開發者提供足夠的發揮余地。比如不能方便地繼承現有控件而派生出自己的控件。（什么？寫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、下面就是類模塊的使用，非常簡單�，F在一個窗體上放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。好了，運行看看，是不是就可以調整左右窗格的大小了？

延伸閱讀

文章來源于領測軟件測試網 http://www.kjueaiud.com/