用户窗体定身术--禁止移动

在VBA中通过用户窗体的StartUpPosition属性可以指定窗体显示的位置,如下图所示。
用户窗体定身术--禁止移动_第1张图片
但是用户可以随意拖动窗体调整位置,是否可以像孙悟空一样,给窗体施个定身术,固定位置无法移动呢?
用户窗体的移动可以通过系统菜单操作,如下图所示,鼠标拖动用户窗体实际上也是调用了系统菜单功能。
用户窗体定身术--禁止移动_第2张图片
但是VBA中的用户窗体对象并没有提供属性或者方法来控制其系统菜单,只能使用API函数来进行处理。

Private Declare Function GetSystemMenu Lib "user32" _
                (ByVal hWnd As Long, _
                 ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" _
                (ByVal lngHmenu As Long, _
                 ByVal nPosition As Long, _
                 ByVal wFlags As Long) As Long
Private Declare Function FindWindowA Lib "user32" _
                (ByVal lpClassName As String, _
                 ByVal lpWindowName As String) As Long
Private Declare Function GetMenuItemCount Lib "user32" _
                (ByVal lngHmenu As Long) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
                (ByVal lngHmenu As Long, _
                 ByVal wIDItem As Long, _
                 ByVal lpString As String, _
                 ByVal nMaxCount As Long, _
                 ByVal wFlag As Long) As Long
Private Const MF_BYPOSITION As Long = &H400
Private Sub UserForm_Initialize()
    Dim intCount As Integer, i As Integer
    Dim lngHwnd As Long
    Dim lngHmenu As Long
    Dim strMenu As String * 255, strMenu1 As String
    Me.StartUpPosition = 2
    lngHwnd = FindWindowA(vbNullString, Me.Caption)
    If lngHwnd <> 0 Then
        lngHmenu = GetSystemMenu(lngHwnd, False)
        intCount = GetMenuItemCount(lngHmenu)
        Debug.Print "UserFomr1有 " & intCount & " 个菜单项"
        Debug.Print "--------------"
        For i = 0 To intCount
            GetMenuString lngHmenu, i, strMenu, 255, MF_BYPOSITION
            strMenu1 = strRemoveNull(strMenu)
            Debug.Print i, strMenu1
        Next i
        Debug.Print "------- 删除菜单项 -------"
        RemoveMenu lngHmenu, 1, MF_BYPOSITION
        intCount = GetMenuItemCount(lngHmenu)
        Debug.Print "UserFomr1有 " & intCount & " 个菜单项"
    End If
End Sub
Private Function strRemoveNull(strIn As String) As String
    On Error Resume Next
    Dim intLen As Integer
    Dim i As Integer
    intLen = Len(strIn)
    i = 1
    While (Asc(Mid(strIn, i, 1)) <> 0 And i < intLen)
        i = i + 1
    Wend
    If i > 1 Then
        strRemoveNull = Left(strIn, i - 1)
    End If
End Function

在代码窗口中可以看到如下输出结果。

UserFomr1有 7 个菜单项
--------------
 0            还原(&R)
 1            移动(&M)
 2            大小(&S)
 3            最小化(&N)
 4            最大化(&X)
 5            
 6            关闭(&C)    Alt+F4
 7            
------- 删除菜单项 -------
UserFomr1有 6 个菜单项

此时在用户窗体标题栏上右击,快捷菜单如下图所示,使用鼠标也无法拖动用户窗体,完美实现定身术!
用户窗体定身术--禁止移动_第3张图片
代码解析:
第26行代码使用FindWindowA获取用户窗体句柄。
第28行代码使用GetSystemMenu获取用户窗体系统菜单句柄。
第29行到第36行代码是为了遍历菜单项,如果只是为了删除菜单,则不需要此部分代码。
第29行代码使用GetMenuItemCount获取用户窗体系统菜单中菜单项的数量。
第33行代码使用GetMenuString获取用菜单项的文字描述字符串,结果保存在strMenu中,由于strMenu是定长字符串,所以需要使用自定义函数strRemoveNull去除多数的空字符。
由立即窗口的输出结果可以知道,“移动”是第2个菜单项,在第38行代码中使用RemoveMenu删除“移动”菜单项,第2个参数设置为1,是因为菜单项位置编号是从0开始的。
第43行到第55行为自定义函数strRemoveNull去除多数的空字符。

你可能感兴趣的:(VBA,API,窗体,窗体,API,固定位置,禁止移动,VBA)