VB 窗体移动

墨家前任巨子

已于 2023-02-17 08:06:34 修改

阅读量819

点赞数

分类专栏： VB学习文章标签：学习方法

于 2023-01-11 18:01:10 首次发布

本文链接：https://blog.youkuaiyun.com/qq_39728950/article/details/128648881

版权

VB学习专栏收录该内容

13 篇文章

订阅专栏

这段代码定义了两个事件处理子程序，分别响应SSTab_Calender对象的MouseDown和MouseMove事件，调用WinMove函数来处理窗体移动。WinMove函数根据条件判断是鼠标按下还是移动，并更新对象的位置。如果发生错误，会弹出提示并询问用户是否继续执行。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Private Sub SSTab_Calender_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call WinMove("MouseDown", SSTab_Calender, Button, x, y)
End Sub
Private Sub SSTab_Calender_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call WinMove("MouseMove", SSTab_Calender, Button, x, y)
End Sub

'窗体移动
Public Function WinMove(ByVal condition As String, ByRef Obj As Object, Button As Integer, x As Single, y As Single)
    Dim PointerOrgin() As String
1   On Error GoTo Err_WinMove
    '-------------------------------------
2   If Button = 1 Then    '右键按下
3       If condition = "MouseDown" Then
4           Obj.Tag = x & " " & y
5       ElseIf condition = "MouseMove" Then
6           PointerOrgin = Split(Obj.Tag, " ")
7           Obj.Left = Obj.Left + (x - Val(PointerOrgin(0)))
8           Obj.Top = Obj.Top + (y - Val(PointerOrgin(1)))
9       End If
10  End If
    '-------------------------------------
11  On Error GoTo 0
12  Exit Function
Err_WinMove:
13  If MsgBox("【错误代码】:" & Err.Number & vbCrLf & "【错误描述】：" & Err.Description & vbCrLf & "【出错位置】: [FunAll]→ [WinMove]的 " & Erl & "行" & vbCrLf & "是否继续？", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
End Function