Option Explicit
Private myForm As Form '应用窗体
Private picP As Object '做为分隔条的控件
Private objBox1 As Object '分隔条左边控件
Private objBox2 As Object '分隔条右边控件
Private Sub Class_Terminate()
Set myForm = Nothing
Set picP = Nothing
Set objBox1 = Nothing
Set objBox2 = Nothing
End Sub
Public Sub myInit(inForm As Form, pic As Object, obj1 As Object, obj2 As Object)
On Error GoTo err1
'初始化各控件位置
Set myForm = inForm
Set picP = pic
Set objBox1 = obj1
Set objBox2 = obj2
picP.MousePointer = 9
picP.Appearance = 0
picP.BackColor = &H8000000F
picP.BorderStyle = 0
picP.Width = 50
objBox1.Top = 0
objBox1.Left = 0
objBox1.Width = 3000
objBox1.Height = myForm.Height
picP.Top = 0
picP.Left = objBox1.Width
picP.Height = myForm.Height: objBox2.Top = 0
objBox2.Left = objBox1.Width + picP.Width
objBox2.Height = myForm.Height
objBox2.Width = myForm.Width - objBox1.Width - picP.Width
picP.ZOrder (0)
Exit Sub
err1:
End Sub
Public Sub myMouseMove(MouseButton As Integer, X As Single)
On Error GoTo err1
'在picP控件的mouseMove事件中调用
If MouseButton = 1 Then
picP.Move picP.Left + X
objBox1.Width = picP.Left
objBox2.Left = picP.Left + 50
objBox2.Width = myForm.Width - picP.Left
picP.ZOrder (0)
End If
Exit Sub
err1:
End Sub
Public Sub myMouseUp(MouseButton As Integer)
On Error GoTo err1
'在picP控件的mouseUp事件中调用
If MouseButton = 1 Then
objBox1.Left = 0
If picP.Left < 1000 Then
objBox1.Width = 1000
picP.Left = 1000
Else
If picP.Left > myForm.Width Then
objBox1.Width = myForm.Width - 1000
picP.Left = objBox1.Width
Else
objBox1.Width = picP.Left
End If
End If
objBox2.Left = objBox1.Width + picP.Width
objBox2.Width = myForm.Width - objBox1.Width - picP.Width
End If
Exit Sub
err1:
End Sub
'以下是窗口代码,添加一个Picturebox控件和两个textbox控件.
Option Explicit
Dim a As Class1
Private Sub Form_Load()
Set a = New Class1
a.myInit Me, Picture1, Text1, Text2
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
a.myMouseMove Button, X
End Sub
