Programming Languages Suite/ProgramD2.iso/Visual Database/Visual BASIC 5.0 (Ent. Edition)/Vb5ent Extractor.EXE/VB/SAMPLES/COMPTOOL/DATATREE/TREEVIEW.FRM

Visual Basic Form | 1996-09-16 | 16.9 KB | 465 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.0#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.0#0"; "COMCTL32.OCX"
Begin VB.Form frmTreeview
   Caption         =   "Database-bound TreeView"
   ClientHeight    =   5655
   ClientLeft      =   735
   ClientTop       =   2640
   ClientWidth     =   9660
   LinkTopic       =   "Form1"
   ScaleHeight     =   5655
   ScaleWidth      =   9660
   Begin VB.ComboBox Combo1
      Height          =   315
      Left            =   6960
      TabIndex        =   4
      Text            =   "Combo1"
      Top             =   0
      Width           =   2415
   End
   Begin VB.CommandButton cmdLoad
      Caption         =   "Load"
      Height          =   270
      Left            =   2190
      TabIndex        =   1
      Top             =   4935
      Visible         =   0   'False
      Width           =   1050
   End
   Begin ComctlLib.TabStrip TabStrip1
      Height          =   30
      Left            =   1305
      TabIndex        =   6
      Top             =   5145
      Width           =   30
      _ExtentX        =   53
      _ExtentY        =   53
      BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7}
         NumTabs         =   1
         BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7}
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin ComctlLib.StatusBar sbrDB
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   5
      Top             =   5400
      Width           =   9660
      _ExtentX        =   17039
      _ExtentY        =   450
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
         NumPanels       =   1
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
         EndProperty
      EndProperty
   End
   Begin ComctlLib.ProgressBar prgLoad
      Height          =   210
      Left            =   255
      TabIndex        =   3
      Top             =   375
      Visible         =   0   'False
      Width           =   9090
      _ExtentX        =   16034
      _ExtentY        =   370
   End
   Begin ComctlLib.ListView lvwDB
      Height          =   4215
      Left            =   3480
      TabIndex        =   2
      Top             =   615
      Width           =   5880
      _ExtentX        =   10372
      _ExtentY        =   7435
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      Icons           =   "imlIcons"
      SmallIcons      =   "imlSmallIcons"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      NumItems        =   0
   End
   Begin MSComDlg.CommonDialog dlgDialog
      Left            =   1605
      Top             =   4830
      _ExtentX        =   847
      _ExtentY        =   847
      FilterIndex     =   474
      FontSize        =   8.01821e-38
   End
   Begin ComctlLib.TreeView tvwDB
      Height          =   4215
      Left            =   255
      TabIndex        =   0
      Top             =   615
      Width           =   3120
      _ExtentX        =   5503
      _ExtentY        =   7435
      LineStyle       =   1
      PathSeparator   =   "\"
      Style           =   7
      ImageList       =   "imlSmallIcons"
   End
   Begin VB.Label lblI
      Caption         =   "To load the Biblio.mdb, on the File menu, click Load."
      Height          =   255
      Left            =   2520
      TabIndex        =   7
      Top             =   0
      Width           =   4335
   End
   Begin ComctlLib.ImageList imlIcons
      Left            =   645
      Top             =   4800
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
         NumListImages   =   1
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":0000
            Key             =   "book"
         EndProperty
      EndProperty
   End
   Begin ComctlLib.ImageList imlSmallIcons
      Left            =   45
      Top             =   4815
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   13
      ImageHeight     =   13
      MaskColor       =   12632256
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
         NumListImages   =   6
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":031A
            Key             =   "closed"
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":048C
            Key             =   "cylinder"
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":05FE
            Key             =   "leaf"
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":0770
            Key             =   "open"
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":08E2
            Key             =   "smlBook"
         EndProperty
         BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "treeview.frx":0B94
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuLoad
         Caption         =   "Load"
      End
      Begin VB.Menu mnuExit
         Caption         =   "Exit"
      End
   End
Attribute VB_Name = "frmTreeview"
Attribute VB_Base = "0{29AE1516-DB43-11CF-AE2E-00AA006EC21C}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_TemplateDerived = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private mDbBiblio As Database ' Module-level Database variable.
Private mNode As Node ' Module-level variable for Nodes
Private mWksBiblio As Workspace ' Module-level WorkSpace variable.
Private mItem As ListItem ' Module-level ListItem variable.
Private EventFlag As Integer ' To signal which event has occurred.
Private mCurrentIndex As Integer ' Flag to assure this node wasn't already clicked.
Private mStatusBarStyle As Integer ' Switches Statusbar style
Const PUBLISHER = 1 ' For EventFlag, Signals Publisher colmunheader objects.
Const TITLE = 2 ' EventFlag, signals Title in ListView
Private Sub cmdLoad_Click()
    ' Declare variables for the Data Access objects.
    Dim rsPublishers As Recordset
    Dim rsTitles As Recordset
    Dim intIndex ' Variable for index of current node.
    ' Set the Database to the BIBLIO.MDB database.
    ' Set the recordset to the "Authors" table.
    Set rsPublishers = mDbBiblio. _
    OpenRecordset("Publishers", dbOpenDynaset)
    ' Show the Progressbar.
    prgLoad.Visible = True
    ' Set StatusBar style to simple
    sbrDB.Style = sbrSimple
    ' While the record is not the last record, add a ListItem object.
    ' Use the Name field for the ListItem object's text.
    Do Until rsPublishers.EOF

        prgLoad.Value = rsPublishers.PercentPosition
        ' Add a Node to the TreeView, and set its properties.
        Set mNode = tvwDB.Nodes.Add(1, tvwChild, rsPublishers!PubID & " ID", CStr(rsPublishers!Name), "closed")
        mNode.Tag = "Publisher" ' Identifies the table.
        ' Set the variable intIndex to the Index property of the
        ' newly created Node. Use this variable to add child
        ' Node objects to the present Node.
        intIndex = mNode.index
        ' While on this record, create a recordset
        ' using a query that finds only titles that have
        ' the same PubID. For each record in the
        ' resulting recordset, add a Node object to the
        ' TreeView control, and set the new Node object
        ' properties with the record's Title, ISBN and
        ' Author fields.
        Set rsTitles = mDbBiblio.OpenRecordset _
        ("select * from Titles Where PubID = " & rsPublishers!PubID)
        Do Until rsTitles.EOF
            Set mNode = tvwDB.Nodes.Add(intIndex, tvwChild)
            mNode.Text = rsTitles!TITLE ' Text.
            mNode.Key = rsTitles!ISBN   ' Unique ID.
            mNode.Tag = "Authors"       ' Table name.
            mNode.Image = "smlBook"     ' Image from ImageList.
            rsTitles.MoveNext ' Move to next record in rsTitles.
        Loop
        rsPublishers.MoveNext   ' Move to next Publishers record.
    Loop
    ' Hide Progressbar
    prgLoad.Visible = False
    ' Set Statusbar style to normal.
    sbrDB.Style = sbrNormal
    ' Sort the Publishers nodes.
    tvwDB.Nodes(1).Sorted = True
    ' Expand top node.
    tvwDB.Nodes(1).Expanded = True
    ' configure statusbar.
    PublishersStatusBar
End Sub
Private Sub PublishersStatusBar()
    Dim rs As Recordset
    Set rs = mDbBiblio.OpenRecordset("Publishers", dbOpenTable)
    sbrDB.Panels(1).Text = "name: " & rs.Name
    sbrDB.Panels(2).Text = "Date Created: " & _
    CStr(rs.DateCreated)
    sbrDB.Panels(3).Text = "Last Updated " & _
    rs.LastUpdated
    sbrDB.Panels(4).Text = "Lockedits: " & rs.LockEdits
End Sub
Private Sub Combo1_Click()
    lvwDB.View = Combo1.ListIndex
End Sub
Private Sub Form_Load()
    ' Configure Combo1 control.
    With Combo1
        .AddItem "Icon View"      '0
        .AddItem "SmallIcon View" '1
        .AddItem "List View"         '2
        .AddItem "Report View"       '3
        .ListIndex = 3
    End With
    ' Configure ListView control.
    lvwDB.View = lvwReport

    ' Configure ProgressBar.
    prgLoad.Max = 100
    ' Configure StatusBar control.
    ' Add three panels, and set Autosize for each
    sbrDB.Panels.Add
    sbrDB.Panels.Add
    sbrDB.Panels.Add
    sbrDB.Panels(1).AutoSize = sbrContents
    sbrDB.Panels(2).AutoSize = sbrSpring
    sbrDB.Panels(3).AutoSize = sbrSpring
    sbrDB.Panels(4).AutoSize = sbrContents
    ' Configure cmdDialog in case the Biblio.mdb can't be found.
    With dlgDialog
        .DialogTitle = "Can't Find Biblio.mdb"

        .Filter = "(*.MDB)|*.mdb"
    End With
    On Error GoTo errFind
    ' Open the Biblio.MDB and set the object variable to the database.
    Set mDbBiblio = DBEngine.OpenDatabase("BIBLIO.MDB")
    ' Configure TreeView
    tvwDB.Sorted = True
    Set mNode = tvwDB.Nodes.Add()
    'mNode.Text = mWksBiblio.Databases(0).Name
    mNode.Text = "Publishers"
    mNode.Tag = mDbBiblio.Name
    mNode.Image = "closed"
    tvwDB.LabelEdit = False
    ' If the Biblio database can't be found, open the
    ' common dialog control to let the user find it.
errFind:
    If Err = 3024 Then
        dlgDialog.ShowOpen
        Set mDbBiblio = DBEngine.Workspaces(0).OpenDatabase(dlgDialog.Filename)
        Resume Next
    ElseIf Err <> 0 Then ' another error
        MsgBox "Unexpected Error: " & Err.Description
        End
    ElseIf Err = 0 Then
        Exit Sub ' just go on
    End If
End Sub
Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As ColumnHeader)
    lvwDB.SortKey = ColumnHeader.index - 1
    ' Set Sorted to True to sort the list.
    lvwDB.Sorted = True
End Sub
Private Sub lvwDB_ItemClick(ByVal Item As ListItem)
    GetData (Item.Key)
End Sub
Private Sub GetData(ISBN)
    If EventFlag <> TITLE Then
        sbrDB.Panels.Clear
        Dim pnlX As Panel
        Set pnlX = sbrDB.Panels.Add(, "ISBN")
        pnlX.AutoSize = sbrSpring
       Set pnlX = sbrDB.Panels.Add(, "author")
        pnlX.AutoSize = sbrSpring
        Set pnlX = sbrDB.Panels.Add(, "year")
        pnlX.Width = 1000
        Set pnlX = sbrDB.Panels.Add(, "description")
        pnlX.AutoSize = sbrSpring
    End If
    Dim rsTitles As Recordset
    ' Set object variable to "Titles" recordset
    Set rsTitles = mDbBiblio.OpenRecordset("Titles", dbOpenDynaset)
    ' Find the ISBN number in Titles table and populate
    ' StatusBar panels with info.
    Dim strQuery As String
    strQuery = "ISBN = " & "'" & ISBN & "'"
    rsTitles.FindFirst strQuery
    sbrDB.Panels("author").Text = GetAuthor(ISBN)
    sbrDB.Panels("ISBN").Text = rsTitles!ISBN
    If Not IsNull(rsTitles![Year Published]) Then
        sbrDB.Panels("year").Text = rsTitles![Year Published]
    Else
        sbrDB.Panels("year").Text = "n/a"
    End If
    If Not IsNull(rsTitles!Description) Then
        sbrDB.Panels("description").Text = rsTitles!Description
    Else
        sbrDB.Panels("description").Text = "n/a"
    End If

    ' Set EventFlag so Panels don't have to be recreated.
    EventFlag = TITLE
End Sub
Private Sub mnuExit_Click()
    End
End Sub
Private Sub mnuLoad_Click()
    Static Loaded As Boolean
    If Loaded = True Then
        Exit Sub
    Else
        cmdLoad_Click
        Loaded = Abs(Loaded - 1)
        mnuLoad.Enabled = False

    End If
End Sub
Private Sub tvwDB_Collapse(ByVal Node As Node)
    If Node.Tag = "Publisher" Or Node.index = 1 _
    Then Node.Image = "closed"
End Sub
Private Sub tvwDB_Expand(ByVal Node As Node)
    If Node.Tag = "Publisher" Or Node.index = 1 Then
        Node.Image = "open"
        Node.Sorted = True
    End If
End Sub
Private Sub MakeColumns()
    ' Clear the ColumnHeaders collection.
    lvwDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    lvwDB.ColumnHeaders.Add , , "Title", 2000
    lvwDB.ColumnHeaders.Add , , "Author"
    lvwDB.ColumnHeaders.Add , , "Year", 350
    lvwDB.ColumnHeaders.Add , , "ISBN"
    ' Set the EventFlag variable so this doesn't get done again and again.
    EventFlag = PUBLISHER
End Sub
Private Sub GetTitles(PubID)
    ' Show Progress bar
    prgLoad.Visible = True
    ' Clear the old titles
    lvwDB.ListItems.Clear
    ' Declare object variable of type Recordset
    Dim rsTitles As Recordset
    ' While on this record, create a recordset using a query
    ' that finds only titles that have the same PubID.
    ' For each record in this recordset, add a ListItem object
    ' to the ListView control, and set the new object's properties
    ' with the record's Title, ISBN and Author fields.
    Set rsTitles = mDbBiblio.OpenRecordset _
    ("select * from Titles where PubID = " & PubID)
    Do Until rsTitles.EOF
            prgLoad.Value = rsTitles.PercentPosition
            Set mItem = lvwDB.ListItems.Add _
            (, CStr(rsTitles!ISBN), rsTitles!TITLE, "book", "smlBook")

            ' Use a function to get the author and set
            ' the SubItems(1) property.
            mItem.SubItems(1) = GetAuthor(rsTitles!ISBN)
            If Not IsNull(rsTitles![Year Published]) Then
                mItem.SubItems(2) = rsTitles![Year Published]
            End If
            mItem.SubItems(3) = rsTitles!ISBN
            rsTitles.MoveNext
    Loop
    prgLoad.Visible = False
    mCurrentIndex = PubID
End Sub
Private Function GetAuthor(ISBN)
    ' Returns the name of an author from Titles table.
    ' Open two recordsets. Search "Title Author" for the ISBN. Then use the
    ' Au_ID field and search for the same value in "Authors" table. Return Author name.
    Dim rsTitlesAuthor As Recordset
    Dim rsAuthors As Recordset
    Set rsTitlesAuthor = mDbBiblio.OpenRecordset("Title Author", dbOpenDynaset)
    Set rsAuthors = mDbBiblio.OpenRecordset("Authors", dbOpenDynaset)
    Dim strQuery As String
    strQuery = "ISBN = " & "'" & ISBN & "'"
    rsTitlesAuthor.FindFirst strQuery
    If rsTitlesAuthor.NoMatch Then
        GetAuthor = "n/a"
        Exit Function
    Else
        strQuery = "Au_ID = " & rsTitlesAuthor!AU_ID
        rsAuthors.FindFirst strQuery
    End If
    GetAuthor = rsAuthors!Author
End Function
Private Sub tvwDB_NodeClick(ByVal Node As Node)
    ' Check the Tag for "Publisher" and EventFlag
    ' variable to see if the ColumnHeaders
    ' have already been created. If not, then
    ' invoke the MakeColumns procedure.
    If Node.Tag = "Publisher" And EventFlag <> _
    PUBLISHER Then MakeColumns
    ' If the Tag is "Publisher" and the mItemCurrentIndex
    ' index isn't the same as the Node.key, then
    ' incoke the GetTitles procedure.
    If Node.Tag = "Publisher" And mCurrentIndex <> Val(Node.Key) _
    Then GetTitles Val(Node.Key)
    If Node.Tag = "Publisher" Then
        sbrDB.Panels(1).Text = Node.Text
        sbrDB.Panels(2).Text = Node.Children & " titles"
        Node.Sorted = True
    End If
End Sub