AW: Userform ohne Balken mit X
16.07.2020 14:24:37
volti
Hallo Jochen,
die beiden Funktionen brauchen unter 64Bit andere Funktionen. Wenn wir die von Nepumuk verwendeten Funktionen weiter verwenden wollen, muss der Alias angepasst werden.
Außerdem muss Dim lngptrStyle As Long => Dim lngptrStyle As LongPtr werden.
Hier Dein code:
[+][-]
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByRef lParam As Any) As LongPtr
Private Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare PtrSafe Function IsThemeActive Lib "uxtheme.dll" () As Long
Private Const GC_CLASSNAMEMSFORM As String = "ThunderDFrame"
Private Const GWL_STYLE As Long = -16&
Private Const WS_CAPTION As LongPtr = &HC00000
Private Const HTCAPTION As LongPtr = 2&
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private mlngptrHwnd As LongPtr
Private Sub UserForm_Activate()
Dim lngptrStyle As LongPtr
mlngptrHwnd = FindWindowA(GC_CLASSNAMEMSFORM, Caption)
lngptrStyle = GetWindowLongA(mlngptrHwnd, GWL_STYLE)
lngptrStyle = lngptrStyle And Not WS_CAPTION
Call SetWindowLongA(mlngptrHwnd, GWL_STYLE, lngptrStyle)
Call DrawMenuBar(mlngptrHwnd)
If IsThemeActive = 1 Then
Height = Height - 16
Else
Height = Height - 14
End If
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessageA(mlngptrHwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub CommandButton1_Click()
Call Unload(Me)
End Sub
viele Grüße aus Freigericht
Karl-Heinz