Hallo Werner,
der Quellcode:
Option Explicit
Private mNode As node ' Knotenvariable auf Modulebene.
Private mItem As ListItem ' ListItem-Variable auf Modulebene.
Private EventFlag As Integer ' Signalisiert, welches Ereignis eingetreten ist.
Private mCurrentIndex As Integer ' Flag zum Sicherstellen, daß nicht schon auf Knoten geklickt worden ist.
Private mStatusBarStyle As Integer ' Schaltet den Stil der Statusleiste um.
Private cn As ADODB.Connection ' Es wird nur eine aktive Verbindung verwendet.
Const PUBLISHER = 1 ' Für EventFlag. Signalisiert Objekte der Spaltenüberschrift "Publisher".
Const TITLE = 2 ' Für EventFlag. Signalisiert Titel in der Listenansicht.
Private Sub cmdLoad\_Click()
Dim intCounter As Integer ' Zähler zum Festlegen von Fortschrittsleiste.Value
Dim intIndex ' Variable für den Index des aktuellen Knoten.
' Festlegen der Verbndungszeichenfolge im ADODB-Connection-Objekt
' und Öffnen der Verbindung.
' Erstellen einer ADODB-Recordset-Objektvariablen.
Dim rsPublishers As New ADODB.Recordset
' Öffnen des Recordset.
With rsPublishers
.Open "SELECT PubID, [Company Name] FROM Publishers", cn, adOpenStatic, adLockOptimistic
' Bewegen zum letzten Datensatz, um RecordCount
' zu ermitteln, und dann wieder zurück.
.MoveLast
.MoveFirst
End With
' Festlegen des Maximums der Fortschrittsleiste und
' Anzeigen der Fortschrittsleiste.
With prgLoad
.Max = rsPublishers.RecordCount
.Visible = True
End With
' Hinzufügen eines Listenelements, solange Datensatz
' nicht der letzte Datensatz ist. Verwenden des
' Felds "Name" als Text des Listenelement-Objekts.
Do While Not rsPublishers.EOF
intCounter = intCounter + 1
prgLoad.Value = intCounter ' Aktualisieren der Fortschrittsleiste.
' Hinzufügen eines Knotens zur Strukturansicht
' und Festlegen seiner Eigenschaften.
Set mNode = tvwDB.Nodes.Add(1, tvwChild, rsPublishers!pubID & " ID", CStr(rsPublishers![Company name]), "closed")
mNode.Tag = "Verlag" ' Bezeichnet die Tabelle.
' Festlegen der Variablen intIndex auf die
' Index-Eigenschaft des neugeschaffenen Knotens.
' Diese Variable wird verwendet, um dem vorliegenden
' Knoten untergeordnete Knotenobjekte hinzuzufügen.
intIndex = mNode.Index
rsPublishers.MoveNext ' Bewegen zum nächsten Publishers-Datensatz.
Loop
' Ausblenden der Fortschrittsleiste.
prgLoad.Visible = False
' Festlegen des Statusleistenstils auf "normal".
sbrDB.Style = sbrNormal
' Sortieren der Publishers-Knoten.
tvwDB.Nodes(1).Sorted = True
' Öffnen des obersten Knotens.
tvwDB.Nodes(1).Expanded = True
End Sub
Private Sub cmbView\_Click()
' Festlegen der View-Eigenschaft der Listenansicht.
lvwDB.View = cmbView.ListIndex
End Sub
Private Function FindBiblio() As String
On Error GoTo ErrHandler
' Konfigurieren von cmdDialog für den Fall,
' daß Biblio.mdb nicht gefunden wird.
With dlgDialog
.DialogTitle = "Biblio.mdb wurde nicht gefunden."
.Filter = "(\*.MDB)|\*.mdb"
End With
' Falls der Benutzer auf "Abbrechen" klickt,
' wird ein Fehler verursacht.
dlgDialog.CancelError = True
dlgDialog.ShowOpen
Do While UCase(Right(Trim(dlgDialog.FileName), 10)) "BIBLIO.MDB"
MsgBox "Dateiname verschieden von BIBLIO.MDB"
dlgDialog.ShowOpen
Loop
FindBiblio = dlgDialog.FileName
Exit Function
ErrHandler:
If Err = 32755 Then
End
End If
End Function
Private Sub Form\_Load()
' Globales Connection-Objekt zuerst öffnen.
On Error GoTo errFind
Set cn = New ADODB.Connection
' Die Verbindungszeichenfolge enthält den Pfad der
' Datenbank. Falls sich Biblio.mdb nicht auf Ihrem
' Computer befindet, können Sie diese auch auf der
' MSDN-CD finden.
With cn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & \_
"C:\Programme\Microsoft Visual Studio\VB98\Biblio.mdb"
.Open
End With
' Konfigurieren des Steuerelements cmbView.
With cmbView
.AddItem "Große Symbole" ' 0
.AddItem "Kleine Symbole" ' 1
.AddItem "Liste" ' 2
.AddItem "Details" ' 3
.ListIndex = 3
End With
' Konfigurieren des Listenansicht-Steuerelements.
lvwDB.View = lvwReport
' Konfigurieren des Strukturansicht-Steuerelements.
With tvwDB
.Sorted = True
Set mNode = .Nodes.Add()
.LabelEdit = False
.LineStyle = tvwRootLines
End With
With mNode ' Hinzufügen des ersten Knotens.
.Text = "Verlage"
.Tag = "Biblio"
.Image = "closed"
End With
frmTreeview.Show
mnuLoad\_Click
Exit Sub
' Falls Datenbank nicht gefunden wird, Standardialog-
' Steuerelement für die Suche durch den Benutzer öffnen.
errFind:
If Err = -2147467259 Then
Set cn = Nothing
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & FindBiblio
cn.Open
Resume Next
ElseIf Err 0 Then ' Anderer Fehler
MsgBox "Unerwarteter Fehler: " & Err.Description
End
End If
End Sub
Private Sub lvwDB\_ColumnClick(ByVal ColumnHeader As ColumnHeader)
lvwDB.SortKey = ColumnHeader.Index - 1
' Festlegen von .Sorted auf True, damit Liste sortiert wird.
lvwDB.Sorted = True
End Sub
Private Sub lvwDB\_ItemClick(ByVal Item As ListItem)
GetData Item.Key
End Sub
Private Sub GetData(ISBN As String)
' Die globale Variable EventFlag kennzeichnet,
' wie die Statusleiste verwendet wird.
If EventFlag TITLE Then
sbrDB.Panels.Clear
Dim pnlX As Panel
Set pnlX = sbrDB.Panels.Add(, "ISBN")
pnlX.AutoSize = sbrContents
Set pnlX = sbrDB.Panels.Add(, "Autor")
pnlX.AutoSize = sbrContents
Set pnlX = sbrDB.Panels.Add(, "Ersch.jahr")
pnlX.Width = 1000
Set pnlX = sbrDB.Panels.Add(, "Beschreibung")
pnlX.AutoSize = sbrContents
End If
' Öffnen eines ADODB-Recordset, um die
' Daten für die Statusleiste zu ermitteln.
Dim rsTitles As New ADODB.Recordset
Dim strQ As String
strQ = "SELECT Authors.Author, Titles.ISBN, Titles.[Year Published], " & \_
"Titles.Description FROM Authors INNER JOIN (Titles INNER JOIN " & \_
"[Title Author] ON " & \_
"Titles.ISBN = [Title Author].ISBN) ON Authors.Au\_ID = " & \_
"[Title Author].Au\_ID WHERE Titles.ISBN='" & ISBN & " '"
' Öffnen des Recordset.
rsTitles.Open strQ, cn, adOpenStatic, adLockOptimistic
' Füllen der Statusleiste mit Informationen.
sbrDB.Panels("Autor").Text = rsTitles!author
sbrDB.Panels("ISBN").Text = rsTitles!ISBN
If Not IsNull(rsTitles![Year Published]) Then
sbrDB.Panels("Ersch.jahr").Text = rsTitles![Year Published]
Else
sbrDB.Panels("Ersch.jahr").Text = "n. v."
End If
If Not IsNull(rsTitles!Description) Then
sbrDB.Panels("Beschreibung").Text = rsTitles!Description
Else
sbrDB.Panels("Beschreibung").Text = "n. v."
End If
If Not rsTitles.EOF Then rsTitles.MoveNext
' Hinzufügen der Namen weiterer Autoren.
Do Until rsTitles.EOF
If Not IsNull(rsTitles!author) Then
sbrDB.Panels("Autor").Text = sbrDB.Panels("Autor").Text & \_
" & " & rsTitles!author
End If
rsTitles.MoveNext
Loop
' Festlegen von EventFlag, damit Grundflächen
' nicht neu erstellt werden müssen.
EventFlag = TITLE
End Sub
Private Sub mnuExit\_Click()
Unload Me
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)
' Nur Knoten, die von Ordnern gebildet werden,
' können reduziert werden.
If node.Tag = "Verlag" Or node.Index = 1 Then node.Image = "closed"
End Sub
Private Sub tvwDB\_Expand(ByVal node As node)
' Nur der oberste Knoten und die Knoten
' der Verlage können erweitert werden.
If node.Tag = "Verlag" Or node.Index = 1 Then
node.Image = "open"
node.Sorted = True
End If
If node.Tag = "Verlag" And EventFlag \_
PUBLISHER Then MakeColumns
' Falls das Tag den Wert "Verlag" besitzt und
' der Index mItemCurrentIndex nicht identisch ist
' mit Node.key, wird die Funktion GetTitles aufgerufen.
If node.Tag = "Verlag" And mCurrentIndex Val(node.Key) \_
Then GetTitles node, Val(node.Key)
If node.Tag = "Verlag" Then PopStatus node
node.Sorted = True
End Sub
Private Sub MakeColumns()
' Löschen des Inhalts der ColumnHeaders-Auflistung.
lvwDB.ColumnHeaders.Clear
' Hinzufügen von vier Spaltenköpfen.
lvwDB.ColumnHeaders.Add , , "Titel", 2800
lvwDB.ColumnHeaders.Add , , "Autor"
lvwDB.ColumnHeaders.Add , , "Ersch.jahr", 800
lvwDB.ColumnHeaders.Add , , "ISBN"
' Festlegen der Variablen EventFlag, damit
' dies nicht immer wieder getan wird.
EventFlag = PUBLISHER
End Sub
Private Sub AddListItemsOnly(pubID)
Dim rsTitles As New ADODB.Recordset
Dim newNode As node
Dim strQ As String
strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & \_
"Titles.[Year Published] FROM Authors INNER JOIN " & \_
"(Titles INNER JOIN [Title Author] " & \_
"ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au\_ID = " & \_
"[Title Author].Au\_ID WHERE Titles.PubID=" & pubID
lvwDB.ListItems.Clear
With rsTitles
.Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
.MoveLast
.MoveFirst
prgLoad.Max = .RecordCount + 1
End With
' Anzeigen der Fortschrittsleiste.
prgLoad.Visible = True
Dim intCounter As Integer
' Erstellen eines untergeordneten Knoten.
' Hinzufügen eines entsprechenden Listenelements.
AddListItem mItem, rsTitles
rsTitles.MoveNext
' Durchlaufen des restlichen Recordsets. Falls der
' nächste Datensatz ein Duplikat ist, wird nur der
' Name des Autors hinzugefügt. Andernfalls Hinzufü-
' gen eines neuen Knotens und eines Listenelements.
Do Until rsTitles.EOF
intCounter = intCounter + 1 ' Für die Fortschrittsleiste.
prgLoad.Value = intCounter ' Aktualisieren der
' Fortschrittsleiste.
If mItem.Key = rsTitles!ISBN Then ' Duplikat
' Hinzufügen des Autors zur Autorenliste.
mItem.ListSubItems(1).Text = \_
mItem.ListSubItems(1).Text & \_
" & " & rsTitles!author
Else
AddListItem mItem, rsTitles
End If
rsTitles.MoveNext
Loop
prgLoad.Visible = False
mCurrentIndex = pubID
End Sub
Private Function GetTitles(ByRef ParentNode As node, pubID) As Boolean
Dim rsTitles As New ADODB.Recordset
Dim newNode As node ' Für neuen Knoten.
Dim strQ As String
Dim intCounter As Integer ' Für den Wert der
' Fortschrittsleiste.
' Überprüfen, ob der Knoten nicht schon gefüllt ist.
' Ist dies der Fall, werden nur die Listenelement-
' Objekte der Listenansicht hinzugefügt und dann
' wird die Prozedur verlassen.
If ParentNode.Children Then
AddListItemsOnly pubID
Exit Function
End If
' Löschen des Inhalts der Listenansicht,
' falls sie schon gefüllt ist.
lvwDB.ListItems.Clear
' SQL-Abfrage, die die benötigten Felder abruft.
strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & \_
"Titles.[Year Published] FROM Authors INNER JOIN " & \_
"(Titles INNER JOIN [Title Author] " & \_
"ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au\_ID = " & \_
"[Title Author].Au\_ID WHERE Titles.PubID=" & pubID
' Öffnen des Recordsets. Verlassen der Prozedur,
' falls keine Ergebnisse vorliegen.
With rsTitles
.Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
If .BOF Then
' Zurückgeben von False und Verlassen der
' Prozedur, falls keine Ergebnisse vorliegen.
GetTitles = False
Exit Function
End If
.MoveLast
.MoveFirst
prgLoad.Max = .RecordCount + 1
End With
' Anzeigen der Fortschrittsleiste.
prgLoad.Visible = True
On Error GoTo childErr
' Hinzufügen des ersten Knoten.
AddNode newNode, ParentNode, rsTitles
' Hinzufügen des entsprechenden Listenelements.
AddListItem mItem, rsTitles
rsTitles.MoveNext
' Durchlaufen des restlichen Recordsets. Falls der
' nächste Datensatz ein Duplikat ist, wird nur der
' Name des Autors hinzugefügt. Andernfalls Hinzufü-
' gen eines neuen Knotens und eines Listenelements.
Do Until rsTitles.EOF
intCounter = intCounter + 1 ' Für die Fortschrittsleiste.
prgLoad.Value = intCounter ' Aktualisieren der
' Fortschrittsleiste.
' Vergleichen von Key mit der aktuellen ISDN.
' Falls sie übereinstimmen, unterscheiden sich
' die Datensätze nur durch den Autor. Daher wird
' der Autors der aktuellen Liste hinzugefügt.
If newNode.Key = rsTitles!ISBN Then
' Hinzufügen des Autors zur aktuellen Liste.
mItem.ListSubItems("author").Text = \_
mItem.ListSubItems("author").Text & \_
" & " & rsTitles!author
Else ' Hinzufügen eines neuen Knotens
' und eines Listenelements.
AddNode newNode, ParentNode, rsTitles
AddListItem mItem, rsTitles
End If
rsTitles.MoveNext
Loop
GetTitles = True ' Zurückgeben von True bei Erfolg
prgLoad.Visible = False
mCurrentIndex = pubID
Exit Function
childErr:
Debug.Print Err.Number, Err.Description
Debug.Print rsTitles!ISBN
Resume Next
Exit Function
End Function
Private Sub AddNode(ByRef newNode As node, ByRef ParentNode As node, ByRef rs As ADODB.Recordset)
' Hinzufügen eines neuen Knoten. Der neue
' Knoten newNode und der übergeordnete
' Knoten ParentNode werden beide benötigt.
Set newNode = tvwDB.Nodes.Add(ParentNode, \_
tvwChild, rs!ISBN, rs!TITLE, "smlBook")
newNode.Tag = "Buch"
End Sub
Private Sub AddListItem(ByRef xItem As ListItem, ByRef xRec As ADODB.Recordset)
' Hinzufügen eines Listenelements und Festlegen
' seines Textes, sowie seines großen und seines
' kleinen Symbols. Dann werden drei ListSubItems
' hinzugefügt und für jedes die Eigenschaften
' Key und Text festgelegt.
Set xItem = lvwDB.ListItems.Add(Key:=xRec!ISBN, \_
Text:=xRec!TITLE, Icon:="book", SmallIcon:="smlBook")
xItem.ListSubItems.Add Key:="author", Text:=xRec!author
If Not IsNull(xRec![Year Published]) Then
xItem.ListSubItems.Add Key:="year", Text:=xRec![Year Published]
End If
xItem.ListSubItems.Add Key:="isbn", Text:=xRec!ISBN
End Sub
Private Sub tvwDB\_NodeClick(ByVal node As node)
' Überprüfen des Tag auf "Verlag" und der Variablen
' EventFlag, um festzustellen, ob die Spaltenköpfe
' schon erstellt worden sind. Falls nicht, wird die
' Prozedur MakeColumns aufgerufen.
If node.Tag = "Verlag" And EventFlag \_
PUBLISHER Then MakeColumns
' Falls das Tag den Wert "Verlag" besitzt und
' der Index mItemCurrentIndex nicht mit Node.key
' identisch ist, wird die Funktion GetTitles
' aufgerufen, die den Knoten füllt.
If node.Tag = "Verlag" And mCurrentIndex Val(node.Key) \_
Then GetTitles node, Val(node.Key)
If node.Tag = "Verlag" Then PopStatus node
node.Sorted = True
' Falls das Tag den Wert "Buch" besitzt, wird
' mit der EnsureVisible-Methode sichergestellt,
' daß das Buch, auf das geklickt worden ist,
' in der Listenansicht zu sehen ist.
If node.Tag = "Buch" Then
Dim liBook As ListItem
Set liBook = lvwDB.FindItem(node.Text)
liBook.EnsureVisible
End If
End Sub
Private Sub PopStatus(node As node)
' Ändern der Statusleiste, um die
' aktuellen Werte wiederzugeben.
With sbrDB
.Panels.Clear
.Panels.Add , "Name", node.Text
.Panels.Add , "Anzahl", node.Children & " Titel"
.Panels(1).AutoSize = sbrContents
.Panels(2).AutoSize = sbrSpring
End With
End Sub
Steuerelemente:
Combobox: cmbViev
Progressbar: prgLoad
TreeViwv: TvwDB
ListView: lvwDB
Imagelist: ImlSmallIco
Imagelist: ImlIcons
Commondialog: DlgDialog
Statusbar: sbrDB
Commandbutton: CmdLoad
Und im Menü:
… Datei
… … Laden
… … Beenden
OK?
Gruß, Rainer
