Thomas Risi Softwareentwicklung
Addins - Datenbanklösungen - Komponenten - RTDServer - WebServices
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
© 2001 -
by Thomas Risi