AW: StartUpPosition bei zwei Bildschirmen
09.12.2019 19:11:24
Nepumuk
Hallo Sven,
das angekündigte Beispiel:
Option Explicit
Option Private Module
Private Declare PtrSafe Function GetWindowPlacement Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function MoveWindow Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SetTimer Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Const GC_CLASSNAMEMSDIALOG As String = "#32770"
Private Const WM_PAINT As Long = &HF
Private Const SM_CXSCREEN As Long = 0&
Private Const SM_CYSCREEN As Long = 1&
Public gstrBoxTitle As String
Public Sub Test()
gstrBoxTitle = "Information"
Call SetTimer(Application.hwnd, 0, 1, AddressOf StartTimer)
Select Case MsgBox("Test", vbInformation, gstrBoxTitle)
Case vbOK
Debug.Print "Ok"
Case vbCancel
Debug.Print "Cancel"
Case vbAbort
Debug.Print "Abbruch"
Case vbRetry
Debug.Print "Wiederholen"
Case vbIgnore
Debug.Print "Ignorieren"
Case vbYes
Debug.Print "Ja"
Case vbNo
Debug.Print "Nein"
End Select
End Sub
Private Sub StartTimer(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Call StopTimer
Call SetWindowPos
End Sub
Private Sub StopTimer()
Call KillTimer(Application.hwnd, 0)
End Sub
Private Sub SetWindowPos()
Dim lngLeft As Long, lngTop As Long
Dim lngptrBoxHwnd As LongPtr
Dim udtWindowPlacemet As WINDOWPLACEMENT
Dim udtCursorPos As POINTAPI
lngptrBoxHwnd = FindWindowA(GC_CLASSNAMEMSDIALOG, gstrBoxTitle)
Call GetWindowPlacement(lngptrBoxHwnd, udtWindowPlacemet)
Call GetCursorPos(udtCursorPos)
udtWindowPlacemet.Length = Len(udtWindowPlacemet)
With udtWindowPlacemet.rcNormalPosition
If udtCursorPos.x + (.Right - .Left) > GetSystemMetrics(SM_CXSCREEN) Then
lngLeft = udtCursorPos.x - (.Right - .Left)
Else
lngLeft = udtCursorPos.x
End If
If udtCursorPos.y + (.Bottom - .Top) > GetSystemMetrics(SM_CYSCREEN) Then
lngTop = udtCursorPos.y - (.Bottom - .Top)
Else
lngTop = udtCursorPos.y
End If
Call MoveWindow(lngptrBoxHwnd, lngLeft, lngTop, .Right - .Left, .Bottom - .Top, WM_PAINT)
End With
End Sub
Gruß
Nepumuk