Option Explicit
Private Const GWL_STYLE As Long = -16
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_THICKFRAME = &H40000
Private Const SC_CLOSE As Long = &HF060&
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
Private Declare PtrSafe Function DeleteMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If VBA7 Then
Private Sub SetStyleBit(style As LongPtr, ByVal bit As Long, ByVal bSet As Boolean)
#Else
Private Sub SetStyleBit(style As Long, ByVal bit As Long, ByVal bSet As Boolean)
#End If
If bSet Then
style = style Or bit
Else
style = style And Not bit
End If
End Sub
#If VBA7 Then
Function ChangeFormStyle(form As Object, Optional ByVal CloseBtn As Boolean = True, Optional ByVal sizing_border As Boolean = False, Optional ByVal minBtn As Boolean = False, Optional ByVal maxBtn As Boolean = False) As LongPtr
Dim hwnd As LongPtr
Dim style As LongPtr, hMenu As LongPtr
#Else
Function ChangeFormStyle(form As Object, Optional ByVal CloseBtn As Boolean = True, Optional ByVal sizing_border As Boolean = False, Optional ByVal minBtn As Boolean = False, Optional ByVal maxBtn As Boolean = False) As Long
Dim hwnd As Long
Dim style As Long, hMenu As Long
#End If
hwnd = FindWindow("ThunderDFrame", form.Caption)
style = GetWindowLong(hwnd, GWL_STYLE)
SetStyleBit style, WS_CAPTION, minBtn Or maxBtn Or CloseBtn
SetStyleBit style, WS_MINIMIZEBOX, minBtn
SetStyleBit style, WS_MAXIMIZEBOX, maxBtn
SetStyleBit style, WS_THICKFRAME, sizing_border
SetWindowLong hwnd, GWL_STYLE, style
If Not CloseBtn Then
hMenu = GetSystemMenu(hwnd, 0)
DeleteMenu hMenu, SC_CLOSE, 0
End If
DrawMenuBar hwnd
ChangeFormStyle = hwnd
End Function
