split.frm

来自「很好的教程原代码！」· FRM 代码 · 共 173 行

VERSION 5.00
Begin VB.Form frmSplit 
   Caption         =   "Form1"
   ClientHeight    =   5205
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6990
   LinkTopic       =   "Form1"
   ScaleHeight     =   5205
   ScaleWidth      =   6990
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Splitter 
      Height          =   3135
      Left            =   3480
      MousePointer    =   9  'Size W E
      ScaleHeight     =   3075
      ScaleWidth      =   75
      TabIndex        =   0
      Top             =   360
      Width           =   135
   End
   Begin VB.PictureBox Sbar 
      Align           =   2  'Align Bottom
      ClipControls    =   0   'False
      Height          =   315
      Left            =   0
      ScaleHeight     =   255
      ScaleWidth      =   6930
      TabIndex        =   3
      Top             =   4890
      Width           =   6990
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "切分窗体演示程序"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   0
         TabIndex        =   4
         Top             =   0
         Width           =   1920
      End
   End
   Begin VB.ListBox lstTel 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2580
      Left            =   4200
      TabIndex        =   2
      Top             =   480
      Width           =   1815
   End
   Begin VB.ListBox lstPers 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2580
      Left            =   360
      TabIndex        =   1
      Top             =   480
      Width           =   2655
   End
End
Attribute VB_Name = "frmSplit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义需要使用的变量
Private Const P_ECART = 3
Private x1 As Integer, x2 As Integer
Private y1 As Integer, y2 As Integer
Private width1 As Integer, width2 As Integer
Private height1 As Integer, height2 As Integer
Private glbfrmInSizeX As Long

'初始化窗体和变量
Private Sub Form_Load()
    glbfrmInSizeX = &H7FFFFFFF
    lstPers.AddItem "  "
    lstPers.AddItem "  "
    lstPers.AddItem "这是左边的窗口"
    lstPers.AddItem "把鼠标移动到切分条上"
    lstPers.AddItem "当鼠标变为左右拖动形状时"
    lstPers.AddItem "便可以切分窗口"
    lstTel.AddItem "  "
    lstTel.AddItem "  "
    lstTel.AddItem "这是右边的窗口"
    lstTel.AddItem "把鼠标移动到切分条上"
    lstTel.AddItem "当鼠标变为左右拖动形状时"
    lstTel.AddItem "便可以切分窗口"
End Sub

'当切分条Splitter移动的时候
Private Sub splitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If glbfrmInSizeX <> &H7FFFFFFF Then
        If CLng(x) <> glbfrmInSizeX Then
            Splitter.Move Splitter.Left + x, y1, P_ECART, ScaleHeight - Sbar.Height - 2
            glbfrmInSizeX = CLng(x)
        End If
    End If
End Sub

'当鼠标松开切分条Splitter的时候
Private Sub splitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If glbfrmInSizeX <> &H7FFFFFFF Then
        If CLng(x) <> glbfrmInSizeX Then
            Splitter.Move Splitter.Left + x, y1, P_ECART, ScaleHeight - Sbar.Height - 2
        End If
        glbfrmInSizeX = &H7FFFFFFF
        Splitter.BackColor = &H8000000F
        If Splitter.Left > 60 And Splitter.Left < (ScaleWidth - 60) Then
            lstPers.Width = Splitter.Left - lstPers.Left
            ElseIf Splitter.Left < 60 Then
            lstPers.Width = 60
        Else
            lstPers.Width = ScaleWidth - 60
        End If
        Form_Resize
    End If
End Sub

'当鼠标按下切分条Splitter的时候
Private Sub splitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        Splitter.BackColor = &H808080
        glbfrmInSizeX = CLng(x)
    Else
        If glbfrmInSizeX <> &H7FFFFFFF Then
            splitter_MouseUp Button, Shift, x, y
        End If
        glbfrmInSizeX = &H7FFFFFFF
    End If
End Sub

'窗体的大小改变
Private Sub Form_Resize()
    Const B_ECART = 1
    On Error Resume Next
    '赋值
    y1 = B_ECART
    height1 = ScaleHeight - Sbar.Height - B_ECART * 2
    x1 = B_ECART
    width1 = lstPers.Width
    x2 = x1 + lstPers.Width + P_ECART - 1
    width2 = ScaleWidth - x2 - B_ECART
    'ListBox和Splitter适应位置
    lstPers.Move x1 - 1, y1, width1, height1
    lstTel.Move x2, y1, width2 + 1, height1
    Splitter.Move x1 + lstPers.Width - 1, y1, P_ECART, height1
End Sub