AW: Habe schon festgestellt, ...
05.02.2019 15:33:54
Nepumuk
Hallo Dieter,
so kannst du den Cursor mitwandern lassen:
Option Explicit
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, _
ByVal y As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Const Step As Single = 100
Private Const GC_CLASSNAME_TASKBAR As String = "Shell_TrayWnd"
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private mudtTaskbarRect As RECT
Private msngScreenWidth As Single
Private msngScreenHeight As Single
Private msngTaskbarHeight As Single
Private Sub CommandButton1_Click()
Call Unload(Object:=Me)
End Sub
Private Sub SpinButton1_SpinUp()
Dim udtPointApi As POINTAPI
Left = Application.Min(msngScreenWidth - Width, Left + Step)
Call GetCursorPos(udtPointApi)
Call SetCursorPos(udtPointApi.x + Step / 0.75, udtPointApi.y)
End Sub
Private Sub SpinButton1_SpinDown()
Dim udtPointApi As POINTAPI
Left = Application.Max(0, Left - Step)
Call GetCursorPos(udtPointApi)
Call SetCursorPos(udtPointApi.x - Step / 0.75, udtPointApi.y)
End Sub
Private Sub SpinButton2_SpinDown()
Dim udtPointApi As POINTAPI
Top = Application.Min(msngScreenHeight - msngTaskbarHeight - Height, Top + Step)
Call GetCursorPos(udtPointApi)
Call SetCursorPos(udtPointApi.x, udtPointApi.y + Step / 0.75)
End Sub
Private Sub SpinButton2_SpinUp()
Dim udtPointApi As POINTAPI
Top = Application.Max(0, Top - Step)
Call GetCursorPos(udtPointApi)
Call SetCursorPos(udtPointApi.x, udtPointApi.y - Step / 0.75)
End Sub
Private Sub UserForm_Initialize()
Dim lngprtTaskbarHwnd As LongPtr
lngprtTaskbarHwnd = FindWindowA(GC_CLASSNAME_TASKBAR, vbNullString)
Call GetWindowRect(lngprtTaskbarHwnd, mudtTaskbarRect)
With mudtTaskbarRect
msngTaskbarHeight = (.Bottom - .Top) * 0.75
End With
msngScreenWidth = CSng(GetSystemMetrics(SM_CXSCREEN) * 0.75)
msngScreenHeight = CSng(GetSystemMetrics(SM_CYSCREEN) * 0.75)
End Sub
Gruß
Nepumuk