VB 窗体锁定 API实现

Question

我这已经有段程序可以实现锁定窗体功能（即不可以让鼠标拖动窗体），可是当很多窗体的情形下，会使程序当掉。已有的程序如下：Option ExplicitPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate lpPrevWndProc As LongPrivate Const GWL_WNDPROC = -4
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&Public Sub StartHook(hWnd As Long)
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc1)
End SubPublic Sub Unhook(hWnd As Long)
    If lpPrevWndProc <> 0 Then SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
End SubPrivate Function WindowProc1(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'    If MDIForm1.LockandUnlock = False Then
'        Exit Function
'    End If
    Select Case uMsg
        Case WM_SYSCOMMAND
            If (wParam And &HFFF0) = SC_MOVE Then
                Debug.Print "move: " & Form1.hWnd; hWnd; uMsg; wParam; lParam
                WindowProc1 = 0
                Exit Function
            End If
    End Select
    WindowProc1 = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function当程序锁定时，Function WindowProc1 始终被调用，而最终使程序当掉，有什么其他解决办法嘛，也用API实现。

Answer 1

子类化的时候，WindowProc1必然始终被调用，要不你怎么知道什么时候发生了WM_SYSCOMMAND操作。。

Answer 2

LZ给的代码用的是消息HOOK，这种方法必须分消息来HOOK，考虑不周就容易当机或者程序崩溃。不让鼠标拖动窗体一般HOOk鼠标down,move,up事件和systemcommand，也就是窗体系统菜单。不让鼠标拖动，有个比较省事的方法:建立一个无边框窗体（边缘可以使用图片来装饰像边框）。

Answer 3

直接在设计时把窗体的Moveable设为false不行吗

Answer 4

Moveable后还可以缩放窗体，貌似达不到目的

Answer 5

改borderstyle为固定，moveable=false差不多了。

Answer 6

关键实时的，可以实现窗体锁定和解锁，那这种方法就不可用了啊，只能在属性窗体里修改
所以只能用API去实现了

Answer 7

"实时的，可以实现窗体锁定和解锁"，LZ的意思就是随时可以锁定和解锁鼠标吧？
如果是这样，确实只能使用api，而且貌似也只能HOOK，并在HOOK中使用全局变量随时限制和解除限制。

Answer 8

不知道你的代码是不是原封不动的就是这个 
如果是的话, 你要考虑一个问题存储窗口处理函数地址的变量 Private lpPrevWndProc As Long
只有一个,而窗口很多时貌似你也是用这一个变量来存, 调用多次 starthook lpprevxxx 变量
存储的窗口处理函数地址却总指向最后一个, 也就是说所有的窗口被子类话的窗口的消息全被发送到了
最后一个被子类话的窗口上了

Answer 9

不知这段代码是否能用:
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const SC_SIZE = &HF000
Private Const SC_MOVE = &HF010
Private Const MF_BYCOMMAND = &H0
Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Private Sub Command1_Click() '限制
Dim hwnd As Long
Dim hMenu As Long
Dim Success As Long    hwnd = Form1.hwnd
    hMenu = GetSystemMenu(hwnd, 0)
    Success = RemoveMenu(hMenu, SC_SIZE, MF_BYCOMMAND) '/删除改变大小菜单
    Success = RemoveMenu(hMenu, SC_MOVE, MF_BYCOMMAND) '/删除移动菜单
End SubPrivate Sub Command2_Click() '解除
Dim hwnd As Long
Dim hMenu As Long
Dim Success As Long
 hwnd = Form1.hwnd
hMenu = GetSystemMenu(hwnd, 1)
End Sub