[AccessD] Instantiate Forms as Objects

Here you go, it's a bit rough as its from a project that's been shelved
for a while so it never really got finished... Have fun

Mark


Option Compare Database
Option Explicit

'
' DESCRIPTION:
'   Opens a form as a form variable allowing more than one instance of a
form
'   to be opened ata time.
'
' COMMENTS:
'   When working with multiple instances of forms, avoid using criteria
in sub
'   forms which references prooperties in the parent form (such as using
a ref-
'   erence to the parent forms key in the subforms datasource).
'
'   The form variables name is always that of the form itself so when
referring
'   to the form in code avoid using the form name (e.g. me.name)
'
'-----------------------------------------------------------------------
-------

    Global frmInst(1 To 12) As Form 'there is a bug with Jet so
sometimes only about 18 new instances can be opened.
                                    'This bug relates to max number of
open databases / tables and has been apparently
                                    'sorted out in later releases of
Jet. See error handler....
                                    '


'----------------------------------------------------------
Function closeInstAll()
'closes all open notes, topics and categories
    Dim i As Integer
    
    For i = 1 To UBound(frmInst)
        Set frmInst(i) = Nothing
    Next
End Function

Function minimizeInstAll()
'minimizes all open notes, topics and categories
On Error Resume Next
    Echo False
        Dim i As Integer
        
        For i = 1 To UBound(frmInst)
            frmInst(i).SetFocus
            DoCmd.Minimize
        Next
        Forms("frm_treeMenu").SetFocus
        DoCmd.Restore
    Echo True
End Function

Function controlInst(c As String)
On Error Resume Next

    Dim i As Integer
    Dim X As Integer
    Dim hw As Long
    Dim hwX As Variant
    Dim frm As Form

    For i = 0 To Forms("frm_TreeMenu").formsList.ListCount
        If Forms("frm_TreeMenu").formsList.Selected(i) = True Then
            hw = Forms("frm_TreeMenu").formsList.ItemData(i)
            For X = 1 To UBound(frmInst)
                hwX = frmInst(X).hwnd
                If hwX = hw Then
                    frmInst(X).SetFocus 'fires a form activate event
                    Select Case c
                        Case "R" 'Restore
                            DoCmd.Restore
                        Case "M" 'Minimize
                            DoCmd.Minimize
                        Case "C" 'Close
                            Set frmInst(X) = Nothing
                    End Select
                End If
            Next
        End If
    Next
End Function

Function minimizeInst()
'minimizes the first selected instance of a form in the open forms list
'On Error Resume Next
    controlInst "M"
End Function

Function restoreInst()
'restores the first selected instance of a form in the open forms list
'On Error Resume Next
    controlInst "R"
End Function

Function closeInst()
'Closes selected items on the open forms list
'On Error Resume Next
    controlInst "C"
End Function

Function getNextFormVar() As Integer
'returns a reference to the next free form variable
On Error GoTo errbit

    Dim i As Integer
    Dim X As Long

    For i = 1 To UBound(frmInst)
        X = frmInst(i).hwnd
tryAgain:
    Next

wayout:
    getNextFormVar = 0
    Exit Function

errbit:
    If Err.Number = 91 Or Err.Number = 2467 Then
        getNextFormVar = i
    Else
        Resume tryAgain
    End If
    
End Function

'=======================================================================
======================
'Opens new instance of form f using one of the "frm*" globals.
'   f  = form name
'   wc = where clause
'   p  = parent nodes index

Sub openInstance(F As String, wc As String, ni As Integer, addMode As
Boolean, Optional parentKey As Integer = 0)
On Error GoTo errbit

    Dim nextFormVar As Integer
    Dim frm As Form
    Dim strCap As String
    Dim ctrl As Control
    
    If Not IsLoaded("frm_TreeMenu") Then
        DoCmd.OpenForm ("frm_TreeMenu")
    End If
        
    If addMode Then
        strCap = StrConv(Mid(F, 5), vbProperCase) & ": (New Record)"
    Else
        strCap = StrConv(Mid(F, 5), vbProperCase) & ": "
    End If
    
    'check if the record is already open... if so then simply set focus
to that record.
    For Each frm In Forms
        If frm.name = F Then
            If frm.Filter = wc Then
                frm.SetFocus
                Exit Sub
            End If
        End If
    Next
    
    nextFormVar = getNextFormVar
  
noMoreForms:
    If nextFormVar = 0 Then
        MsgBox "The system has run out of free form variables. Please
close" & Chr(13) & "any unused forms and try again.", vbCritical,
"Error"
        Exit Sub
    End If
    
    Select Case F
        Case "frm_Category"
            'form open event fired next subform then main then main
activate then main current
            Set frmInst(nextFormVar) = New Form_frm_Category
        Case "frm_Topic"
            Set frmInst(nextFormVar) = New Form_frm_Topic
        Case "frm_Note"
            Set frmInst(nextFormVar) = New Form_frm_note
    End Select

    With frmInst(nextFormVar)
        If addMode Then
            .AllowAdditions = True
            .DataEntry = True
            .Caption = strCap
            .newRcd = True
            If parentKey > 0 Then
                .parentKey = parentKey
            End If
        Else
            .Filter = wc
            'next line fires a form current in the subform then main
activate and main current
            .FilterOn = True
        End If
        .nodeIndex = ni
        'next line triggers activate
        .SetFocus
        .formStart
        For Each ctrl In .Controls
            If ctrl.Tag = "X" Then
                ctrl.Visible = True
            End If
        Next
    
    End With

    frmInst(nextFormVar).SetFocus
    DoCmd.Restore
    listForms

wayout:
    strCap = ""
    nextFormVar = 0
    Exit Sub
    
errbit:
    DoCmd.Echo True
    If Err.Number = 2956 Or Err.Number = 3048 Or Err.Number = 2950 Then
        nextFormVar = 0
        Resume noMoreForms
    Else
        MsgBox Err.Description
        Resume wayout
    End If
    errLog "multiInstance", Err.Number, Err.Description

End Sub