扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
来源:开发高手 2007年10月14日
关键字:控件 类模块 Visual Basic
图1 带分隔条的窗体 |
’生成类模块clsTest的一个实例test Dim test as new clsTest |
test.DoSomthing() ’调用test的方法DoSomthing() |
图2 编辑类模块 |
’定义一个带事件的文本框变量 Dim WithEvents MyText As TextBox ’保存文本框是否获得焦点的布尔变量 Dim bSetted As Boolean ’自己定义的类模块的方法,传入参数是文本框。 Public Sub BindText(t As TextBox) ’将文本框变量设置为传入的文本框,即是对传入文本框的引用 Set MyText = t End Sub |
Private Sub Class_Initialize() ’将文本框变量初始化Nothing Set MyText = Nothing bSetted = False End Sub |
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 |
图3 测试类模块 |
’定义类模块的实例,因为有3个TextBox所以定义3个实例 Dim t1 As New clsTest Dim t2 As New clsTest Dim t3 As New clsTest |
Private Sub Form_Load() ’调用类模块的方法BindText 参数是窗体上的TextBox们 t1.BindText Text1 t2.BindText Text2 t3.BindText Text3 End Sub |
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 |
’分割条类型: 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 |
’给分割条控件指定所在的窗体、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 |
’类模块初始化 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 |
图4 测试分隔条 |
Dim sp As New clsSplitBar |
Private Sub Form_Load() sp.Attach Me, Label1, 0, 1000, 5000 sp.SetLeftBind Text1 sp.SetRightBind Text2 End Sub |
Private Sub Form_Resize() sp.ArrangePosition End Sub |
如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。