在 Visual Basic 6 中让用户在运行时移动和调整控件大小

键盘侠雷哥

于 2021-06-12 20:43:43 发布

阅读量646

点赞数

分类专栏：【VB6】

本文链接：https://blog.csdn.net/YYMP32008/article/details/117855157

版权

【VB6】专栏收录该内容

3 篇文章 1 订阅

订阅专栏

标题	在 Visual Basic 6 中让用户在运行时移动和调整控件大小
描述	此示例说明如何让用户在 Visual Basic 6 中在运行时移动控件和调整控件大小。
关键词	拖动、移动、调整大小、控件、Visual Basic 6
类别	控件，ActiveX

本示例构建了一个 ActiveX 控件，允许用户在运行时移动和调整控件的大小。它会自动调整它包含的控件的大小以适应。

UserControl 在其右下角包含一个名为 Corner 的小图片框。该控件跟踪其 MouseDown、MouseMove 和 MouseUp 事件。当您拖动该控件时，以下代码会调整 UserControl 的大小，将 Corner 放回右下角，并调整包含的控件的大小以适合。

Option Explicit

'Default Property Values:
Const m_def_Draggable = True
Const m_def_MinWidth = 240
Const m_def_MaxWidth = 100000
Const m_def_MinHeight = 240
Const m_def_MaxHeight = 100000
Const m_def_HandleSize = 45
'Property Variables:
Dim m_Draggable As Boolean
Dim m_MinWidth As Long
Dim m_MaxWidth As Long
Dim m_MinHeight As Long
Dim m_MaxHeight As Long
Dim m_HandleSize As Long

Dim Resizing As Boolean
Dim Moving As Boolean
Dim StartX As Single
Dim StartY As Single

' *********************************************
' Start resizing the control.
' *********************************************
Private Sub Corner_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not Draggable Then Exit Sub
    Resizing = True
    StartX = X
    StartY = Y
End Sub

' *********************************************
' Resize the control.
' *********************************************
Private Sub Corner_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dw As Single
Dim dh As Single
Dim wid As Single
Dim hgt As Single
Dim w As Single
Dim h As Single

    ' Do nothing unless we're resizing.
    If Not Resizing Then Exit Sub
    
    dw = X - StartX
    dh = Y - StartY
    If dw = 0 And dh = 0 Then Exit Sub
    
    wid = Width + dw
    ' Make sure we will fit on the form.
    w = ScaleX(wid, ScaleMode, Parent.ScaleMode)
    If w > Parent.ScaleWidth - Extender.Left Then
        w = Parent.ScaleWidth - Extender.Left
        wid = ScaleX(w, Parent.ScaleMode, ScaleMode)
    End If
    ' Stay between MinWidth and MaxWidth.
    If wid < m_MinWidth Then wid = m_MinWidth
    If wid > m_MaxWidth Then wid = m_MaxWidth
    
    hgt = Height + dh
    ' Make sure we will fit on the form.
    h = ScaleX(hgt, ScaleMode, Parent.ScaleMode)
    If h > Parent.ScaleHeight - Extender.Top Then
        h = Parent.ScaleHeight - Extender.Top
        hgt = ScaleY(h, Parent.ScaleMode, ScaleMode)
    End If
    ' Stay between MinHeight and MaxHeight.
    If hgt < m_MinHeight Then hgt = m_MinHeight
    If hgt > m_MaxHeight Then hgt = m_MaxHeight

    Size wid, hgt
End Sub
' *********************************************
' Stop resizing the control.
' *********************************************
Private Sub Corner_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Resizing = False
End Sub

UserControl 排列它包含的控件，因此底部有一个小间隙。这让 UserControl 显示出来并让您看到 Corner PictureBox。

UserControl 也在其自己的表面上跟踪 MouseDown、MouseMove 和 MouseUp 事件。当您在 UserControl 上单击并拖动时，代码会确定该控件的位置并调用 Extender.Move 以适当地移动 UserControl。

该控件还包括在注册表中保存和恢复大小和位置的例程，因此程序可以轻松地在程序运行之间保持其大小和位置。