Me acaban de contratar en una empresa, y me han pedido que haga una aplicaion en visual basic. El problema es que no tengo ni idea del vb. Me he bajado un par de manuales pero no consigo hacer todo lo que necesito.
Me han pedido que haga una base de datos en access pero se tiene que visualizar con un treeview dinamico y también con un listview. La verdad es que he encontrado un ejemplo muy bueno del treeview, pero no soy capaz de unirlo al listview. Si alguien le quiere echar un vistazo que me lo pido que yo se lo envio, os aseguro que es muy bueno. El codigo del treeview es el siguiente:
Código:
Gracias a todos por vuestro tiempo Option Explicit
Dim mDB As Database
Dim mRS As Recordset
Dim mnIndex As Integer
Dim mbIndrag As Boolean
Dim moDragNode As Object
Dim FileName As String
Private Sub cmdChild_Click()
Dim oNodex As Node
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index ' si un noeud a été sélectionné
skey = GetNextKey() ' génération d'une nouvelle clé
Set oNodex = TreeView1.Nodes.Add(iIndex, tvwChild, skey, txtCode.Text & ":" & txtName.Text, 1, 2)
oNodex.EnsureVisible ' le noeud crée doit être visible
txtCode.Text = ""
txtName.Text = ""
Exit Sub
myerr:
MsgBox "Vous devez sélectionner un noeud pour la création d'un noeud enfants...", vbInformation, "Message"
Exit Sub
End Sub
Private Sub cmdLast_Click()
Dim skey As String
skey = GetNextKey() ' génération d'une nouvelle clé
On Error GoTo myerr
TreeView1.Nodes.Add TreeView1.SelectedItem.Index, tvwLast, skey, txtCode.Text & ":" & txtName.Text, 1, 2
txtCode.Text = ""
txtName.Text = ""
Exit Sub
myerr:
' Si le treeview est vide...
TreeView1.Nodes.Add , tvwLast, skey, txtCode.Text & ":" & txtName.Text, 1, 2
txtCode.Text = ""
txtName.Text = ""
Exit Sub
End Sub
Private Sub cmdLoad_Click()
LoadFromTable
End Sub
Private Sub GetFirstParent()
On Error GoTo myerr
Dim i As Integer
Dim nTmp As Integer
For i = 1 To TreeView1.Nodes.Count
nTmp = TreeView1.Nodes(i).Parent.Index
Next
Exit Sub
myerr:
mnIndex = i
Exit Sub
End Sub
Private Function GetNextKey() As String
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
iHold = Val(TreeView1.Nodes(1).Key)
For i = 1 To TreeView1.Nodes.Count
If Val(TreeView1.Nodes(i).Key) > iHold Then
iHold = Val(TreeView1.Nodes(i).Key)
End If
Next
iHold = iHold + 1
sNewKey = CStr(iHold) & "_"
GetNextKey = sNewKey
Exit Function
myerr:
GetNextKey = "1_"
Exit Function
End Function
Private Sub LoadFromTable()
Dim oNodex As Node
Dim nImage As Integer
Dim nSelectedImage As Integer
Dim i As Integer
Dim sTableNames As String
Dim sNodeTable As String
FileName = App.Path & "\test.mdb"
sNodeTable = "table1"
Set mDB = DBEngine.Workspaces(0).OpenDatabase(FileName)
TreeView1.Nodes.Clear
Set mRS = mDB.OpenRecordset(sNodeTable)
If mRS.RecordCount > 0 Then
mRS.MoveFirst
Do While mRS.EOF = False
nImage = mRS.Fields("image")
nSelectedImage = mRS.Fields("selectedimage")
If Trim(mRS.Fields("parent")) = "0_" Then
Set oNodex = TreeView1.Nodes.Add(, 1, Trim(mRS.Fields("key")), _
Trim(mRS.Fields("text")), nImage, nSelectedImage)
Else
' Il s'agit d'un noeud enfant
Set oNodex = TreeView1.Nodes.Add(Trim(mRS.Fields("parent")), tvwChild, _
Trim(mRS.Fields("key")), Trim(mRS.Fields("text")), nImage, nSelectedImage)
' Le noeud enfant est visible
oNodex.EnsureVisible
End If
mRS.MoveNext
Loop
End If
mRS.Close ' fermeture du recordset
mDB.Close ' fermeture de la base de données
End Sub
Sub SaveToTable()
Dim sResponse As String
Dim sMDBName As String
Dim sTableName As String
Dim i As Integer
FileName = App.Path & "\test.mdb"
sTableName = "table1"
Set mDB = DBEngine.Workspaces(0).OpenDatabase(FileName)
Set mRS = mDB.OpenRecordset(sTableName)
Call WriteToTable
mRS.Close
mDB.Close
End Sub
Private Sub cmdRemove_Click()
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index ' suppression du noeud sélectionné
TreeView1.Nodes.Remove iIndex
Exit Sub
myerr:
' Si aucun noeud n'est sélectionné...
MsgBox "Vous devez sélectionner un noeud...", vbInformation, "Message"
Exit Sub
End Sub
Private Sub cmdSave_Click()
SaveToTable
End Sub
Sub WriteToTable()
Dim i As Integer
Dim iTmp As Integer
Dim iIndex As Integer
If mRS.RecordCount > 0 Then
mRS.MoveFirst
Do While mRS.EOF = False
mRS.Delete
mRS.MoveNext
Loop
End If
If TreeView1.Nodes.Count = 0 Then
Exit Sub
End If
Call GetFirstParent
iIndex = TreeView1.Nodes(mnIndex).FirstSibling.Index
iTmp = iIndex
mRS.AddNew
mRS("parent") = "0_"
mRS("key") = TreeView1.Nodes(iIndex).Key
mRS("text") = TreeView1.Nodes(iIndex).Text
mRS("image") = TreeView1.Nodes(iIndex).Image
mRS("selectedimage") = TreeView1.Nodes(iIndex).SelectedImage
mRS.Update
If TreeView1.Nodes(iIndex).Children > 0 Then
Call WriteChild(iIndex)
End If
While iIndex <> TreeView1.Nodes(iTmp).LastSibling.Index
mRS.AddNew
mRS("parent") = "0_"
mRS("key") = TreeView1.Nodes(iIndex).Next.Key
mRS("text") = TreeView1.Nodes(iIndex).Next.Text
mRS("image") = TreeView1.Nodes(iIndex).Next.Image
mRS("selectedimage") = TreeView1.Nodes(iIndex).Next.SelectedImage
mRS.Update
If TreeView1.Nodes(iIndex).Next.Children > 0 Then
WriteChild TreeView1.Nodes(iIndex).Next.Index
End If
iIndex = TreeView1.Nodes(iIndex).Next.Index
Wend
End Sub
Private Sub Form_Load()
Set moDragNode = Nothing
Call LoadFromTable
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SaveToTable ' sauvegarde de l'arborescence
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "exit"
Unload Me
Case "parent"
Call cmdLast_Click
Case "child"
Call cmdChild_Click
Case "delete"
Call cmdRemove_Click
End Select
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
If TreeView1.DropHighlight Is Nothing Then
mbIndrag = False
Exit Sub
Else
On Error GoTo checkerror ' To prevent circular errors.
Set moDragNode.Parent = TreeView1.DropHighlight
Set TreeView1.DropHighlight = Nothing
mbIndrag = False
Set moDragNode = Nothing
Exit Sub
End If
checkerror:
' Constants Visual Basic errors code.
Const CircularError = 35614
If Err.Number = CircularError Then
mbIndrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If mbIndrag = True Then
' Positionner DropHighlight d'aprés les coordonnées de la souris
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End If
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
' Savoir si l'on a cliqué sur un noeud
If Not TreeView1.DropHighlight Is Nothing Then
' On a cliqué sur un noeud
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set moDragNode = TreeView1.SelectedItem ' représente le noeud qui sera drag and drop
End If
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then ' on est donc en mode drag and drop
mbIndrag = True ' on positionne le flag à TRUE
TreeView1.DragIcon = Image1.Picture
TreeView1.Drag vbBeginDrag ' on commence le drag and drop
End If
End Sub
Private Sub WriteChild(ByVal iNodeIndex As Integer)
Dim i As Integer
Dim iTempIndex As Integer
iTempIndex = TreeView1.Nodes(iNodeIndex).Child.FirstSibling.Index
For i = 1 To TreeView1.Nodes(iNodeIndex).Children
mRS.AddNew
mRS("parent") = TreeView1.Nodes(iTempIndex).Parent.Key
mRS("key") = TreeView1.Nodes(iTempIndex).Key
mRS("text") = TreeView1.Nodes(iTempIndex).Text
mRS("image") = TreeView1.Nodes(iTempIndex).Image
mRS("selectedimage") = TreeView1.Nodes(iTempIndex).SelectedImage
mRS.Update
' Appel récursif de la procédure
If TreeView1.Nodes(iTempIndex).Children > 0 Then
Call WriteChild(iTempIndex)
End If
' On passe au noeud suivant
If i <> TreeView1.Nodes(iNodeIndex).Children Then
iTempIndex = TreeView1.Nodes(iTempIndex).Next.Index
End If
Next i
End Sub
