err1: End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo err1 If Button = 1 Then Picture1.Move Picture1.Left + X Picture1.ZOrder (0) End If Exit Sub
err1: End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo err1 If Button = 1 Then Text1.Left = 0 If Picture1.Left < 1000 Then Text1.Width = 1000 Picture1.Left = 1000 Else If Picture1.Left > form1.Width Then Text1.Width = form1.Width - 500 Picture1.Left = Text1.Width Else Text1.Width = Picture1.Left End If End If
Text2.Left = Text1.Width + Picture1.Width Text2.Width = form1.Width - Text1.Width - Picture1.Width End If Exit Sub
err1: End Sub'*************************************************** '建一个窗体 '加入两个文本框(text1,text2)和一个图片框(picture1) '*******************************************
Option ExplicitPrivate Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long'加三个PICTUREBOX控件,将其中一个作为分隔条,改名为:picSplit Private Sub Form_Load() Picture1.Left = 60 Picture1.Top = 60 Picture2.Top = 60 picSplit.Left = Picture1.Left + Picture1.Width + 30 picSplit.Width = 60 picSplit.BorderStyle = 0 Picture2.Left = picSplit.Left + picSplit.Width '+ 50 Picture1.Height = 5700 Picture2.Height = 5700 picSplit.Top = 60 picSplit.Height = 5700 picSplit.MousePointer = vbSizeWE End SubPrivate Sub picSplit_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next If Button = vbLeftButton Then SetCapture picSplit.hwnd picSplit.Tag = x picSplit.BackColor = &HFF8080 End If End SubPrivate Sub picSplit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next If Button = vbLeftButton Then If picSplit.Left >= (100 - x) And picSplit.Left <= (Me.ScaleWidth - 100 - x) Then picSplit.Left = picSplit.Left + x - CInt(picSplit.Tag) End If End SubPrivate Sub picSplit_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next If Button = vbLeftButton Then Picture1.Width = picSplit.Left - 80 Picture2.Left = picSplit.Left + 50 Picture2.Width = Width - Picture1.Width - 4
picSplit.BackColor = &H8000000F ReleaseCapture End If End Sub
窗体上画 ListView TreeView Image(imgSplitter) StatusBar 再将下面代码粘入即可Option ExplicitPrivate Sub Form_Load() With TreeView1 .Top = 15 .Left = 15 .Height = Me.Height - StatusBar1.Height - 400 .Width = Me.Width * 0.35 End With With imgSplitter .Top = 15 .Left = TreeView1.Left + TreeView1.Width .Height = TreeView1.Height .Width = 60 End With With ListView1 .Top = 15 .Left = TreeView1.Left + TreeView1.Width + imgSplitter.Width .Height = TreeView1.Height .Width = Me.Width * 0.65 - 200 End With End SubPrivate Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '开始移动 If Button = 1 Then If X < 0 Then '向左平移 If Abs(X) >= TreeView1.Width - 60 Then ListView1.Width = TreeView1.Width + imgSplitter.Width + ListView1.Width - 120 TreeView1.Width = 60 imgSplitter.Left = 60 ListView1.Left = 120 Else TreeView1.Width = TreeView1.Width + X imgSplitter.Left = imgSplitter.Left + X ListView1.Left = ListView1.Left + X ListView1.Width = ListView1.Width - X End If ElseIf X > 0 Then '向右平移 If X >= ListView1.Width - 180 Then TreeView1.Width = TreeView1.Width + imgSplitter.Width + ListView1.Width - 180 imgSplitter.Left = TreeView1.Left + TreeView1.Width ListView1.Left = imgSplitter.Left + imgSplitter.Width ListView1.Width = 120 Else TreeView1.Width = TreeView1.Width + X imgSplitter.Left = imgSplitter.Left + X ListView1.Left = ListView1.Left + X ListView1.Width = ListView1.Width - X End If End If End If End Sub
一般是用api函数来实现,你去找找。
也可以在窗体上放上控件,然后在拉动事件中调整控件位置。
Private Sub Form_Load()
Picture1.MousePointer = 9
Picture1.Appearance = 0
Picture1.BackColor = &H8000000F
Picture1.BorderStyle = 0
Picture1.Width = 150
End SubPrivate Sub Form_Resize()
On Error GoTo err1
Text1.Top = 0
Text1.Left = 0
Text1.Width = 3000
Text1.Height = form1.Height
Picture1.Top = 0
Picture1.Left = Text1.Width - 50
Picture1.Height = form1.Height Text2.Top = 0
Text2.Left = Text1.Width + Picture1.Width - 50
Text2.Height = form1.Height
Text2.Width = form1.Width - Text1.Width - Picture1.Width
Exit Sub
err1:
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo err1
If Button = 1 Then
Picture1.Move Picture1.Left + X
Picture1.ZOrder (0)
End If
Exit Sub
err1:
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo err1
If Button = 1 Then
Text1.Left = 0
If Picture1.Left < 1000 Then
Text1.Width = 1000
Picture1.Left = 1000
Else
If Picture1.Left > form1.Width Then
Text1.Width = form1.Width - 500
Picture1.Left = Text1.Width
Else
Text1.Width = Picture1.Left
End If
End If
Text2.Left = Text1.Width + Picture1.Width
Text2.Width = form1.Width - Text1.Width - Picture1.Width
End If
Exit Sub
err1:
End Sub'***************************************************
'建一个窗体
'加入两个文本框(text1,text2)和一个图片框(picture1)
'*******************************************
Private Declare Function ReleaseCapture Lib "user32" () As Long'加三个PICTUREBOX控件,将其中一个作为分隔条,改名为:picSplit
Private Sub Form_Load()
Picture1.Left = 60
Picture1.Top = 60
Picture2.Top = 60
picSplit.Left = Picture1.Left + Picture1.Width + 30
picSplit.Width = 60
picSplit.BorderStyle = 0
Picture2.Left = picSplit.Left + picSplit.Width '+ 50
Picture1.Height = 5700
Picture2.Height = 5700
picSplit.Top = 60
picSplit.Height = 5700
picSplit.MousePointer = vbSizeWE
End SubPrivate Sub picSplit_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Button = vbLeftButton Then
SetCapture picSplit.hwnd
picSplit.Tag = x
picSplit.BackColor = &HFF8080
End If
End SubPrivate Sub picSplit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Button = vbLeftButton Then
If picSplit.Left >= (100 - x) And picSplit.Left <= (Me.ScaleWidth - 100 - x) Then picSplit.Left = picSplit.Left + x - CInt(picSplit.Tag)
End If
End SubPrivate Sub picSplit_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Button = vbLeftButton Then
Picture1.Width = picSplit.Left - 80
Picture2.Left = picSplit.Left + 50
Picture2.Width = Width - Picture1.Width - 4
picSplit.BackColor = &H8000000F
ReleaseCapture
End If
End Sub
With TreeView1
.Top = 15
.Left = 15
.Height = Me.Height - StatusBar1.Height - 400
.Width = Me.Width * 0.35
End With
With imgSplitter
.Top = 15
.Left = TreeView1.Left + TreeView1.Width
.Height = TreeView1.Height
.Width = 60
End With
With ListView1
.Top = 15
.Left = TreeView1.Left + TreeView1.Width + imgSplitter.Width
.Height = TreeView1.Height
.Width = Me.Width * 0.65 - 200
End With
End SubPrivate Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'开始移动
If Button = 1 Then
If X < 0 Then '向左平移
If Abs(X) >= TreeView1.Width - 60 Then
ListView1.Width = TreeView1.Width + imgSplitter.Width + ListView1.Width - 120
TreeView1.Width = 60
imgSplitter.Left = 60
ListView1.Left = 120
Else
TreeView1.Width = TreeView1.Width + X
imgSplitter.Left = imgSplitter.Left + X
ListView1.Left = ListView1.Left + X
ListView1.Width = ListView1.Width - X
End If
ElseIf X > 0 Then '向右平移
If X >= ListView1.Width - 180 Then
TreeView1.Width = TreeView1.Width + imgSplitter.Width + ListView1.Width - 180
imgSplitter.Left = TreeView1.Left + TreeView1.Width
ListView1.Left = imgSplitter.Left + imgSplitter.Width
ListView1.Width = 120
Else
TreeView1.Width = TreeView1.Width + X
imgSplitter.Left = imgSplitter.Left + X
ListView1.Left = ListView1.Left + X
ListView1.Width = ListView1.Width - X
End If
End If
End If
End Sub