程序人家

　　树形控件在大多数的系统中都会使用到。以其层次鲜明，操作简便的优点得到广大程序员以及使用人员的认可。不过，尽管树形控件操作比较简单，但是当与数据库结合的时候，操作会有一引起麻烦。
　　笔者将自己在实际应用过程中总结出来的代码编写成类，在以后使用的时候直接使用类就可以了。

代码如下：
首先，选择菜单－＞工程－＞添加类模块，输入以下代码：
option explicit
private m_treeview as treeview
public sub createtreeview(atreeview as object)
  set m_treeview = atreeview
end sub
'添加数据到treeview控件
public sub addtree(rs as recordset, aid as string, acontext as string, aparentid as string)
  dim xnod as node
 
  do while not rs.eof
    if rs.fields(aparentid) = 0 then
        '加入根结点
        set xnod = m_treeview.nodes.add(, , "key" & rs.fields(aid), rs.fields(acontext), 2)
    else
        '加入子节点
        set xnod = m_treeview.nodes.add("key" & rs.fields(aparentid), tvwchild, "key" & rs.fields(aid), rs.fields(acontext), 1)
    end if
    xnod.ensurevisible
    rs.movenext
  loop
end sub
'取得所有子结点的关键字
public function getsubnodekey(anode as node) as string
  dim strwhere as string
 
  getsubkey anode, strwhere
  if len(strwhere) > 0 then
    getsubnodekey = "id = " & mid(anode.key, 4) & " or " & left(strwhere, len(strwhere) - 4)
  else
    getsubnodekey = "id = " & mid(anode.key, 4)
  end if
end function
public sub getsubkey(anode as node, astrwhere as string)
  dim nodesub as node
  set nodesub = anode.child
  while not nodesub is nothing
    astrwhere = astrwhere & "id = " & mid(nodesub.key, 4) & " or "
    if nodesub.children > 0 then getsubkey nodesub, astrwhere
   
    set nodesub = nodesub.next
  wend
end sub

添加一窗口，为窗口添加一菜单，菜单项分别为：添加、修改、删除。菜单名分别为：mnuadd、mnumodify、mnudelete。
在窗口中添加一个treeview控件。
窗口代码如下：

option explicit
'工程--->引用--->microsoft activex data object 2.x library（版本号）
dim cn as adodb.connection
dim m_boladdflag as boolean
dim m_strkey as string, m_strparentkey as string
dim m_treeopt as new ctreeopt
private sub command1_click()
  dim rs as new adodb.recordset
 
  treeview1.nodes.clear
  rs.open "select * from tbtree", cn, adopendynamic, adlockreadonly
  m_treeopt.addtree rs, "id", "context", "parentid"
  rs.close
  set rs = nothing
end sub
private sub form_load()
on error goto errhandle
  set cn = new adodb.connection
  '连接数据库
  cn.connectionstring = "dbq=" & app.path & "\db1.mdb;defaultdir=" & _
    app.path & ";driver={microsoft access driver (*.mdb)};" & _
    "driverid=25;fil=ms access;implicitcommitsync=yes;" & _
    "maxbuffersize=512;maxscanrows=8;pagetimeout=5;safetransactions=0;" & _
    "threads=3;uid=admin;usercommitsync=yes;pwd=admind1234;"
  cn.open
 
  m_treeopt.createtreeview treeview1
  command1.value = true
 
  exit sub
errhandle:
  msgbox err.description, vbexclamation
end sub
private sub form_queryunload(cancel as integer, unloadmode as integer)
on error resume next
  cn.close
  set cn = nothing
  set m_treeopt = nothing
end sub
'添加结点
private sub mnuadd_click()
  dim rs as new adodb.recordset
 
  m_boladdflag = true
  if rs.state = adstateopen then rs.close

  rs.open "select iif (isnull (max(id)), 1, max(id)) as id_m from tbtree", cn, adopenstatic, adlockreadonly
  if rs.eof then
    m_strkey = "1"
  else
    m_strkey = cstr(rs!id_m + 1)
  end if
  with treeview1
    m_strparentkey = .selecteditem.key
    .nodes.add(m_strparentkey, tvwchild, "key" & m_strkey, "新加结点", 1).selected = true
    .startlabeledit
  end with
  rs.close
  set rs = nothing
end sub
'删除结点
private sub mnudelete_click()
  dim strwhere as string
 
  with treeview1
    if .selecteditem.key = "key1" then
        msgbox "对不起,不能删除根点!", vbexclamation
        exit sub
    end if
    strwhere = m_treeopt.getsubnodekey(.selecteditem)
    cn.execute "delete from tbtree where " & strwhere
    .nodes.remove .selecteditem.key
  end with
end sub
'修改结点
private sub mnumodify_click()
  m_boladdflag = false
 
  with treeview1
    m_strkey = mid(.selecteditem.key, 4)
    .startlabeledit
  end with
end sub
private sub treeview1_afterlabeledit(cancel as integer, newstring as string)
  cn.execute "update tbtree set context = '" & newstring & "' where id = " & m_strkey
end sub
private sub treeview1_beforelabeledit(cancel as integer)
  if m_boladdflag then
    dim strsql as string
   
    m_strparentkey = mid(m_strparentkey, 4)
    strsql = "insert into tbtree (id, context, parentid) values (" & m_strkey & ", '新加结点', " & m_strparentkey & ")"
    cn.execute strsql
  end if
end sub
private sub treeview1_mouseup(button as integer, shift as integer, x as single, y as single)
  if button = vbrightbutton then popupmenu mnupopup
end sub