Thomas Risi Softwareentwicklung

Mauszeiger in UserForm einsperren

Ein Beispiel, um den Mauszeiger nur innerhalb einer UserForm zuzulassen.

Quellcode für normales Modul ...

Option Explicit Private Declare Function ClipCursor Lib "user32.dll" ( _ lpRect As Any) As Long Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowRect Lib "user32.dll" ( _ ByVal hWnd As Long, _ ByRef lpRect As RECT) 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 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 Type RECT left As Long top As Long right As Long bottom As Long End Type Private Const GWL_WNDPROC = (-4) Private Const WM_CLOSE = &H10& Private Const WM_NCMOUSEMOVE = &HA0& Private Const WM_SYSCOMMAND = &H112& Private Const SC_CLOSE = &HF060& Private m_hWnd As Long Private m_OldProc As Long Public Sub ClipCursorUF() If Not m_hWnd = 0 Then Dim hRect As RECT Call GetWindowRect(m_hWnd, hRect) Call ClipCursor(hRect) End If End Sub Public Sub UnClipCursorUF() Call ClipCursor(0&) Call SetWindowLong(m_hWnd, GWL_WNDPROC, m_OldProc) End Sub Public Sub SubclassUF(uf As MSForms.UserForm) m_hWnd = GetHandleUF(uf) m_OldProc = SetWindowLong(m_hWnd, GWL_WNDPROC, AddressOf NewProc) End Sub Public Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Select Case Msg Case WM_SYSCOMMAND Select Case wParam Case SC_CLOSE: Call UnClipCursorUF End Select Case WM_NCMOUSEMOVE Call ClipCursorUF End Select NewProc = CallWindowProc(m_OldProc, hWnd, Msg, wParam, lParam) End Function Private Function GetHandleUF(uf As MSForms.UserForm) As Long GetHandleUF = IIf(Int(Val(Application.Version)) < 9, _ FindWindow("ThunderXFrame", uf.Caption), FindWindow("ThunderDFrame", uf.Caption)) End Function

Quellcode für die UserForm mit einem CommandButton ...

Option Explicit Private Sub CommandButton1_Click() MsgBox "Test" Call ClipCursorUF End Sub Private Sub UserForm_Activate() Call ClipCursorUF End Sub Private Sub UserForm_Initialize() Me.Caption = " Unsere kleine Form" Call SubclassUF(Me) End Sub

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)