Attribute VB_Name = "dialogs"
Option Explicit

'-----------------------------Declarations to Remove Dialog Controls
Private Const MfByPosition As Long = &H400     'Deletes the menus by position (this is our default).
Private Const MinimumSysMenuItems As Long = 9  'This is the number of items on the system menu
Private Const SW_NORMAL  As Long = 1

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd 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 FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'--------------Set Dialog to Top API---------------
Private Declare Function SetWindowPos Lib "user32" (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 GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'--------------Remove Dialog Controls API----------
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'--------------Get Class Name----------------------
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) 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
    MinPosition As POINTAPI
    MaxPosition As POINTAPI
    NormalPosition As RECT
End Type



'Purpose   :    Deletes the system control menu of the specified window.
'Inputs    :    sDialogCaption              The caption of the window whose control menu you want to delete.
'               [lHandle]                   If specified operates on this window, else finds the handle from
'                                           the dialog caption.
'Outputs   :    N/A
'Author    :    Andrew Baker
'Date      :    30/05/2000
'Notes     :    1. Disables all the dialog menus including the min, max, terminate and resizing.
'               2. Control 6 contains the Terminate (X) control.
'Revisions :    Added code to refresh menu bar.

Sub DialogDisableMenuControls(sDialogCaption As String, Optional lHandle As Long)
    Dim lCount As Long
    
    If lHandle = 0 Then
        'Get window handle from dialog caption
        lHandle = DialogHwnd(sDialogCaption)
    End If
    'Only continue if the passed window handle isn't zero.
    If lHandle <> 0 Then
        'There are 9 items on the application control menu.
        'Loop through and disable each one.
        For lCount = 1 To MinimumSysMenuItems
            'After deleting menu item 0, menu item 1 becomes menu item 0,
            'hence we delete item 0 each time.
            Call DeleteMenu(GetSystemMenu(lHandle, False), 0, MfByPosition)
        Next
        'Refresh the dialog menu bar
        Call DrawMenuBar(lHandle)
    End If
End Sub


'Purpose   :    Restores the system control menu of the specified window.
'Inputs    :    sDialogCaption              The caption of the window whose control menu you want to restore.
'               [lHandle]                   If specified operates on this window, else finds the handle from
'                                           the dialog caption.
'Outputs   :    N/A
'Author    :    Andrew Baker
'Date      :    30/05/2000
'Notes     :    To call in VBA use:
'               DialogEnableMenuControls Me.Caption
'Revisions :    Added code to refresh menu bar.

Public Sub DialogEnableMenuControls(sDialogCaption As String, Optional lHandle As Long)
    If lHandle = 0 Then
        'Get window handle from dialog caption
        lHandle = DialogHwnd(sDialogCaption)
    End If
    If lHandle Then
        'Passing True to the bRevert argument of the GetSystemMenu API restores
        'the control menu of the specified window.
        Call GetSystemMenu(lHandle, True)
        Call DrawMenuBar(lHandle)
    End If
End Sub



'Purpose   :    Returns the Windows Handle of a Dialog based on its caption (and class name).
'Inputs    :    sDialogCaption as String            The Caption of the dialog to find the handle.
'               [sClassName]                        The Class name of the dialog to find the handle.
'Outputs   :    The Dialogs Window Handle
'Author    :    Andrew Baker
'Date      :    30/05/2000
'Notes     :    To Call in VBA use
'               lHwnd = DialogHwnd(Me.Caption)
'Revisions :
Function DialogHwnd(ByVal sDialogCaption As String, Optional sClassName As String = vbNullString) As Long
    On Error Resume Next
    DialogHwnd = FindWindowA(sClassName, sDialogCaption)
    On Error GoTo 0
End Function



'Purpose   :    Places a Dialog back on top of all other dialogs
'Inputs    :    [lDialogHwnd]           =   Used when calling from VB       i.e. DialogToTop Me.hWnd
'               [sDialogCaption]        =   Used when calling from VBA      i.e. DialogToTop ,Me.Caption ,True
'Outputs   :    This enables the dialog to be shown above all other dialogs.
'Author    :    Andrew Baker    (VBUsers.com)
'Date      :    30/05/2000
'Notes     :
'Revisions :

Function DialogToTop(Optional lDialogHwnd As Long, Optional sDialogCaption As String)
    Dim WinPlace As WINDOWPLACEMENT
    Const HWND_TOPMOST As Long = -1
    
    If lDialogHwnd = 0 Then
        lDialogHwnd = DialogHwnd(sDialogCaption)
    End If
    If lDialogHwnd Then
        WinPlace.Length = Len(WinPlace)
        GetWindowPlacement lDialogHwnd, WinPlace
        SetWindowPos lDialogHwnd, HWND_TOPMOST, WinPlace.NormalPosition.Left, WinPlace.NormalPosition.Top, 0, 0, SW_NORMAL
    End If
End Function



'Purpose   :    Restores a Dialogs natural Z Order
'Inputs    :    [lDialogHwnd]        =   Used when calling from VB       i.e. DialogToNormal Me.hWnd
'               [sDialogCaption]     =   Used when calling from VBA      i.e. DialogToNormal ,Me.Caption
'Outputs   :    N/A
'Author    :    Andrew Baker    (VBUsers.com)
'Date      :    30/05/2000
'Notes     :    This routine is only required after calling DialogToTop.
'Revisions :

Sub DialogToNormal(Optional lDialogHwnd As Long, Optional sDialogCaption As String)
    Dim WinPlace As WINDOWPLACEMENT
    Const HWND_NOTOPMOST As Long = -2
    
    If lDialogHwnd = 0 Then
        lDialogHwnd = DialogHwnd(sDialogCaption)
    End If
    If lDialogHwnd Then
        WinPlace.Length = Len(WinPlace)
        GetWindowPlacement lDialogHwnd, WinPlace
        SetWindowPos lDialogHwnd, HWND_NOTOPMOST, WinPlace.NormalPosition.Left, WinPlace.NormalPosition.Top, 0, 0, SW_NORMAL
    End If
End Sub




'Purpose     :  Sets the windows style bits to remove the dialog controls
'Inputs      :  [sCaption]      =       The dialogs caption
'               [lHwnd]         =       The dialogs handle
'Outputs     :
'Author      :  Andrew Baker
'Date        :  12/08/2000 11:13
'Notes       :
'Revisions   :

Sub DialogRemoveControls(Optional sCaption As String, Optional lHwnd As Long)
    Dim lStyle As Long
    Const GWL_STYLE = (-16)
    Const WS_MAXIMIZEBOX = &H10000, WS_SYSMENU = &H80000, WS_MINIMIZEBOX = &H20000
    Const SWP_NOACTIVATE = &H10, SWP_NOMOVE = &H2, SWP_NOSIZE = &H1
    Const SWP_NOZORDER = &H4, SWP_FRAMECHANGED = &H20
    
    If Len(sCaption) Then
        'Get Dialog Handle
        lHwnd = DialogHwnd(sCaption)
    End If
    If lHwnd Then
        'Get Style bits
        lStyle = GetWindowLong(lHwnd, GWL_STYLE)
        'Set style bits
        lStyle = lStyle And (Not WS_SYSMENU) And (Not WS_MINIMIZEBOX) And (Not WS_MAXIMIZEBOX)
        Call SetWindowLong(lHwnd, GWL_STYLE, lStyle)
        Call SetWindowPos(lHwnd, 0&, 0&, 0&, 0&, 0&, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED)
    End If
End Sub


'Purpose     :  Returns the class name of a object given the handle or caption
'Inputs      :  [sCaption]      =       The objects caption
'               [lHwnd]         =       The objects handle
'Outputs     :
'Author      :  Andrew Baker
'Date        :  12/08/2000 12:33
'Notes       :
'Revisions   :

Function DialogClassName(Optional sCaption As String, Optional lHwnd As Long) As String
    Dim lRetVal As Long, sResult As String
    Const clMaxLen As Long = 256
    
    If Len(sCaption) Then
        'Get Dialog Handle
        lHwnd = DialogHwnd(sCaption)
    End If
    If lHwnd Then
        'Get Class Name
        sResult = String(clMaxLen, Chr(0))
        lRetVal = GetClassName(lHwnd, sResult, clMaxLen)
        DialogClassName = Left$(sResult, lRetVal)
    End If
End Function


'Purpose     :  Check if a form is an Excel Form
'Inputs      :  [sCaption]      =       The objects caption
'               [lHwnd]         =       The objects handle
'Outputs     :  Returns True if the Form is an Excel Form
'Author      :  Andrew Baker
'Date        :  12/08/2000 12:33
'Notes       :  Require either sCaption OR lHwnd
'Revisions   :

Function DialogIsExcel(Optional sFormCaption As String, Optional lHwnd As Long) As Boolean
    Const GW_OWNER As Long = 4
    lHwnd = GetWindow(FindWindowA("ThunderXFrame", sFormCaption), GW_OWNER)
    If DialogClassName(, lHwnd) = "XLMAIN" Then
        DialogIsExcel = True
    End If
End Function