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