home *** CD-ROM | disk | FTP | other *** search
/ Tools / WinSN5.0Ver.iso / PVb5.0 / VB / SAMPLES / VISDATA / DATABASE.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-01-14  |  16.5 KB  |  439 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
  3. Begin VB.Form frmDatabase 
  4.    Caption         =   "
  5.    ClientHeight    =   3540
  6.    ClientLeft      =   3405
  7.    ClientTop       =   2910
  8.    ClientWidth     =   3690
  9.    HelpContextID   =   2016146
  10.    Icon            =   "Database.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MDIChild        =   -1  'True
  14.    ScaleHeight     =   3540
  15.    ScaleWidth      =   3690
  16.    ShowInTaskbar   =   0   'False
  17.    Begin ComctlLib.TreeView tvDatabase 
  18.       Height          =   3465
  19.       Left            =   30
  20.       TabIndex        =   0
  21.       Top             =   30
  22.       Width           =   3600
  23.       _ExtentX        =   6350
  24.       _ExtentY        =   6112
  25.       Indentation     =   353
  26.       LineStyle       =   1
  27.       Style           =   7
  28.       ImageList       =   "imlTreePics"
  29.       Appearance      =   1
  30.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  31.          Name            =   "
  32.          Size            =   9
  33.          Charset         =   134
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       MouseIcon       =   "Database.frx":014A
  40.    End
  41.    Begin ComctlLib.ImageList imlTreePics 
  42.       Left            =   1215
  43.       Top             =   1560
  44.       _ExtentX        =   1005
  45.       _ExtentY        =   1005
  46.       BackColor       =   -2147483643
  47.       ImageWidth      =   16
  48.       ImageHeight     =   16
  49.       MaskColor       =   -2147483643
  50.       BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
  51.          NumListImages   =   6
  52.          BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  53.             Picture         =   "Database.frx":0166
  54.             Key             =   "Table"
  55.          EndProperty
  56.          BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  57.             Picture         =   "Database.frx":0480
  58.             Key             =   "Query"
  59.          EndProperty
  60.          BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  61.             Picture         =   "Database.frx":079A
  62.             Key             =   "Index"
  63.          EndProperty
  64.          BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  65.             Picture         =   "Database.frx":0AB4
  66.             Key             =   "Property"
  67.          EndProperty
  68.          BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  69.             Picture         =   "Database.frx":0DCE
  70.             Key             =   "Attached"
  71.          EndProperty
  72.          BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  73.             Picture         =   "Database.frx":10E8
  74.             Key             =   "Field"
  75.          EndProperty
  76.       EndProperty
  77.    End
  78. Attribute VB_Name = "frmDatabase"
  79. Attribute VB_GlobalNameSpace = False
  80. Attribute VB_Creatable = False
  81. Attribute VB_PredeclaredId = True
  82. Attribute VB_Exposed = False
  83. Option Explicit
  84. '>>>>>>>>>>>>>>>>>>>>>>>>
  85. Const FORMCAPTION = "
  86. '>>>>>>>>>>>>>>>>>>>>>>>>
  87. Dim mnodEditNode As Node
  88. Public Sub LoadDatabase()
  89.   On Error GoTo ADErr
  90.   Dim nodX As Node    ' 
  91.   Dim sTBLName As String
  92.   Dim sQRYName As String
  93.   Dim sPropName As String
  94.   Dim tblObj As DAO.TableDef
  95.   Dim qdfObj As DAO.QueryDef
  96.   Dim prpObj As DAO.Property
  97.   Dim bAttached As Boolean
  98.   Dim sTmp As String
  99.   Dim qryObj As QueryDef
  100.   Dim bTablesFound As Boolean
  101.   Dim bIncludeSysTables As Boolean
  102.   Me.MousePointer = vbHourglass
  103.   tvDatabase.Nodes.Clear
  104.   If gdbCurrentDB Is Nothing Then Exit Sub
  105.   Set nodX = tvDatabase.Nodes.Add(, , ">" & PROPERTIES_STR, PROPERTIES_STR, PROPERTY_STR)
  106.   nodX.Tag = PROPERTIES_STR
  107.   tvDatabase_NodeClick nodX
  108.   nodX.Expanded = False
  109.   bIncludeSysTables = frmMDI.mnuPAllowSys.Checked
  110.   For Each tblObj In gdbCurrentDB.TableDefs
  111.     If (tblObj.Attributes And dbSystemObject) = 0 Or bIncludeSysTables Then
  112.       sTBLName = tblObj.Name
  113.       bTablesFound = True
  114.       If (tblObj.Attributes And dbAttachedTable) = dbAttachedTable Then
  115.         bAttached = True
  116.       ElseIf (tblObj.Attributes And dbAttachedODBC) = dbAttachedODBC Then
  117.         bAttached = True
  118.       Else
  119.         bAttached = False
  120.       End If
  121.       
  122.       If bAttached Then
  123.         Set nodX = tvDatabase.Nodes.Add(, , "T" & tblObj.Name, tblObj.Name, ATTACHED_STR)
  124.       Else
  125.         Set nodX = tvDatabase.Nodes.Add(, , "T" & tblObj.Name, tblObj.Name, TABLE_STR)
  126.       End If
  127.       nodX.Tag = TABLE_STR
  128.       Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
  129.                                       sTBLName & ">Fields", _
  130.                                       FIELDS_STR, FIELD_STR)
  131.       nodX.Tag = FIELDS_STR
  132.       Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
  133.                                       sTBLName & ">Indexes", _
  134.                                       INDEXES_STR, INDEX_STR)
  135.       nodX.Tag = INDEXES_STR
  136.       Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
  137.                                       sTBLName & ">" & PROPERTIES_STR, _
  138.                                       PROPERTIES_STR, PROPERTY_STR)
  139.       nodX.Tag = PROPERTIES_STR
  140.       If bAttached Then
  141.         '
  142.         sTmp = gdbCurrentDB.TableDefs(sTBLName).Connect
  143.         sTmp = Left(sTmp, InStr(sTmp, ";") - 1)
  144.         If Len(sTmp) = 0 Then
  145.           sTmp = gsMSACCESS
  146.         End If
  147.         Set nodX = tvDatabase.Nodes.Add("T" & sTBLName, tvwChild, _
  148.                                         sTBLName & ">AttachType", _
  149.                                         sTmp & " Table", ATTACHED_STR)
  150.       End If
  151.     End If
  152.   Next
  153. querydefs
  154.   For Each qryObj In gdbCurrentDB.QueryDefs
  155.     sQRYName = qryObj.Name
  156.     Set nodX = tvDatabase.Nodes.Add(, , sQRYName, sQRYName, QUERY_STR)
  157.     nodX.Tag = QUERY_STR
  158.     Set nodX = tvDatabase.Nodes.Add(sQRYName, tvwChild, _
  159.                                    sQRYName & ">" & PROPERTIES_STR, _
  160.                                    PROPERTIES_STR, PROPERTY_STR)
  161.     nodX.Tag = PROPERTIES_STR
  162.   Next
  163.   If bTablesFound Then
  164.     frmMDI.mnuUQuery.Enabled = True
  165.     frmMDI.mnuDBPUNewQuery.Visible = True
  166.   Else
  167.     '
  168.     frmMDI.mnuUQuery.Enabled = False
  169.     frmMDI.mnuDBPUNewQuery.Visible = False
  170.   End If
  171.   Me.MousePointer = vbDefault
  172.   Exit Sub
  173. ADErr:
  174.   ShowError
  175. End Sub
  176. Private Sub Form_Load()
  177.   On Error Resume Next
  178.   Me.Caption = FORMCAPTION
  179.   Me.Height = Val(GetINIString("DBWindowHeight", "3870"))
  180.   Me.Width = Val(GetINIString("DBWindowWidth", "3835"))
  181.   Me.Top = Val(GetINIString("DBWindowTop", "0"))
  182.   Me.Left = Val(GetINIString("DBWindowLeft", "0"))
  183.   Err.Clear
  184. End Sub
  185. Private Sub Form_Resize()
  186.   On Error Resume Next
  187.   tvDatabase.Width = Me.ScaleWidth - (tvDatabase.Left * 2)
  188.   tvDatabase.Height = Me.ScaleHeight - (tvDatabase.Top * 2)
  189. End Sub
  190. Private Sub Form_Unload(Cancel As Integer)
  191.   CloseCurrentDB
  192.   If Me.WindowState = vbNormal Then
  193.     SaveSetting APP_CATEGORY, App.Title, "DBWindowTop", Me.Top
  194.     SaveSetting APP_CATEGORY, App.Title, "DBWindowLeft", Me.Left
  195.     SaveSetting APP_CATEGORY, App.Title, "DBWindowWidth", Me.Width
  196.     SaveSetting APP_CATEGORY, App.Title, "DBWindowHeight", Me.Height
  197.   End If
  198. End Sub
  199. Private Sub tvDatabase_AfterLabelEdit(Cancel As Integer, NewString As String)
  200.   On Error Resume Next
  201.   Select Case mnodEditNode.Tag
  202.     Case TABLE_STR
  203.       gdbCurrentDB.TableDefs(mnodEditNode.Text).Name = NewString
  204.     Case QUERY_STR
  205.       gdbCurrentDB.QueryDefs(mnodEditNode.Text).Name = NewString
  206.     Case INDEX_STR
  207.       gdbCurrentDB.TableDefs(mnodEditNode.Parent.Parent.Text).Indexes(mnodEditNode.Text).Name = NewString
  208.     Case FIELD_STR
  209.       gdbCurrentDB.TableDefs(mnodEditNode.Parent.Parent.Text).Fields(mnodEditNode.Text).Name = NewString
  210.   End Select
  211.   If Err Then
  212.     MsgBox Err.Description
  213.     '
  214.     Cancel = True
  215.   End If
  216.   If Not gnodDBNode Is Nothing Then
  217.     Set frmDatabase.tvDatabase.SelectedItem = gnodDBNode
  218.   End If
  219.   Err.Clear
  220. End Sub
  221. Private Sub tvDatabase_BeforeLabelEdit(Cancel As Integer)
  222.   Dim sTmp As String
  223.   sTmp = tvDatabase.SelectedItem.Tag
  224.   If sTmp = FIELDS_STR Or _
  225.      sTmp = INDEXES_STR Or _
  226.      sTmp = PROPERTIES_STR Or _
  227.      sTmp = PROPERTY_STR Then
  228.      
  229.     Cancel = True
  230.   Else
  231.     Set mnodEditNode = gnodDBNode
  232.   End If
  233. End Sub
  234. Private Sub tvDatabase_DblClick()
  235.   If gnodDBNode Is Nothing Then Exit Sub
  236.   gnodDBNode.Expanded = Not gnodDBNode.Expanded
  237.   Set gnodDBNode2 = gnodDBNode
  238.   If gnodDBNode2.Tag = PROPERTY_STR Then
  239.     frmMDI.mnuDBPUEdit_Click
  240.   Else
  241.     frmMDI.mnuDBPUOpen_Click
  242.   End If
  243. End Sub
  244. Private Sub tvDatabase_MouseUp(BUTTON As Integer, Shift As Integer, X As Single, Y As Single)
  245.   On Error Resume Next
  246.   If BUTTON = vbRightButton Then
  247.     '
  248.     Set gnodDBNode2 = tvDatabase.HitTest(X, Y)
  249.     If gnodDBNode2 Is Nothing Then
  250.       Set gnodDBNode2 = tvDatabase.HitTest(800, Y)
  251.     End If
  252.     If gnodDBNode2 Is Nothing Then
  253.       '
  254.       Set gnodDBNode2 = tvDatabase.HitTest(1200, Y)
  255.     End If
  256.     If gnodDBNode2 Is Nothing Then
  257.       frmMDI.mnuDBPUCopyStruct.Visible = False
  258.       frmMDI.mnuDBPURename.Visible = False
  259.       frmMDI.mnuDBPUDelete.Visible = False
  260.       frmMDI.mnuDBPUDesign.Visible = False
  261.       frmMDI.mnuDBPUOpen.Visible = False
  262.       frmMDI.mnuDBPUEdit.Visible = False
  263.       frmMDI.mnuDBPUBar1.Visible = False
  264.     Else
  265.       frmMDI.mnuDBPURename.Visible = True
  266.       frmMDI.mnuDBPUDelete.Visible = True
  267.       frmMDI.mnuDBPUBar1.Visible = True
  268.       If gnodDBNode2.Tag = TABLE_STR Then
  269.         frmMDI.mnuDBPUOpen.Visible = True
  270.         frmMDI.mnuDBPUEdit.Visible = False
  271.         frmMDI.mnuDBPUCopyStruct.Visible = True
  272.         frmMDI.mnuDBPUDesign.Visible = True
  273.         frmMDI.mnuDBPURename.Enabled = True
  274.         frmMDI.mnuDBPUDelete.Enabled = True
  275.       ElseIf gnodDBNode2.Tag = QUERY_STR Then
  276.         frmMDI.mnuDBPUOpen.Visible = True
  277.         frmMDI.mnuDBPUEdit.Visible = False
  278.         frmMDI.mnuDBPUCopyStruct.Visible = False
  279.         frmMDI.mnuDBPUDesign.Visible = True
  280.         frmMDI.mnuDBPURename.Enabled = True
  281.         frmMDI.mnuDBPUDelete.Enabled = True
  282.       ElseIf gnodDBNode2.Tag = INDEX_STR Then
  283.         frmMDI.mnuDBPUOpen.Visible = False
  284.         frmMDI.mnuDBPUEdit.Visible = False
  285.         frmMDI.mnuDBPUCopyStruct.Visible = False
  286.         frmMDI.mnuDBPUDesign.Visible = False
  287.         frmMDI.mnuDBPURename.Enabled = True
  288.         frmMDI.mnuDBPUDelete.Enabled = True
  289.       ElseIf gnodDBNode2.Tag = FIELD_STR Then
  290.         frmMDI.mnuDBPUOpen.Visible = False
  291.         frmMDI.mnuDBPUEdit.Visible = False
  292.         frmMDI.mnuDBPUCopyStruct.Visible = False
  293.         frmMDI.mnuDBPUDesign.Visible = False
  294.         frmMDI.mnuDBPURename.Enabled = True
  295.         frmMDI.mnuDBPUDelete.Enabled = True
  296.       ElseIf gnodDBNode2.Tag = PROPERTY_STR Then
  297.         frmMDI.mnuDBPUOpen.Visible = False
  298.         frmMDI.mnuDBPUEdit.Visible = True
  299.         frmMDI.mnuDBPUCopyStruct.Visible = False
  300.         frmMDI.mnuDBPUDesign.Visible = False
  301.         frmMDI.mnuDBPURename.Enabled = False
  302.         frmMDI.mnuDBPUDelete.Enabled = False
  303.       ElseIf gnodDBNode2.Tag = PROPERTIES_STR Then
  304.         frmMDI.mnuDBPUOpen.Visible = False
  305.         frmMDI.mnuDBPUEdit.Visible = False
  306.         frmMDI.mnuDBPUCopyStruct.Visible = False
  307.         frmMDI.mnuDBPUDesign.Visible = False
  308.         frmMDI.mnuDBPURename.Enabled = False
  309.         frmMDI.mnuDBPUDelete.Enabled = False
  310.       Else
  311.         frmMDI.mnuDBPUOpen.Visible = False
  312.         frmMDI.mnuDBPUCopyStruct.Visible = False
  313.         frmMDI.mnuDBPUDesign.Visible = False
  314.         frmMDI.mnuDBPURename.Enabled = False
  315.         frmMDI.mnuDBPUDelete.Enabled = False
  316.       End If
  317.     End If
  318.     PopupMenu frmMDI.mnuDBPopUp
  319.   End If
  320. End Sub
  321. Private Sub tvDatabase_NodeClick(ByVal Node As Node)
  322.   On Error GoTo tvDatabase_NodeClickErr
  323.   Dim nod As Node
  324.   Dim nodX As Node
  325.   Dim fldObj As DAO.Field
  326.   Dim idxObj As DAO.Index
  327.   Dim prpObj As DAO.Property
  328.   Dim colTmp As Object
  329.   Dim vTmp As Variant
  330.   Set gnodDBNode = Node
  331.   Select Case Node.Tag
  332.     Case FIELDS_STR
  333.       If Node.Children > 0 Then Exit Sub
  334.       '
  335.       For Each fldObj In gdbCurrentDB.TableDefs(Node.Parent.Text).Fields
  336.         Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  337.                                        tvwChild, _
  338.                                        Node.Parent.Key & ">" & FIELDS_STR & ">" & fldObj.Name, _
  339.                                        fldObj.Name, FIELD_STR)
  340.         nodX.Tag = FIELD_STR
  341.       Next
  342.       Node.Expanded = True
  343.       
  344.     Case FIELD_STR
  345.       If Node.Children > 0 Then Exit Sub
  346.       For Each prpObj In gdbCurrentDB.TableDefs(Node.Parent.Parent.Text).Fields(Node.Text).Properties
  347.         'Value 
  348.         '
  349.  tabledef 
  350.  field 
  351.         If prpObj.Name <> "Value" Then
  352.           vTmp = GetPropertyValue(prpObj)
  353.           Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  354.                                          tvwChild, _
  355.                                          Node.Parent.Key & Node.Key & ">" & prpObj.Name, _
  356.                                          prpObj.Name & "=" & vTmp, PROPERTY_STR)
  357.           nodX.Tag = PROPERTY_STR
  358.         End If
  359.       Next
  360.       Node.Expanded = True
  361.       Set tvDatabase.SelectedItem = Node
  362.         
  363.     Case INDEXES_STR
  364.       If Node.Children > 0 Then Exit Sub
  365.       '
  366.       For Each idxObj In gdbCurrentDB.TableDefs(Node.Parent.Text).Indexes
  367.         Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  368.                                        tvwChild, _
  369.                                        Node.Parent.Key & ">" & INDEXES_STR & ">" & idxObj.Name, _
  370.                                        idxObj.Name, INDEX_STR)
  371.         nodX.Tag = INDEX_STR
  372.       Next
  373.       Node.Expanded = True
  374.       
  375.     Case INDEX_STR
  376.       If Node.Children > 0 Then Exit Sub
  377.       For Each prpObj In gdbCurrentDB.TableDefs(Node.Parent.Parent.Text).Indexes(Node.Text).Properties
  378.         vTmp = GetPropertyValue(prpObj)
  379.         Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  380.                                        tvwChild, _
  381.                                        Node.Parent.Key & Node.Key & ">" & prpObj.Name, _
  382.                                        prpObj.Name & "=" & vTmp, PROPERTY_STR)
  383.         nodX.Tag = PROPERTY_STR
  384.       Next
  385.       Node.Expanded = True
  386.       Set tvDatabase.SelectedItem = Node
  387.     Case PROPERTIES_STR
  388.       If Node.Children > 0 Then Exit Sub
  389.       '
  390.       If Node.Parent Is Nothing Then
  391.         Set colTmp = gdbCurrentDB.Properties
  392.       Else
  393.         Select Case Node.Parent.Tag
  394.           Case TABLE_STR
  395.             Set colTmp = gdbCurrentDB.TableDefs(Node.Parent.Text).Properties
  396.           Case QUERY_STR
  397.             Set colTmp = gdbCurrentDB.QueryDefs(Node.Parent.Text).Properties
  398.           Case PROPERTY_STR
  399.             Exit Sub  '
  400.         End Select
  401.       End If
  402.       For Each prpObj In colTmp
  403.         vTmp = GetPropertyValue(prpObj)
  404.         If VarType(vTmp) = vbString Then
  405.           '
  406.           vTmp = Left$(vTmp, 50)
  407.         End If
  408.         If Node.Parent Is Nothing Then
  409.           Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  410.                                          tvwChild, _
  411.                                          Node.Key & ">" & prpObj.Name, _
  412.                                          prpObj.Name & "=" & vTmp, PROPERTY_STR)
  413.         Else
  414.           Set nodX = tvDatabase.Nodes.Add(Node.Key, _
  415.                                          tvwChild, _
  416.                                          Node.Parent.Key & ">" & prpObj.Name, _
  417.                                          prpObj.Name & "=" & vTmp, PROPERTY_STR)
  418.         End If
  419.         nodX.Tag = PROPERTY_STR
  420.       Next
  421.       Node.Expanded = True
  422.   End Select
  423.   Exit Sub
  424. tvDatabase_NodeClickErr:
  425.   If Err = 35602 Then Resume Next
  426.   ShowError
  427. End Sub
  428. Function GetPropertyValue(prpObj As DAO.Property) As Variant
  429.   On Error Resume Next
  430.   Dim vTmp As Variant
  431.   vTmp = prpObj.Value
  432.   If Err Then
  433.     Err.Clear
  434.     GetPropertyValue = "N/A"
  435.   Else
  436.     GetPropertyValue = vTmp
  437.   End If
  438. End Function
  439.