与网友:"天方流星夜谭"的一点讨论!

Question

同样是要实现TREEVIEW可以有限N个类别的要求,即:用户自定义新类别,也可以对已有类别新增子类别.天方流星夜谭的做法:定义一个表,用来映射TREEVIEW,他讲的是定义四个字段,具体听他的解.我的做法是:  
  参考了管家婆的模式,在一个表中定义所有的类别,子类别取父类别的前两字符作为子类别的首两位字符,这样,不允许同层类别有重复的标识,实现分层.在TREEVIEW的实现中,我在表中定义一个字段用来判断是否有子类别.......不讲了,因为我现在只在思考这个问题,还没有真正到程序中实现,所以听听各位对于让用户自定义N层类别应该如何实现!

Answer 1

嗯，学习！那如何用递归得到树形列表呢？楼主能具体说说吗？这个是天方夜谭做的.我也是学来的.父ID   父名    本节点ID   本节点名
第一层可以设定为root,然后下层节点的父ID字段为上级的"本节点ID".
代码如下,我没有整理(是我改完运行后,没有保存,不过我看懂了,而且他的代码也非常的不严谨,所以我没做深的研究)Option Explicit
Dim parText As String
Dim nodX As Node'树的显示
 Private Sub treeshow(ssn As Variant)     '表示浏览根节点。
 Dim txtSQL As String
 Dim MsgText As String
 Dim mrc As ADODB.Recordset
 If Trim(ssn) <> "" Then
 txtSQL = "select * from dm_wzlb where lbcode='" & ssn & "'" '//treenkey,treename,zitreekey,zitreename
 Set mrc = ExecuteSQL(txtSQL, MsgText)
     
    If Not mrc.EOF Then
        Do While Not mrc.EOF
           ssn = mrc.Fields(2)
            Set nodX = TreeView1.Nodes.Add(Trim(mrc.Fields(0)), tvwChild)
            nodX.Key = Trim(mrc.Fields(2))
            nodX.Text = Trim(mrc.Fields(3))
            treeshow (ssn)
            mrc.MoveNext
        Loop
        mrc.Close
    End If
   Else
   MsgBox "weihi", vbOKCancel, "ti"
   Exit Sub
   End If
End Sub
Private Sub cmdADDP_Click() '?ó?ù?úμ?
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
        If Trim(parText) <> "" Then
        'cmdADDC_Click
        'If TreeView1.Nodes(parText).Parent Is Nothing Then
        Set nodX = TreeView1.Nodes.Add(parText, tvwChild)
            nodX.Key = "n" & zlbh.Text
            nodX.Text = zlmc.Text
            nodX.EnsureVisible
            txtSQL = "insert dm_wzlb(lbcode,lb,lbcode1,lb1)values('" & Trim(TreeView1.Nodes(parText).Key) & "','" & Trim(TreeView1.Nodes(parText).Text) & "','" & nodX.Key & "','" & nodX.Text & "')"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
           
      Else
      Set nodX = TreeView1.Nodes.Add(, tvwChild)
        nodX.Key = "n" & zlbh.Text
        nodX.Text = zlmc.Text
       txtSQL = "insert dm_wzlb (lbcode,lb,lbcode1,lb1) values ('r','root','" & nodX.Key & "','" & zlmc.Text & "')"
           Set mrc = ExecuteSQL(txtSQL, MsgText)
  End If
  zlbh.Text = ""
  zlmc.Text = ""
  
End SubPrivate Sub cmdCancel_Click()
    Unload Me
End SubPrivate Sub cmdDelete_Click()
    Dim nodX As Node
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    If Trim(parText) <> "" Then
        With TreeView1
    
            If MsgBox("ê?·?é?3y" & .Nodes(parText).Text & "?", vbOKCancel, "?ˉ??") = vbOK Then
                txtSQL = "delete from dm_wzlb where lbcode1 = '" & Trim(.Nodes(parText).Key) & "'"
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                
                If .Nodes(parText).Parent Is Nothing Then
                    txtSQL = "delete from dm_wzlb where lbcode = '" & Trim(.Nodes(parText).Key) & "'"
                    Set mrc = ExecuteSQL(txtSQL, MsgText)
                End If
                
                TreeView1.Nodes.Clear
                
                ShowClass
            Else
                Exit Sub
            End If
        End With
    End If
    
End SubPrivate Sub Form_Load()    ShowClass
    
End SubPrivate Sub TreeView1_NodeCheck(ByVal Node As MSComctlLib.Node)
             parText = Node.Key
End Sub
Private Sub ShowClass()
    Dim txtSQL As String
    Dim MsgText As String
    Dim ssn As Variant
    Dim mrc As ADODB.Recordset
    txtSQL = "select lbcode1,lb1 from dm_wzlb where lbcode = 'r'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
   
    If Not mrc.EOF Then
        Do While Not mrc.EOF
            ssn = mrc.Fields(0)
            Set nodX = TreeView1.Nodes.Add(, tvwChild)
            nodX.Key = Trim(mrc.Fields(0))
            nodX.Text = Trim(mrc.Fields(1))
              treeshow (ssn)
            mrc.MoveNext
          
        Loop
        mrc.Close
    End If
    
    
End Sub
表名是：dm_wzlb
lbcode,lb,lbcode1,lb1
我说啊，lbcode是父节点的编号，lb是父节点的名称。lbcode1是节点的编号，也就是key的值。bl1当然就是节点的名称了。 以上只是参考,我实际用时的想法是:
级别

Answer 2

单一的treeview不能实现很好的效果,因为只能显示出ID来,不能显示名字,及其它信息,因此我考虑使用VSFLEXGRID控件来实现,此效果用MSHFLEXGRID应该也可以实现.
代码可能不是很实用,不过要实现此效果的朋友可以参考一下,因为我现在写的这个也暂时只能读节点,增,删,改,还有待实现!Private Sub Form_Load()
 Set Cnn = New ADODB.Connection
 Set Rst = New ADODB.Recordset
 Set RstSub = New ADODB.Recordset
 With fg
    
        ' layout
        .Rows = 1
        .Cols = 4
        .FixedCols = 0
        .ExtendLastCol = True
        .TextMatrix(0, 0) = "lbcode"
        .TextMatrix(0, 1) = "lb"
        .TextMatrix(0, 2) = "lbcode1"
        .TextMatrix(0, 3) = "lb1"
        .ColAlignment(-1) = flexAlignLeftTop
        .Editable = flexEDKbdMouse
                
        ' outline
        .OutlineCol = 0
        .OutlineBar = flexOutlineBarSimpleLeaf
        .MergeCells = flexMergeOutline
        
        ' other
        .AllowUserResizing = flexResizeColumns
        .AllowSelection = False
        .GridLines = flexGridFlatVert
    End With
    ReadRoot
End Sub
Private Sub ReadRoot()   '读所有的根结点
  Dim Rst1 As ADODB.Recordset
  Dim Rst2 As ADODB.Recordset
  Dim Sqlstring1 As String
  Dim Sqlstring2 As String
  Sqlstring1 = "select lbcode,lb,lbcode1,lb1 from test where lbcode='r'"   '程序规定顶层父结点必需为R
  Set Rst1 = ExecuteSQL(Sqlstring1)
  If Rst1.EOF = False Then
    Rst1.MoveFirst
    Do While Not Rst1.EOF   '判断此当前顶层结点是否为其它结点的父结点
     Sqlstring2 = "select lbcode,lb,lbcode1,lb1 from test where lbcode='" & Rst1!lbcode1 & " '"
     Set Rst2 = ExecuteSQL(Sqlstring2)
     If Rst2.EOF = False Then   '是其它层的父结点,则让此行为issubtotal行
       fg.AddItem Rst1!lbcode & vbTab & Rst1!lb & vbTab & Rst1!lbcode1 & vbTab & Rst1!lb1
       fg.IsSubtotal(fg.Rows - 1) = True
       myReadSub (Rst1!lbcode1)
     Else                       '不是其它层的父结点则直接增加一行
       fg.AddItem Rst1!lbcode & vbTab & Rst1!lb & vbTab & Rst1!lbcode1 & vbTab & Rst1!lb1
     End If
     Rst1.MoveNext
    Loop
 End If
End Sub
Private Sub myReadSub(subLB)     '读底层过程,同ReadRoot基本相同,根据readroot传来的某父结点的ID,求出所有子结点.使用了递归
  Dim Rst1 As ADODB.Recordset
  Dim Rst2 As ADODB.Recordset
  Dim Sqlstring1 As String
  Dim Sqlstring2 As String
  Sqlstring1 = "select lbcode,lb,lbcode1,lb1 from test where lbcode='" & subLB & " '"
  Set Rst1 = ExecuteSQL(Sqlstring1)
  If Rst1.EOF = False Then
    Do While Not Rst1.EOF
      Sqlstring2 = "select lbcode,lb,lbcode1,lb1 from test where lbcode='" & Rst1!lbcode1 & " '"
      Set Rst2 = ExecuteSQL(Sqlstring2)
      If Rst2.EOF = False Then
      fg.AddItem Rst1!lbcode & vbTab & Rst1!lb & vbTab & Rst1!lbcode1 & vbTab & Rst1!lb1
        fg.IsSubtotal(fg.Rows - 1) = True
        myReadSub (Rst1!lbcode1)
      Else
        fg.AddItem Rst1!lbcode & vbTab & Rst1!lb & vbTab & Rst1!lbcode1 & vbTab & Rst1!lb1
      End If
      Rst1.MoveNext
    Loop
 End If
End Sub