AW: Userform komplett ohne Rand
21.11.2015 17:43:53
Nepumuk
Hallo,
ich würde den Rahmen einfach abschneiden:
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Private Declare PtrSafe Function CreateRectRgnIndirect Lib "gdi32.dll" ( _
ByRef lpRect As RECT) As LongPtr
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.dll" ( _
ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongA Lib "user32.dll" ( _
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, _
lParam As Any) As LongPtr
Private Declare PtrSafe Function SetWindowRgn Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
ByVal hRgn As LongPtr, _
ByVal bRedraw As Long) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () 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 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 Const GC_CLASSNAMEMSFORM As String = "ThunderDFrame"
Private mlngptrHwnd As LongPtr
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
Dim udtRect As RECT, udtPoint As POINTAPI
Dim lngptrStyle As LongPtr, lngptrRegion As LongPtr
mlngptrHwnd = FindWindowA(GC_CLASSNAMEMSFORM, Caption)
lngptrStyle = GetWindowLongA(mlngptrHwnd, GWL_STYLE)
Call SetWindowLongA(mlngptrHwnd, GWL_STYLE, lngptrStyle And Not WS_CAPTION)
Call DrawMenuBar(mlngptrHwnd)
Call GetWindowRect(mlngptrHwnd, udtRect)
udtPoint.X = udtRect.Right
udtPoint.Y = udtRect.Bottom
Call ScreenToClient(mlngptrHwnd, udtPoint)
With udtRect
.Bottom = udtPoint.Y
.Left = 4
.Right = udtPoint.X
.Top = 4
End With
lngptrRegion = CreateRectRgnIndirect(udtRect)
Call SetWindowRgn(mlngptrHwnd, lngptrRegion, 1&)
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
Gruß
Nepumuk