CascadeForm(): Prevent Multi-Instance Forms From Hiding Behind Each Other

Multi-instance forms–where you open multiple copies of the same form object–are a powerful but underused feature in Access.

Being able to compare two records side by side makes data analysis much easier.

Keeping multiple instances of the same form open in Access is surprisingly difficult, though. You can't just call DoCmd.OpenForm multiple times. Instead, you need to create new instances of the form's class module (i.e., its code-behind). You also need to ensure those instances don't go out of scope otherwise their associated forms will close.

Even if you can navigate all those challenges, there's a good chance your users won't even realize you've added support for multiple form instances.

That's because every time they open a new instance of the form, it opens the same size and at the same position on the screen. In other words, the forms stack directly on top of each other. Unless the user moves the form, it will look like the new instance is simply replacing the existing instance. This matches the behavior of every other Access form interaction they've had, so they don't even question it.

What we need is a way to make it obvious to the user that we have opened multiple instances of the form.

Prior Art: The Windows Operating System

While this may be a relatively new problem for most Access developers, it's a very common problem in Microsoft Windows.

Most applications–including the cmd console–support multiple instances. If every new cmd console appeared in the same spot on the screen, you wouldn't realize there was more than one. To handle this situation, the Windows team chose to create a "cascading" effect, where subsequent windows would open down and to the right of each earlier window.

Multiple instances of the cmd console arranged in a "cascading" pattern.

Let's see if we can recreate this cascade effect in Microsoft Access.

Sample Usage

For the sample usage, let's look at a BEFORE and AFTER of opening multiple form instances with and without our CascadeForm() routine.

In both screenshots below, we ran the same four ShowForm() calls shown above.

BEFORE

Without incorporating the CascadeForm() function, all four instances of the frmMSysObjects form open directly on top of the others, making it appear as though only a single instance of the form is open:

AFTER

After incorporating the CascadeForm() function into our ShowForm() function, it's now immediately obvious that we have four different instances of the form open at once:

On a side note, customizing the multi-instance form's caption in its Current() event would further enhance the user experience by making it easier to find the desired form instance.

The Approach

The idea is to open each subsequent instance of a form down and to the right of the previous one.

We do this by keeping track of how many instances of a given form are open during the Access session and storing a "Depth" value for that form. When another instance of the form is open, we use the Depth value to shift the form down and to the right.

We continue shifting the forms down and to the right until they no longer fit on the form's "canvas."

When this happens, we reset the Depth value to zero, which forces the next instance of the form to open in the original location. In this way, the forms continue to cascade indefinitely no matter how many form instances are opened.

The Function

Here is the CascadeForm() function on its own without its required dependencies.

' ----------------------------------------------------------------
' Procedure : CascadeForm
' Date      : 7/17/2023
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/cascadeform/
' Purpose   : Prevent multiple instances of a form from opening on top of each other.
' Requires  - GetInnerAccessHwnd()
'           - KeepFormOnCanvas()
'           - apiGetWindowRect() API call
'           - apiMoveWindow() API call
' ----------------------------------------------------------------
Sub CascadeForm(Frm As Form)
    Const pBuffer = 30    'buffer, in pixels

    'Maintain a collection of Depth values keyed by form name
    Static FormDepth As Collection
    If FormDepth Is Nothing Then Set FormDepth = New Collection
    
    'Attempt to get the form's current Depth value
    Dim Depth As Long
    On Error Resume Next
    Depth = FormDepth(Frm.Name)
    FormDepth.Remove Frm.Name
    On Error GoTo 0
    
    'Get the window handle for the Access "canvas"
    Dim CanvasHwnd As LongPtr
    CanvasHwnd = GetInnerAccessHwnd()
    
    'Get the Rectangle values for the Access window
    Dim pAccWindow As Rect
    apiGetWindowRect CanvasHwnd, pAccWindow
    
    'Get the Rectangle values for the passed form
    Dim pFormRect As Rect
    apiGetWindowRect Frm.hWnd, pFormRect
    
    'Move the window down and to the right (relative to previous instance)
    apiMoveWindow Frm.hWnd, _
                  pFormRect.Left - pAccWindow.Left + (pBuffer * Depth), _
                  pFormRect.Top - pAccWindow.Top + (pBuffer * Depth), _
                  pFormRect.Right - pFormRect.Left, _
                  pFormRect.Bottom - pFormRect.Top, _
                  True
                  
    'Move form to keep it on canvas if necessary
    If KeepFormOnCanvas(Frm) Then
        'If this form didn't fit on screen, reset the next one
        '   to use the original position...
        FormDepth.Add 0, Frm.Name
    Else
        '...otherwise, increment the depth so that the next instance
        '   cascades down and to the right of this one
        FormDepth.Add Depth + 1, Frm.Name
    End If

End Sub

The Full Code

The code below includes required helper functions that I've written about in the past:

KeepFormOnCanvas(): Get Back Here, Form!

The code can be copied and pasted into a blank standard module to get a fully-working solution that you can easily integrate into your projects:

Option Compare Database
Option Explicit

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare PtrSafe Function apiFindWindowEx Lib "user32" _
    Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
                           ByVal hWnd2 As LongPtr, _
                           ByVal lpsz1 As String, _
                           ByVal lpsz2 As String) As LongPtr
    
Private Declare PtrSafe Function apiGetParent Lib "user32" _
    Alias "GetParent" (ByVal hWnd As LongPtr) As LongPtr

Private Declare PtrSafe Function apiGetWindowRect Lib "user32" _
    Alias "GetWindowRect" (ByVal hWnd As LongPtr, lpRect As Rect) As Long
    
Private Declare PtrSafe Function apiMoveWindow Lib "user32" _
    Alias "MoveWindow" (ByVal hWnd As LongPtr, _
                        ByVal x As Long, ByVal y As Long, _
                        ByVal nWidth As Long, ByVal nHeight As Long, _
                        ByVal bRepaint As Long) As Long
    
Private Declare PtrSafe Function apiGetClientRect Lib "user32" _
    Alias "GetClientRect" (ByVal hWnd As LongPtr, _
                           lpRect As Rect) As Long

Private Declare PtrSafe Function GetDC Lib "user32" _
    (ByVal hWnd As LongPtr) As LongPtr

Private Declare PtrSafe Function ReleaseDC Lib "user32" _
    (ByVal hWnd As LongPtr, _
     ByVal hdc As LongPtr) As Long

Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As LongPtr, _
    ByVal nIndex As Long) As Long

Private Const WU_LOGPIXELSX = 88
Private Const WU_LOGPIXELSY = 90

' ----------------------------------------------------------------
' Procedure : CascadeForm
' Date      : 7/17/2023
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/cascadeform/
' Purpose   : Prevent multiple instances of a form from opening on top of each other.
' Requires  - GetInnerAccessHwnd()
'           - KeepFormOnCanvas()
'           - apiGetWindowRect() API call
'           - apiMoveWindow() API call
' ----------------------------------------------------------------
Sub CascadeForm(Frm As Form)
    Const pBuffer = 30    'buffer, in pixels

    'Maintain a collection of Depth values keyed by form name
    Static FormDepth As Collection
    If FormDepth Is Nothing Then Set FormDepth = New Collection
    
    'Attempt to get the form's current Depth value
    Dim Depth As Long
    On Error Resume Next
    Depth = FormDepth(Frm.Name)
    FormDepth.Remove Frm.Name
    On Error GoTo 0
    
    'Get the window handle for the Access "canvas"
    Dim CanvasHwnd As LongPtr
    CanvasHwnd = GetInnerAccessHwnd()
    
    'Get the Rectangle values for the Access window
    Dim pAccWindow As Rect
    apiGetWindowRect CanvasHwnd, pAccWindow
    
    'Get the Rectangle values for the passed form
    Dim pFormRect As Rect
    apiGetWindowRect Frm.hWnd, pFormRect
    
    'Move the window down and to the right (relative to previous instance)
    apiMoveWindow Frm.hWnd, _
                  pFormRect.Left - pAccWindow.Left + (pBuffer * Depth), _
                  pFormRect.Top - pAccWindow.Top + (pBuffer * Depth), _
                  pFormRect.Right - pFormRect.Left, _
                  pFormRect.Bottom - pFormRect.Top, _
                  True
                  
    'Move form to keep it on canvas if necessary
    If KeepFormOnCanvas(Frm) Then
        'If this form didn't fit on screen, reset the next one
        '   to use the original position...
        FormDepth.Add 0, Frm.Name
    Else
        '...otherwise, increment the depth so that the next instance
        '   cascades down and to the right of this one
        FormDepth.Add Depth + 1, Frm.Name
    End If

End Sub




'---------------------------------------------------------------------------------------vv
' Procedure : KeepFormOnCanvas
' Author    : Mike
' Date      : 11/1/11 - 10/8/14 10:23
' Purpose   : Ensures a form fits within the Access window.
' Notes     - Naming conventions (p: Pixels; t: Twips)
' Returns   - True if form did not fit within the Access window
'           - False if the form did fit
'---------------------------------------------------------------------------------------
'^^
Function KeepFormOnCanvas(tFrm As Form, Optional MinDetailSections As Integer = 5) As Boolean
    Const TwipsPerInch = 1440, tNavBarHeight = 270, acDefViewContinuous = 1
    Const tRecSelWidth = 263, tVertScrollWidth = 255
    Dim pAppCanvas As Rect, pAppRect As Rect, pFormRect As Rect, pFormCanvas As Rect
    Dim pVAppBuffer As Long, pHAppBuffer As Long, pVBuffer As Long, pHBuffer As Long
    
    #If VBA7 Then
        Dim DeviceContext As LongPtr
    #Else
        Dim DeviceContext As Long
    #End If
    
    Dim XPixelsPerInch As Long, YPixelsPerInch As Long
    
    Dim pFormWidth As Long, pFormHeight As Long, tFormWidth As Long, tFormHeight As Long
    Dim pNewLeft As Long, pNewWidth As Long
    Dim pNewTop As Long, pNewHeight As Long

    Dim CanvasHwnd As Variant 'Long/LongPtr
    CanvasHwnd = GetInnerAccessHwnd(tFrm.hWnd)
    
    apiGetWindowRect CanvasHwnd, pAppRect
    apiGetClientRect CanvasHwnd, pAppCanvas
    apiGetWindowRect tFrm.hWnd, pFormRect
    apiGetClientRect tFrm.hWnd, pFormCanvas


    'Get screen resolution (Pixels/Inch)
    DeviceContext = GetDC(tFrm.hWnd)
    XPixelsPerInch = GetDeviceCaps(DeviceContext, WU_LOGPIXELSX)
    YPixelsPerInch = GetDeviceCaps(DeviceContext, WU_LOGPIXELSY)
    ReleaseDC tFrm.hWnd, DeviceContext

    'The Buffers are the amount of space (in pixels) lost to the bounding window box at top/bottom and left/right
    pVBuffer = (pFormRect.Bottom - pFormRect.Top) - (pFormCanvas.Bottom - pFormCanvas.Top)
    pHBuffer = (pFormRect.Right - pFormRect.Left) - (pFormCanvas.Right - pFormCanvas.Left)
    pVAppBuffer = (pAppRect.Bottom - pAppRect.Top) - (pAppCanvas.Bottom - pAppCanvas.Top)
    pHAppBuffer = (pAppRect.Right - pAppRect.Left) - (pAppCanvas.Right - pAppCanvas.Left)

    'Calculate the full form width
    tFormWidth = tFrm.Width
    'Add width of record selectors
    If tFrm.RecordSelectors Then tFormWidth = tFormWidth + tRecSelWidth
    'Add width of vertical scroll bar
    If tFrm.ScrollBars And 2 Then tFormWidth = tFormWidth + tVertScrollWidth
    'Translate form width from twips to pixels (truncate instead of rounding to prevent 1-pixel "growth" of forms)
    pFormWidth = Int(tFormWidth / TwipsPerInch * XPixelsPerInch) + pHBuffer

    'Fit form on screen horizontally
    If pFormRect.Right >= pAppCanvas.Right + pAppRect.Left Or pFormCanvas.Bottom = 0 Then
        KeepFormOnCanvas = True
        pNewLeft = pAppCanvas.Right - pFormWidth
        pNewWidth = pFormWidth
    ElseIf pFormRect.Left < pAppRect.Left Then
        'reposition windows to the left of the Access canvas (can only occur with dialog windows)
        KeepFormOnCanvas = True
        pNewLeft = pAppRect.Left
        pNewWidth = pFormRect.Right - pFormRect.Left
    Else
        pNewLeft = pFormRect.Left - pAppRect.Left - (pHAppBuffer / 2)
        pNewWidth = pFormRect.Right - pFormRect.Left
    End If
    'Calculate the full form height
    tFormHeight = tFrm.Section(acDetail).Height
    'If continuous form will not fit on screen, try to get at least some minimum number of rows to show
    If tFrm.DefaultView = acDefViewContinuous Then
        tFormHeight = tFrm.Section(acDetail).Height * CLng(MinDetailSections)
    End If
    'Add height of horizontal scroll bar/navigation buttons
    If tFrm.NavigationButtons Or ((tFrm.ScrollBars And 1) = 1) Then
        tFormHeight = tFormHeight + tNavBarHeight
    End If
    On Error Resume Next
    tFormHeight = tFormHeight + tFrm.Section(acHeader).Height + tFrm.Section(acFooter).Height
    On Error GoTo 0
    'Translate form height from twips to pixels (truncate instead of rounding to prevent 1-pixel "growth" of forms)
    pFormHeight = Int(tFormHeight / TwipsPerInch * YPixelsPerInch) + pVBuffer

    'Fit form on screen vertically
    If pFormRect.Bottom >= pAppCanvas.Bottom + pAppRect.Top Or pFormCanvas.Bottom = 0 Then
        KeepFormOnCanvas = True
        If pFormHeight > pFormRect.Bottom - pFormRect.Top Then
            pNewHeight = pFormHeight
        Else
            pNewHeight = pFormRect.Bottom - pFormRect.Top
        End If
        pNewTop = pAppCanvas.Bottom - pNewHeight
    ElseIf pFormRect.Top < pAppRect.Top Then
        'reposition windows to the top of the Access canvas (can only occur with dialog windows)
        KeepFormOnCanvas = True
        pNewTop = pAppRect.Top
        pNewHeight = pFormRect.Bottom - pFormRect.Top
    Else
        pNewTop = pFormRect.Top - pAppRect.Top - (pVAppBuffer / 2)
        pNewHeight = pFormRect.Bottom - pFormRect.Top
    End If

    If pNewLeft < 0 Then pNewLeft = 0
    If pNewTop < 0 Then pNewTop = 0
    If pNewWidth > pAppCanvas.Right Then pNewWidth = pAppCanvas.Right
    If pNewHeight > pAppCanvas.Bottom Then pNewHeight = pAppCanvas.Bottom

    'Move the form only if we need to (prevents minor adjustments due to buffer allowances of forms that are already open)
    If KeepFormOnCanvas Then apiMoveWindow tFrm.hWnd, pNewLeft, pNewTop, pNewWidth, pNewHeight, True


End Function

'---------------------------------------------------------------------------------------
' Procedure : GetInnerAccessHwnd
' Author    : Mike Wolfe
' Date      : 11/26/2014
' Purpose   : Gets the window handle of the Access "canvas".
' Notes     - We don't use HWndAccessApp here because that's the window handle for the
'               full application; what we really want is the handle for the "inner container";
'               ie, the Access window minus the docked menus, docked toolbars, and status bar
'---------------------------------------------------------------------------------------
'
Function GetInnerAccessHwnd(Optional ByVal ChildHWnd As Long = 0) As Variant 'Variant used instead of Conditional Compile (Long needed for 32bit LongPtr needed for 64bit)
    
    GetInnerAccessHwnd = apiFindWindowEx(hWndAccessApp, ByVal 0&, "MDIClient", vbNullString)
    If GetInnerAccessHwnd <> 0 Then Exit Function

    On Error Resume Next
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveForm.hWnd
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveReport.hWnd
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveDatasheet.hWnd
    GetInnerAccessHwnd = apiGetParent(ChildHWnd)
End Function