Author  

Language  

Operating Systems  

Option Explicit

Private Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32.dll" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long) As Long

Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const SC_ARRANGE = &HF110
Public Const SC_CLOSE = &HF060
Public Const SC_HOTKEY = &HF150
Public Const SC_HSCROLL = &HF080
Public Const SC_KEYMENU = &HF100
Public Const SC_MAXIMIZE = &HF030
Public Const SC_MINIMIZE = &HF020
Public Const SC_MOVE = &HF010
Public Const SC_NEXTWINDOW = &HF040
Public Const SC_PREVWINDOW = &HF050
Public Const SC_RESTORE = &HF120
Public Const SC_SIZE = &HF000
Public Const SC_VSCROLL = &HF070
Public Const SC_TASKLIST = &HF130
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOP = 0
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const GWL_STYLE = (-16)

Public Enum T_WindowStyle
    WS_BORDER = &H800000
    WS_CAPTION = &HC00000
    WS_CHILD = &H40000000
    WS_CHILDWINDOW = (WS_CHILD)
    WS_CLIPCHILDREN = &H2000000
    WS_CLIPSIBLINGS = &H4000000
    WS_DISABLED = &H8000000
    WS_DLGFRAME = &H400000
    WS_EX_ACCEPTFILES = &H10&
    WS_EX_DLGMODALFRAME = &H1&
    WS_EX_NOPARENTNOTIFY = &H4&
    WS_EX_TOPMOST = &H8&
    WS_EX_TRANSPARENT = &H20&
    WS_GROUP = &H20000
    WS_HSCROLL = &H100000
    WS_MAXIMIZE = &H1000000
    WS_MAXIMIZEBOX = &H10000
    WS_MINIMIZE = &H20000000
    WS_MINIMIZEBOX = &H20000
    WS_OVERLAPPED = &H0&
    WS_ICONIC = WS_MINIMIZE
    WS_POPUP = &H80000000
    WS_VISIBLE = &H10000000
    WS_VSCROLL = &H200000
    WS_SYSMENU = &H80000
    WS_TABSTOP = &H10000
    WS_THICKFRAME = &H40000
    WS_TILED = WS_OVERLAPPED
    WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or          WS_MAXIMIZEBOX)
    WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
    WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
    WS_SIZEBOX = WS_THICKFRAME
End Enum

'Brings the specified form in the top most position, it will be over all other
'forms in the screen, even if they will receive the focus
Public Sub FormTopMost(hWnd As Long)
    SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
End Sub

'Brings the form in his standard Z-Order
Public Sub FormNoTopMost(hWnd As Long)
    SetWindowPos hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
End Sub

'Brings the form in the top position of the Z-Order, if another form takes the
'focus it will become the new top form
Public Sub FormTop(hWnd As Long)
    SetWindowPos hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
End Sub

'Remove the form's system menu, if RemoveClose is true the Close command inside the
'menu is removed too, in this case even the X key in the right upper cornet of the
'form will be removed
Public Sub RemoveSystemMenu(hWnd As Long, RemoveClose As Boolean)
    Dim hMenu As Long

    hMenu = GetSystemMenu(hWnd, False)
    DeleteMenu hMenu, SC_MAXIMIZE, MF_BYCOMMAND
    DeleteMenu hMenu, SC_MINIMIZE, MF_BYCOMMAND
    DeleteMenu hMenu, SC_SIZE, MF_BYCOMMAND
    DeleteMenu hMenu, SC_MOVE, MF_BYCOMMAND
    DeleteMenu hMenu, SC_RESTORE, MF_BYCOMMAND
    DeleteMenu hMenu, SC_NEXTWINDOW, MF_BYCOMMAND
    If RemoveClose Then
        DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND
        DeleteMenu hMenu, 0, MF_BYPOSITION
    End If
End Sub

'Hides the upper right keys Maximize and minimize
Public Sub RemoveMaxMinButtons(hWnd As Long)
    Dim x As Long

    x = GetWindowLong(hWnd, GWL_STYLE)
    x = x And Not WS_MINIMIZEBOX
    x = x And Not WS_MAXIMIZEBOX
    SetWindowLong hWnd, GWL_STYLE, x
End Sub

'Shows the upper right keys Maximize and minimize
Public Sub AddMaxMinButtons(hWnd As Long)
    Dim x As Long

    x = GetWindowLong(hWnd, GWL_STYLE)
    x = x Or WS_MINIMIZEBOX
    x = x Or WS_MAXIMIZEBOX
    SetWindowLong hWnd, GWL_STYLE, x
End Sub

'Set the attribute of a window: the module has a public enum type that contains
'all the constants to define a window style (used by others Subs)
Public Sub SetWindowStyle(hWnd As Long, mAttribute As T_WindowStyle, Enable As Boolean)
    Dim x As Long

    x = GetWindowLong(hWnd, GWL_STYLE)
    If Enable Then
        x = x Or mAttribute
    Else
        x = x And Not mAttribute
    End If
    SetWindowLong hWnd, GWL_STYLE, x
End Sub