+ Rispondi al Thread
Pagina 2 di 2 primaprima 12
Visualizzazione dei risultati da 11 a 14 su 14

Discussione: Treeview, intercettare primo parent del nodo selezionato

  1. #11
    L'avatar di @Alex
    @Alex non è in linea Very Important Person
    Post
    15,446
    Do unitil node.parent is Nothing...

    Non serve il controllo interno.
    Ecc o puoi introdurre un parametro... suppongo il livello sia 4... e tu voglia sapere il parente di 2°...
    Introduce un levelcounter nel loop...
    Poi a fantasia...
    @Alex
    Il CROSSPOST è VIETATO
    Mirror al vecchio sito WEB(salvare i Demo riassegnando l'estensione (.Zip/.Rar/.Exe in base all'icona...):
    http://mirror.masterdrive.it/alessandrobaraldi/
    Leggi il
    Regolamento del Forum e nel comprenderne la filosofia rispettalo.

  2. #12
    terrornoize non è in linea Scolaretto
    Post
    67
    Più che altro mi piacerebbe "ottimizzare" i tempi di caricamento del treeview (circa 3500 nodi, è l'organigramma di una azienda)

    Attualmente si genera in circa 15 secondi su un i7+ssd
    Ho già messo il recordset di input (id - nome da visualizzare - id_padre) in vbreadonly, ho cercato di ottimizzare il più possibile, ma mi piacerebbe fare di più.

    Questo è il codice (copia incollato e modificato da un vecchio manuale di access 2003) che genera il treeview, se qualcuno mi vuole dare qualche spunto per ottimizzare l'esistente mi fa una grossa cortesia:

    codice:
    Private Sub Form_Load()
    
    Const strNomeTabellaQuery = "TBL_UO_UOSup"
    
    Dim db As DAO.Database, rst As DAO.Recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strNomeTabellaQuery, dbOpenDynaset, dbReadOnly)
    
    AggiungiRamo rst:=rst, strPuntaAlCampo:="ID_Sup", _
    strCampoID:="ID", strCampoTesto:="UO"
    
    Call SetupTreeview
    
    End Sub
    
    -----------------------------
    
    '================= Procedura ricorsiva AggiungiRamo ======================
    '      Procedura ricorsiva per aggiungere rami al controllo TreeView
    'Richiede:
    'Controllo ActiveX :  controllo TreeView
    '              Nome:  xTree
    'Parametri:
    '               rst:  Recordset autoreferente che contiene i dati
    '   strPuntaAlCampo:  Nome di un campo che punta alla chiave primaria del genitore
    '        strCampoID:  Nome del campo chiave primaria del genitore
    '      strCampoTesto: Nome del campo che contiene il testo da visualizzare
    '=============================================================
    Sub AggiungiRamo(rst As Recordset, strPuntaAlCampo As String, _
               strCampoID As String, strCampoTesto As String, _
               Optional varIDSuperiore As Variant)
    
    On Error GoTo errAggiungiRamo
    Dim nodCorrente As node, objAlbero As TreeView
    Dim strCriteri As String, strTesto As String, strChiave As String
    Dim nodGenitore As node, bk As String, nodNodes As Nodes
    
    Set objAlbero = Me!xTree.Object
    Set nodNodes = objAlbero.Nodes
    
    If IsMissing(varIDSuperiore) Then  ' Radice
        strCriteri = strPuntaAlCampo & " Is Null"
    Else  ' Cerca record che puntano al genitore.
        strCriteri = BuildCriteria(strPuntaAlCampo, _
            rst.Fields(strPuntaAlCampo).Type, "=" & varIDSuperiore)
        'Set nodGenitore = objAlbero.Nodes("a" & varIDSuperiore)
        Set nodGenitore = nodNodes("a" & varIDSuperiore)
    End If
    
    ' Trova il primo impiegato che dipende dal nodo del capo.
    rst.FindFirst strCriteri
    Do Until rst.NoMatch
          
        ' Crea una stringa col Cognome.
        strTesto = rst(strCampoTesto)
        strChiave = "a" & rst(strCampoID)
           
        If Not IsMissing(varIDSuperiore) Then  'aggiunge un nuovo nodo al genitore
           'Set nodCorrente = objAlbero.Nodes.Add(nodGenitore, tvwChild, strChiave, strTesto)
           Set nodCorrente = nodNodes.Add(nodGenitore, tvwChild, strChiave, strTesto)
        Else    ' Aggiunge un nuovo nodo alla radice.
           'Set nodCorrente = objAlbero.Nodes.Add(, , strChiave, strTesto)
           Set nodCorrente = nodNodes.Add(, , strChiave, strTesto)
        End If
        
           ' Salva la posizione raggiunta nel recordset in modo che sia
           ' più veloce passare il riferimento.
        bk = rst.Bookmark
           ' Aggiunge gli Impiegati che dipendono da questo nodo.
        AggiungiRamo rst, strPuntaAlCampo, strCampoID, strCampoTesto, rst(strCampoID)
        rst.Bookmark = bk     ' Torna all'ultimo punto e continua la ricerca.
        rst.FindNext strCriteri   ' Trova il prossimo impiegato.
        
    Loop
           
    exitAggiungiRamo:
    Exit Sub
    
       '-------------------------- Intercettazione errori --------------------------
    errAggiungiRamo:
    MsgBox "Non posso aggiungere un figlio:  " & Err.Description, vbCritical, "Errore AggiungiRamo :"
    Resume exitAggiungiRamo
    End Sub
    
    
    Private Sub SetupTreeview()
    
        With Me.xTree
            '.Style = tvwTreelinesPlusMinusText
            '.LineStyle = tvwRootLines
            '.Indentation = 240
            '.Appearance = ccFlat
            '.HideSelection = False
            '.BorderStyle = ccFixedSingle
            '.HotTracking = True
            '.FullRowSelect = False
            '.CheckBoxes = False
            '.SingleSel = False
            '.sorted = False
            '.Scroll = True
            '.LabelEdit = tvwManual
            .Font.Name = "Calibri (Detail)"
            .Font.Size = 9
            .LabelEdit = 1
            '.Node.Level(1).ForeColor = vbRed
        End With
        
    End Sub

  3. #13
    L'avatar di @Alex
    @Alex non è in linea Very Important Person
    Post
    15,446
    Hai pensato, invece di caricare TUTTO il RS e passarlo obbligando ad usare il FINDNEXT... a creare una Funzione Ricorsiva sul RS, e da quella chiamare l'ADDNODE...?

    Credo che possa essere più veloce il caricamento, ma puoi fare una prova, è abbastanza semplice.

    Di norma si genera una Funzione iniziale che carica i Record con IdParent(Null), che equivale alla Gerarchia di Livello ZERO.

    Si cicla il RS che chiama la 2° funzione, questa sarà Ricorsiva, che riceve come Parametro IDParent.

    Ti propoongo uno stralcio di un mio vecchio codice..., prendilo così solo come indirizzo
    codice:
    Public Sub LoadTree()
        
        'populate the treeview control
        Dim rs          As DAO.Recordset
        Dim rsI         As DAO.Recordset
        Dim sKey        As String
        Dim ssKEY       As String
        Dim sSQL        As String
        Dim ndP         As MSComctlLib.node
        Dim ndC         As MSComctlLib.node
        Dim ndRoot      As MSComctlLib.node
            
        mT.Nodes.Clear
        
        Set ndRoot = mT.Nodes.Add(, , "PLANTS", "IMPIANTI", 1)
        
        sSQL = "SELECT DISTINCT CLE FROM TI ORDER BY CLE;"
        
        Set rs = DBEngine(0)(0).OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
        If rs.EOF = False Then
            rs.MoveFirst
            Do Until rs.EOF
                sKey = UniqueKey
                ' INSERISCE LA ROOT UNICA
                Set ndP = mT.Nodes.Add("PLANTS", tvwChild)
                    
                ndP.Key = sKey
                ndP.Text = rs.Fields("CLE").Value
                ndP.image = 2
                ndP.Tag = ""
                'add sub levels
                
                ' QUESTO NEL MIO CASO CARICA I NODE PRINCIPALI, nel tuo vedi se serve un Check sul NULL PARENT
                sSQL = "SELECT * FROM TI WHERE CLE='" & rs.Fields("CLE").Value & "' ORDER BY Macchinario;"
                
                Set rsI = DBEngine(0)(0).OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
                If rsI.EOF = False Then
                    If Not ndP Is Nothing Then ndP.Text = ndP.Text & " (" & rsI.RecordCount & ")"
    
                    rsI.MoveFirst
                    Do Until rsI.EOF
                        Set ndP = mT.Nodes.Add(sKey, tvwChild)
                        ssKEY = UniqueKey
                        
                        ndP.Key = ssKEY
                        ndP.Text = rsI.Fields("Macchinario").Value
                        ndP.image = 3
                        ndP.Tag = rsI.Fields("IdImp").Value
                        'add sub levels
                        AddChildren ssKEY, ndP
            
                        rsI.MoveNext
                    Loop
                End If
                rs.MoveNext
            Loop
            
        
        End If
        On Error Resume Next
        ndRoot.Expanded = True
        rs.Close
        Set rs = Nothing
        Set ndP = Nothing
        Set ndRoot = Nothing
    End Sub
    
    Sub AddChildren(ByVal Parent_Key As String, Optional mNode As MSComctlLib.node)
    
        Dim rsC             As DAO.Recordset
        Dim sSQL            As String
        Dim sKey            As String
        Dim nd              As MSComctlLib.node
        
           
        'get sub levels
        sSQL = "SELECT * FROM TT WHERE IdImp = " & mNode.Tag & " ORDER BY DataTest DESC" 'Obj_Ico, Obj_Name"
        Set rsC = DBEngine(0)(0).OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
        If rsC.RecordCount > 0 Then
        
            If Not mNode Is Nothing Then mNode.Text = mNode.Text & " (" & rsC.RecordCount & ")"
        
            With rsC
                .MoveFirst
                Do While .EOF = False
                    sKey = UniqueKey
                    
                    Set nd = TreeCtrl.Nodes.Add(Parent_Key, tvwChild)
                    nd.Key = sKey
                    nd.Text = StrConv(Format$(rsC.Fields("DataTest").Value, "mmmm yyyy"), vbProperCase)
                    nd.image = 4
                    nd.Tag = rsC.Fields("IdTest").Value
                    Set nd = Nothing
                    AddChildren .Fields("IdTest").Value  ' FUNZIONE RICORSIVA PER INSERIRE I CHILD
                    .MoveNext
                Loop
            End With
        End If
        
        rsC.Close
        Set rsC = Nothing
    
    End Sub
    Ultima modifica di @Alex; 16-04-2018 13:20 
    @Alex
    Il CROSSPOST è VIETATO
    Mirror al vecchio sito WEB(salvare i Demo riassegnando l'estensione (.Zip/.Rar/.Exe in base all'icona...):
    http://mirror.masterdrive.it/alessandrobaraldi/
    Leggi il
    Regolamento del Forum e nel comprenderne la filosofia rispettalo.

  4. #14
    terrornoize non è in linea Scolaretto
    Post
    67
    Grazie mille Alex, oggi sono piuttosto preso con altre problematiche in ufficio, appena ho mezza giornata rivedo il codice che hai gentilmente postato!

+ Rispondi al Thread
Pagina 2 di 2 primaprima 12

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi