Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Database Window"
'>>>>>>>>>>>>>>>>>>>>>>>>

Dim mnodEditNode As Node

'for standalone use, this method must be called
'from the operation that loads this form
Public Sub LoadDatabase()
  On Error GoTo ADErr

  Dim nodX As Node    ' Create variable.
  Dim sTBLName As String
  Dim sQRYName As String
  Dim sPropName As String
  Dim tblObj As DAO.TableDef
  Dim qdfObj As DAO.QueryDef
  Dim prpObj As DAO.Property
  Dim bAttached As Boolean
  Dim sTmp As String
  Dim qryObj As QueryDef
  Dim bTablesFound As Boolean
  Dim bIncludeSysTables As Boolean

  Me.MousePointer = vbHourglass
    
  tvDatabase.Nodes.Clear
    
  If gdbCurrentDB Is Nothing Then Exit Sub
  
  'add the properties node
  Set nodX = tvDatabase.Nodes.Add(, , ">" & PROPERTIES_STR, PROPERTIES_STR, PROPERTY_STR)
  nodX.Tag = PROPERTIES_STR
  tvDatabase_NodeClick nodX
  nodX.Expanded = False
  
  bIncludeSysTables = frmMDI.mnuPAllowSys.Checked
  
  'add the tables
  For Each tblObj In gdbCurrentDB.TableDefs
    If (tblObj.Attributes And dbSystemObject) = 0 Or bIncludeSysTables Then
      sTBLName = tblObj.Name
      bTablesFound = True
      If (tblObj.Attributes And dbAttachedTable) = dbAttachedTable Then
        bAttached = True
      ElseIf (tblObj.Attributes And dbAttachedODBC) = dbAttachedODBC Then
        bAttached = True
      Else
        bAttached = False
      End If
      
      If bAttached Then
        Set nodX = tvDatabase.Nodes.Add(, , "T" & tblObj.Name, tblObj.Name, ATTACHED_STR)
      Else
        Set nodX = tvDatabase.Nodes.Add(, , "T" & tblObj.Name, tblObj.Name, TABLE_STR)
      End If
      nodX.Tag = TABLE_STR
      Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
                                      sTBLName & ">Fields", _
                                      FIELDS_STR, FIELD_STR)
      nodX.Tag = FIELDS_STR
      Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
                                      sTBLName & ">Indexes", _
                                      INDEXES_STR, INDEX_STR)
      nodX.Tag = INDEXES_STR
      Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
                                      sTBLName & ">" & PROPERTIES_STR, _
                                      PROPERTIES_STR, PROPERTY_STR)
      nodX.Tag = PROPERTIES_STR
      If bAttached Then
        'add a couple of node to show attachment details
        sTmp = gdbCurrentDB.TableDefs(sTBLName).Connect
        sTmp = Left(sTmp, InStr(sTmp, ";") - 1)
        If Len(sTmp) = 0 Then
          sTmp = gsMSACCESS
        End If
        Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
                                        sTBLName & ">AttachType", _
                                        sTmp & " Table", ATTACHED_STR)
      End If
    End If
  Next


  'add the querydefs
  For Each qryObj In gdbCurrentDB.QueryDefs
    sQRYName = qryObj.Name
    Set nodX = tvDatabase.Nodes.Add(, , sQRYName, sQRYName, QUERY_STR)
    nodX.Tag = QUERY_STR
    Set nodX = tvDatabase.Nodes.Add(sQRYName, tvwChild, _
                                   sQRYName & ">" & PROPERTIES_STR, _
                                   PROPERTIES_STR, PROPERTY_STR)
    nodX.Tag = PROPERTIES_STR
  Next

  'enable menus that depend on tables being present
  If bTablesFound Then
    frmMDI.mnuUQuery.Enabled = True
    frmMDI.mnuDBPUNewQuery.Visible = True
  Else
    'no tables available
    frmMDI.mnuUQuery.Enabled = False
    frmMDI.mnuDBPUNewQuery.Visible = False
  End If

  Me.MousePointer = vbDefault
  Exit Sub
  
ADErr:
  ShowError
End Sub


Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016146
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmDatabase_Auto_Init
  On Error Resume Next

  Me.Caption = FORMCAPTION

  Me.Height = Val(GetRegistryString("DBWindowHeight", "3870"))
  Me.Width = Val(GetRegistryString("DBWindowWidth", "3835"))
  Me.Top = Val(GetRegistryString("DBWindowTop", "0"))
  Me.Left = Val(GetRegistryString("DBWindowLeft", "0"))

  Err.Clear
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  tvDatabase.Width = Me.ScaleWidth - (tvDatabase.Left * 2)
  tvDatabase.Height = Me.ScaleHeight - (tvDatabase.Top * 2)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  CloseCurrentDB
  If Me.WindowState = vbNormal Then
    SaveSetting APP_CATEGORY, APPNAME, "DBWindowTop", Me.Top
    SaveSetting APP_CATEGORY, APPNAME, "DBWindowLeft", Me.Left
    SaveSetting APP_CATEGORY, APPNAME, "DBWindowWidth", Me.Width
    SaveSetting APP_CATEGORY, APPNAME, "DBWindowHeight", Me.Height
  End If
End Sub

Private Sub tvDatabase_AfterLabelEdit(Cancel As Integer, NewString As String)
  On Error Resume Next
  
  'change the name in the database
  Select Case mnodEditNode.Tag
    Case TABLE_STR
      gdbCurrentDB.TableDefs(mnodEditNode.Text).Name = NewString
    Case QUERY_STR
      gdbCurrentDB.QueryDefs(mnodEditNode.Text).Name = NewString
    Case INDEX_STR
      gdbCurrentDB.TableDefs(mnodEditNode.Parent.Parent.Text).Indexes(mnodEditNode.Text).Name = NewString
    Case FIELD_STR
      gdbCurrentDB.TableDefs(mnodEditNode.Parent.Parent.Text).Fields(mnodEditNode.Text).Name = NewString
  End Select
  
  If Err Then
    MsgBox Err.Description
    'errored out so set it back
    Cancel = True
  End If
  
  'set it back
  If Not gnodDBNode Is Nothing Then
    Set frmDatabase.tvDatabase.SelectedItem = gnodDBNode
  End If

  Err.Clear
End Sub

Private Sub tvDatabase_BeforeLabelEdit(Cancel As Integer)
  Dim sTmp As String
  
  sTmp = tvDatabase.SelectedItem.Tag
  
  If sTmp = FIELDS_STR Or _
     sTmp = INDEXES_STR Or _
     sTmp = PROPERTIES_STR Or _
     sTmp = PROPERTY_STR Then
     
    Cancel = True
  Else
    Set mnodEditNode = gnodDBNode
  End If
End Sub

Private Sub tvDatabase_DblClick()
  If gnodDBNode Is Nothing Then Exit Sub
  
  'reverse the automatic expansion change
  'from the mouse click
  gnodDBNode.Expanded = Not gnodDBNode.Expanded
  
  Set gnodDBNode2 = gnodDBNode
  If gnodDBNode2.Tag = PROPERTY_STR Then
    frmMDI.mnuDBPUEdit_Click
  Else
    frmMDI.mnuDBPUOpen_Click
  End If
  
End Sub

Private Sub tvDatabase_MouseUp(BUTTON As Integer, Shift As Integer, x As Single, y As Single)
  On Error Resume Next
  If BUTTON = vbRightButton Then
    'try to get the node that they right clicked
    Set gnodDBNode2 = tvDatabase.HitTest(x, y)
    If gnodDBNode2 Is Nothing Then
      Set gnodDBNode2 = tvDatabase.HitTest(800, y)
    End If
    If gnodDBNode2 Is Nothing Then
      'try a little farther over
      Set gnodDBNode2 = tvDatabase.HitTest(1200, y)
    End If
    If gnodDBNode2 Is Nothing Then
      frmMDI.mnuDBPUCopyStruct.Visible = False
      frmMDI.mnuDBPURename.Visible = False
      frmMDI.mnuDBPUDelete.Visible = False
      frmMDI.mnuDBPUDesign.Visible = False
      frmMDI.mnuDBPUOpen.Visible = False
      frmMDI.mnuDBPUEdit.Visible = False
      frmMDI.mnuDBPUBar1.Visible = False
    Else
      frmMDI.mnuDBPURename.Visible = True
      frmMDI.mnuDBPUDelete.Visible = True
      frmMDI.mnuDBPUBar1.Visible = True
      If gnodDBNode2.Tag = TABLE_STR Then
        frmMDI.mnuDBPUOpen.Visible = True
        frmMDI.mnuDBPUEdit.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = True
        frmMDI.mnuDBPUDesign.Visible = True
        frmMDI.mnuDBPURename.Enabled = True
        frmMDI.mnuDBPUDelete.Enabled = True
      ElseIf gnodDBNode2.Tag = QUERY_STR Then
        frmMDI.mnuDBPUOpen.Visible = True
        frmMDI.mnuDBPUEdit.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = True
        frmMDI.mnuDBPURename.Enabled = True
        frmMDI.mnuDBPUDelete.Enabled = True
      ElseIf gnodDBNode2.Tag = INDEX_STR Then
        frmMDI.mnuDBPUOpen.Visible = False
        frmMDI.mnuDBPUEdit.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = False
        frmMDI.mnuDBPURename.Enabled = True
        frmMDI.mnuDBPUDelete.Enabled = True
      ElseIf gnodDBNode2.Tag = FIELD_STR Then
        frmMDI.mnuDBPUOpen.Visible = False
        frmMDI.mnuDBPUEdit.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = False
        frmMDI.mnuDBPURename.Enabled = True
        frmMDI.mnuDBPUDelete.Enabled = True
      ElseIf gnodDBNode2.Tag = PROPERTY_STR Then
        frmMDI.mnuDBPUOpen.Visible = False
        frmMDI.mnuDBPUEdit.Visible = True
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = False
        frmMDI.mnuDBPURename.Enabled = False
        frmMDI.mnuDBPUDelete.Enabled = False
      ElseIf gnodDBNode2.Tag = PROPERTIES_STR Then
        frmMDI.mnuDBPUOpen.Visible = False
        frmMDI.mnuDBPUEdit.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = False
        frmMDI.mnuDBPURename.Enabled = False
        frmMDI.mnuDBPUDelete.Enabled = False
      Else
        frmMDI.mnuDBPUOpen.Visible = False
        frmMDI.mnuDBPUCopyStruct.Visible = False
        frmMDI.mnuDBPUDesign.Visible = False
        frmMDI.mnuDBPURename.Enabled = False
        frmMDI.mnuDBPUDelete.Enabled = False
      End If
    End If
  
    PopupMenu frmMDI.mnuDBPopUp
  End If
End Sub

Private Sub tvDatabase_NodeClick(ByVal Node As Node)
  On Error GoTo tvDatabase_NodeClickErr
  
  Dim nod As Node
  Dim nodX As Node
  Dim fldObj As DAO.Field
  Dim idxObj As DAO.Index
  Dim prpObj As DAO.Property
  Dim colTmp As Object
  Dim vTmp As Variant

  Set gnodDBNode = Node

  Select Case Node.Tag
    Case FIELDS_STR
      If Node.Children > 0 Then Exit Sub
      'add the fields
      For Each fldObj In gdbCurrentDB.TableDefs(Node.Parent.Text).Fields
        Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                       tvwChild, _
                                       Node.Parent.Key & ">" & FIELDS_STR & ">" & fldObj.Name, _
                                       fldObj.Name, FIELD_STR)
        nodX.Tag = FIELD_STR
      Next
      Node.Expanded = True
      
    Case FIELD_STR
      If Node.Children > 0 Then Exit Sub
      For Each prpObj In gdbCurrentDB.TableDefs(Node.Parent.Parent.Text).Fields(Node.Text).Properties
        'special case the Value property because it
        'is not available from the field object on a tabledef
        If prpObj.Name <> "Value" Then
          vTmp = GetPropertyValue(prpObj)
          Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                         tvwChild, _
                                         Node.Parent.Key & Node.Key & ">" & prpObj.Name, _
                                         prpObj.Name & "=" & vTmp, PROPERTY_STR)
          nodX.Tag = PROPERTY_STR
        End If
      Next
      Node.Expanded = True
      Set tvDatabase.SelectedItem = Node
        
    Case INDEXES_STR
      If Node.Children > 0 Then Exit Sub
      'add the indexes
      For Each idxObj In gdbCurrentDB.TableDefs(Node.Parent.Text).Indexes
        Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                       tvwChild, _
                                       Node.Parent.Key & ">" & INDEXES_STR & ">" & idxObj.Name, _
                                       idxObj.Name, INDEX_STR)
        nodX.Tag = INDEX_STR
      Next
      Node.Expanded = True
      
    Case INDEX_STR
      If Node.Children > 0 Then Exit Sub
      For Each prpObj In gdbCurrentDB.TableDefs(Node.Parent.Parent.Text).Indexes(Node.Text).Properties
        vTmp = GetPropertyValue(prpObj)
        Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                       tvwChild, _
                                       Node.Parent.Key & Node.Key & ">" & prpObj.Name, _
                                       prpObj.Name & "=" & vTmp, PROPERTY_STR)
        nodX.Tag = PROPERTY_STR
      Next
      Node.Expanded = True
      Set tvDatabase.SelectedItem = Node
    
    Case PROPERTIES_STR
      If Node.Children > 0 Then Exit Sub
      'add the properties
      If Node.Parent Is Nothing Then
        Set colTmp = gdbCurrentDB.Properties
      Else
        Select Case Node.Parent.Tag
          Case TABLE_STR
            Set colTmp = gdbCurrentDB.TableDefs(Node.Parent.Text).Properties
          Case QUERY_STR
            Set colTmp = gdbCurrentDB.QueryDefs(Node.Parent.Text).Properties
          Case PROPERTY_STR
            Exit Sub  'undone: need to get parent object
        End Select
      End If
      For Each prpObj In colTmp
        vTmp = GetPropertyValue(prpObj)
        If VarType(vTmp) = vbString Then
          'truncate it to 50 chars
          vTmp = Left$(vTmp, 50)
        End If
        If Node.Parent Is Nothing Then
          Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                         tvwChild, _
                                         Node.Key & ">" & prpObj.Name, _
                                         prpObj.Name & "=" & vTmp, PROPERTY_STR)
        Else
          Set nodX = tvDatabase.Nodes.Add(Node.Key, _
                                         tvwChild, _
                                         Node.Parent.Key & ">" & prpObj.Name, _
                                         prpObj.Name & "=" & vTmp, PROPERTY_STR)
        End If
        nodX.Tag = PROPERTY_STR
      Next
      Node.Expanded = True
    
  End Select
  
  Exit Sub
tvDatabase_NodeClickErr:
  If Err = 35602 Then Resume Next
  ShowError
End Sub

Function GetPropertyValue(prpObj As DAO.Property) As Variant
  On Error Resume Next
  
  Dim vTmp As Variant
  
  vTmp = prpObj.Value
  If Err Then
    Err.Clear
    GetPropertyValue = "N/A"
  Else
    GetPropertyValue = vTmp
  End If
  
End Function


'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "Database Window"
Property Get FORMCAPTION As String
    FORMCAPTION = "Database Window"
End Property


Private Sub frmDatabase_Auto_Init()
'This routine initializes all User Interface control properties on frmDatabase.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    Me.Caption = "Database"
End Sub