有个问题，大家帮我想一想，谢谢

[online]

对treeview添加新类，和添加子类，并删除，并将分类存入数据库中
做了一个，老是有错误
已经两天了
大家有没有这方面的资料或demo
在线等待

[二师兄的老公]

?

[Azi03]

添加新类、字类什么意思

TreeView.nodes.add() ??

[online]

大学同学
------张三
------李斯
-------王五
高中同学
------张三
------李斯
-------王五
初中同学
------张三
------李斯
-------王五
就是以这样的层次显示出来，所有的信息报存在数据库中
当然了，这些都是可增可删的

[Azi03]

Call trvInfoClass.Nodes.Clear
Set curRecords = gConnection.Execute("SELECT Title,ID FROM tab_Info_class WHERE Parent_Id='-1'")
If curRecords.EOF = False Then
'如果类信息记录集不空，则将现有的类信息标题显示在树型视图中。
'否则，添加一条信息类根节点记录，ID为"00000000000000000001"，Title为"信息集合",Parent_Id为"-1"。
'并将此信息类根节点显示在树型视图中。
Set curNode = trvInfoClass.Nodes.Add(, , SJROOTKEY & Trim(CStr(curRecords.Fields("ID"))), Trim(CStr(curRecords.Fields("Title"))), 1, 1)
Call AddChildNodes(curNode)
curRecords.Close
Else
curRecords.Close
Set curRecords = New ADODB.Recordset
Call curRecords.Open("SELECT * FROM tab_Info_class WHERE Parent_Id='-1'", gConnection, adOpenDynamic, adLockPessimistic)
Call curRecords.AddNew
curRecords.Fields("ID") = "00000000000000000001"
curRecords.Fields("Parent_Id") = "-1"
curRecords.Fields("Title") = "信息集合"
Call curRecords.Update
Set curNode = trvInfoClass.Nodes.Add(, , SJROOTKEY & Trim(CStr(curRecords.Fields("ID").Value)), Trim(CStr(curRecords.Fields("Title"))), 1, 1)
Call curRecords.Close
End If


Public Sub AddChildNodes(ByRef rootNode As Node)
'递归显示树视图。
Dim curInfoClassRecords As ADODB.Recordset
Dim curNode As Node
Set curInfoClassRecords = gConnection.Execute("SELECT Title,ID FROM tab_Info_class WHERE Parent_Id='" & Right(rootNode.Key, Len(rootNode.Key) - 4) & "' and " & CURRENTQUERYCONDITION)
If curInfoClassRecords.EOF = True Then ' And curInfoCellRecords.EOF = True Then
curInfoClassRecords.Close
Exit Sub
End If
Do While curInfoClassRecords.EOF = False
Set curNode = trvInfoClass.Nodes.Add(rootNode, tvwChild, SJINFOCLASSKEY & curInfoClassRecords.Fields("ID").Value, curInfoClassRecords.Fields("Title"), 2, 3)
Call curInfoClassRecords.MoveNext
Call AddChildNodes(curNode)
Loop
curInfoClassRecords.Close
End Sub

[ivt]

Private Sub ListView1_Click()
Dim strlist As String
If ListView1.ListItems.Count = 0 Then Exit Sub
strlist = ListView1.SelectedItem.Text
'If rs14.Fields(0).Value = "" Then Exit Sub
'strlist = rs14.Fields(0).Value
If strlist <> "" Then
Set rs1 = New ADODB.Recordset
strsql = "select * from stu where 编号=cint(" & strlist & ")"
rs1.Open strsql, conn, adOpenStatic, adLockPessimistic
CoolEdit1.Text = rs1.Fields(4).Value
CoolEdit2.Text = rs1.Fields(3).Value
Combo1.Text = rs1!性别
CoolEdit3.Text = rs1!生日
CoolEdit4.Text = rs1!外号
CoolEdit5.Text = rs1!网名
CoolEdit6.Text = rs1!QQ
CoolEdit7.Text = rs1.Fields(10).Value
CoolEdit8.Text = rs1!个人主页
CoolEdit9.Text = rs1!电话
CoolEdit10.Text = rs1!工作单位
CoolEdit11.Text = rs1!联系地址
CoolEdit12.Text = rs1!备注
Combo2.Text = rs1!职业
Combo3.Text = rs1!系别
Combo4.Text = rs1!班级
End If
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

'ListView1.ColumnHeaders.Clear
'ListView1.ColumnHeaders.Add , , "编号"
'ListView1.ColumnHeaders.Add , , "学号"
'ListView1.ColumnHeaders.Add , , "姓名", , lvwColumnCenter
'ListView1.ColumnHeaders.Add , , "性别"
'ListView1.ColumnHeaders.Add , , "生日"
'ListView1.ColumnHeaders.Add , , "外号"
'ListView1.ColumnHeaders.Add , , "网名"
' ListView1.ColumnHeaders.Add , , "OICQ"
'ListView1.ColumnHeaders.Add , , "E妹儿"
' ListView1.ColumnHeaders.Add , , "个人主页"
'ListView1.ColumnHeaders.Add , , "联系电话"
'ListView1.ColumnHeaders.Add , , "工作单位"
'ListView1.ColumnHeaders.Add , , "职业"
'ListView1.ColumnHeaders.Add , , "联系地址"
'ListView1.ColumnHeaders.Add , , "备注"

bool = Not bool
If bool Then
ColumnHeader.Text = ColumnHeader.Text & "↑"
ListView1.SortOrder = lvwAscending '升序
Else
ColumnHeader.Text = ColumnHeader.Text & "↓"
ListView1.SortOrder = lvwDescending
End If
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
End Sub

Private Sub poptreeadd_Click()
'增加系别
Dim strdep
strdep = InputBox("请输入要增加系的名称。如计算机系", "添加系别")
If strdep <> "" Then
Set rs3 = New ADODB.Recordset
rs3.CursorLocation = adUseClient
strsql = "select * from dep where 系别='" & strdep & "'"
rs3.Open strsql, conn, adOpenStatic, adLockPessimistic
If rs3.EOF Then
If rs3.State = 1 Then rs3.Close
strsql = "insert into dep values('" & strdep & "')"
rs3.Open strsql, conn, adOpenStatic, adLockPessimistic

refreshtreeview ("a") '刷新显示treeview
addcombo34 '刷新显示combo34
Else
MsgBox "同一名称的系别已存在，请重新来过"
End If
End If
End Sub

Private Sub poptreeadd1_Click()
'增加班级
Dim strclass
strclass = InputBox("请输入要增加班级的名称。如98(1)班", "添加班级", "98(1)班")
If strclass <> "" Then
Set rs2 = New ADODB.Recordset
rs2.CursorLocation = adUseClient
strsql = "select * from class where 班级='" & strclass & "'"
rs2.Open strsql, conn, adOpenStatic, adLockPessimistic
If rs2.EOF Then
If rs2.State = 1 Then rs2.Close
strsql = "insert into class values('" & strclass & "')"
rs2.Open strsql, conn, adOpenStatic, adLockPessimistic

refreshtreeview ("a") '刷新显示treeview
addcombo34 '刷新显示combo34
Else
MsgBox "同一名称的班级已存在，请重新来过"
End If
End If
End Sub

Private Sub poptreedel_Click()
Dim strtree
'Dim strdep
If TreeView1.SelectedItem.Children <> 0 Then
If TreeView1.SelectedItem.Text = "井冈山师院" Then Exit Sub
strtree = TreeView1.SelectedItem.Text
If strtree = "" Then Exit Sub
If MsgBox("真的要删除吗？" & strtree & "同时会删除此系别所有同学", vbQuestion + vbYesNo, "提示") = vbYes Then
' If rs9.State = 1 Then rs9.Close
Set rs9 = New ADODB.Recordset
rs9.CursorLocation = adUseClient
strsql = "delete from stu where 系别='" & strtree & "'"
rs9.Open strsql, conn, adOpenStatic, adLockPessimistic
If rs9.State = 1 Then rs9.Close
strsql = "delete from dep where 系别='" & strtree & "'"
rs9.Open strsql, conn, adOpenStatic, adLockPessimistic

refreshtreeview ("a")
addcombo34
End If
End If
End Sub

Private Sub poptreedel1_Click()
Dim strtree
'Dim strclass
If TreeView1.SelectedItem.Children = 0 Then
strtree = TreeView1.SelectedItem.Text
If strtree = "" Then Exit Sub
If MsgBox("真的要删除吗？" & strtree & "同时会删除此班级所有同学", vbQuestion + vbYesNo, "提示") = vbYes Then
' If rs9.State = 1 Then rs9.Close
Set rs9 = New ADODB.Recordset
rs9.CursorLocation = adUseClient
strsql = "delete from stu where 班级='" & strtree & "'"
rs9.Open strsql, conn, adOpenStatic, adLockPessimistic
If rs9.State = 1 Then rs9.Close
strsql = "delete from class where 班级='" & strtree & "'"
rs9.Open strsql, conn, adOpenStatic, adLockPessimistic

refreshtreeview ("a")
addcombo34
End If
End If
End Sub

Private Sub poptreeexpend_Click()
Dim i
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(i).Expanded = True '展开所有节点
Next i
End Sub

Private Sub poptreemodi_Click()
Dim strtree
Dim strdep
If TreeView1.SelectedItem.Children <> 0 Then
If TreeView1.SelectedItem.Text = "井冈山师院" Then Exit Sub
strtree = TreeView1.SelectedItem.Text
strdep = InputBox("输入要修改后的系名，如计算机系", "修改", strtree)
If strdep = "" Then Exit Sub
Set rs8 = New ADODB.Recordset
rs8.CursorLocation = adUseClient
strsql = "update stu set 系别='" & strdep & "' where 系别='" & strtree & "'"
rs8.Open strsql, conn, adOpenStatic, adLockPessimistic
If rs8.State = 1 Then rs8.Close

strsql = "update dep set 系别='" & strdep & "' where 系别='" & strtree & "'"
rs8.Open strsql, conn, adOpenStatic, adLockPessimistic

refreshtreeview ("a")
addcombo34
End If
End Sub

[Azi03]

注意数据库的设计
ID为主键
ParentId为服节点的ID

[ivt]

Private Sub TreeView1_Click()
'If TreeView1.Nodes.Count = 0 Then Exit Sub
'ListView1.ListItems.Clear

'str = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)

' If str = "井冈山师院" Then
'strsql = "select 编号,学号,姓名,性别,生日,外号,网名,QQ,E-Mail,个人主页,电话,工作单位,职业,联系地址,备注 from stu"
' strsql = "select * from stu"
'refreshlistview (strsql)
' Else
' str1 = TreeView1.Nodes.Item(TreeView1.SelectedItem.Parent.Index)
' If str1 = "井冈山师院" Then
'strsql = "select 编号,学号,姓名,性别,生日,外号,网名,QQ,E-Mail,个人主页,电话,工作单位,职业,联系地址,备注 from stu where 系别='" & str & "'"
' strsql = "select * from stu where 系别='" & str & "'"
' refreshlistview (strsql)
' Else
'strsql = "select 编号,学号,姓名,性别,生日,外号,网名,QQ,E-Mail,个人主页,电话,工作单位,职业,联系地址,备注 from stu where 系别='" & str1 & "' and 班级='" & str & "'"
' strsql = "select * from stu where 系别='" & str1 & "' and 班级='" & str & "'"
' refreshlistview (strsql)
' End If
' End If
End Sub
Private Sub refreshtreeview(r As String)
Dim i As Integer
Dim j As Integer
i = 1
TreeView1.Nodes.Clear
'TreeView1.ImageList = ImageList2
TreeView1.LineStyle = tvwRootLines
TreeView1.ImageList = ImageList2 '链接图像列
TreeView1.Style = tvwTreelinesPlusMinusPictureText
Set nodex = TreeView1.Nodes.Add(, , r, "井冈山师院")
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
strsql = "select 系别 from dep"
rs.Open strsql, conn, adOpenStatic, adLockPessimistic

'rs.MoveFirst
Do While Not rs.EOF
' MsgBox "a" & i
Set nodex = TreeView1.Nodes.Add(r, tvwChild, Chr(i), rs.Fields(0), 1)
rs.MoveNext
i = i + 1
Loop
If rs.State = 1 Then rs.Close
For j = 2 To TreeView1.Nodes.Count
'Set rs = New ADODB.Recordset
strsql = "select * from class"
rs.Open strsql, conn, adOpenStatic, adLockPessimistic
'rs.MoveFirst
Do While Not rs.EOF
'If TreeView1.Nodes(j).Text = rs!部门 Then
Set nodex = TreeView1.Nodes.Add(TreeView1.Nodes(j).Key, tvwChild, , rs.Fields(0), 2)
'End If
rs.MoveNext
Loop
rs.Close
Next

'Dim i
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(i).Expanded = True '展开所有节点
Next i
End Sub
Private Sub refreshlistview(sqlstr As String)
Dim strsql
ListView1.ListItems.Clear
strsql = sqlstr
Set rs14 = New ADODB.Recordset
rs14.Open strsql, conn, adOpenStatic, adLockPessimistic
'rs.MoveFirst
Do While Not rs14.EOF
Set itemx = ListView1.ListItems.Add(1, , CStr(rs14!编号))
If Not IsNull(rs14!学号) Then
itemx.SubItems(1) = rs14!学号
End If
If Not IsNull(rs14!姓名) Then
itemx.SubItems(2) = rs14!姓名
End If
'itemx.SubItems(3) = rs14.Fields(3).Value
'itemx.SubItems(4) = rs14.Fields(4).Value
itemx.SubItems(3) = rs14.Fields(5).Value
itemx.SubItems(4) = rs14.Fields(6).Value
itemx.SubItems(5) = rs14.Fields(7).Value
itemx.SubItems(6) = rs14.Fields(8).Value
itemx.SubItems(7) = rs14.Fields(9).Value
itemx.SubItems(8) = rs14.Fields(10).Value
itemx.SubItems(9) = rs14.Fields(11).Value
itemx.SubItems(10) = rs14.Fields(12).Value
itemx.SubItems(11) = rs14.Fields(13).Value
itemx.SubItems(12) = rs14.Fields(14).Value
itemx.SubItems(13) = rs14.Fields(15).Value
itemx.SubItems(14) = rs14.Fields(16).Value
rs14.MoveNext
Loop
If Not rs14.EOF Then rs14.MoveFirst
'rs.Close
End Sub


Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim i As Integer
'If TreeView1.SelectedItem.Children = 0 Then '检查是否有子节点,0为无
'For i = 1 To TreeView1.Nodes.Count
'If TreeView1.Nodes(i).Selected Then
'MsgBox "您选择的是：“" & TreeView1.Nodes(i).FullPath & "”子节点！"
'系统提示
'End If
'Next i
'End If

If TreeView1.SelectedItem.Children = 0 Then
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then
str = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)
str1 = TreeView1.Nodes.Item(TreeView1.SelectedItem.Parent.Index)
ListView1.ListItems.Clear
' MsgBox str & Space(2) & str1
strsql = "select * from stu where 系别='" & str1 & "' and 班级='" & str & "'"
refreshlistview (strsql)
End If
Next i
End If
End Sub

在CSDN中下载本人的校友录（纯绿色软件），上面为它的源代码
仅供参考

[用户 昵称]

cool
learning

[snoweagle]

Add 方法（Nodes 集合）
在 Treeview 控件的 Nodes 集合中添加一个 Node 对象也就是一个节点。

语法

object.Add(relative, relationship, key, text, image, selectedimage)

Add 方法的语法包含下面部分：

部分 描述
object 必需的。对象表达式，其值是“应用于”列表中的一个对象
relative 可选的。已存在的 Node 对象的索引号或键值。新节点与已存在的节点间的关系，可在下一个参数 relationship 中找到。
relationship 可选的。指定的 Node 对象的相对位置，如设置值中所述。
key 可选的。唯一的字符串，可用于用 Item 方法检索 Node。
text 必需的。在 Node 中出现的字符串。
image 可选的。在关联的 ImageList 控件中的图像的索引。
selectedimage 可选的。在关联的 ImageList 控件中的图像的索引，在 Node 被选中时显示。


设置值

relationship 的设置值是：

常数 值 描述
tvwFirst 0 首的节点。该 Node 和在 relative 中被命名的节点位于同一层，并 位于所有同层节点之前。
tvwLast 1 最后的节点。该 Node 和在 relative 中被命名的节点位于同一层，并 位于所有同层节点之后。任何连续地添加的节点可能位于最后添加的节点之后
tvwNext 2 （缺省）下一个节点。该 Node 位于在 relative 中被命名的节点之后。
tvwPrevious 3 前一个节点。该 Node 位于在 relative 中被命名的节点之前。
tvwChild 4 （缺省）子节点。该 Node 成为在 relative 中被命名的
节点的子节点。

With TreeView1
.Nodes.Add , , "r1", "root1" '增加关键字为"r1"的根结点
.Nodes.Add , , "r2", "root2" '增加关键字为"r2"的根结点
.Nodes.Add "r1", tvwChild, "r11", "root1_1" '增加关键字为"r11"的结点 ，并且与"r1"是子关系
.Nodes.Add "r1", tvwChild, "r12", "root1_2" '增加关键字为"r12"的结点 ，并且与"r1"是子关系
End With


增加根结点可用add

[online]

大家好，这个问题解决了，贴出我的源码，谢谢大家的帮助
Private DataCategories As Recordset


Private Sub Fill_TreeCategories()

Dim strManagerName As String
Dim strTeamMemberName As String

Tvwcatalog.Nodes.Clear

Dim rscata As Recordset
Set rscata = New Recordset

rscata.Open "select * from catalog order by id ", db, adOpenKeyset, adLockOptimistic

Tvwcatalog.Nodes.Add , , "藏品分类", "藏品分类", 1
Tvwcatalog.Nodes(1).Selected = True
Tvwcatalog.Nodes(1).Expanded = True

If rscata.RecordCount = 0 Then
Exit Sub
End If

With rscata

.MoveFirst
' strTeamMemberName = .Fields("catid")
' Call AddRootNode(strTeamMemberName)
Do Until .EOF
' .MoveNext
strTeamMemberName = .Fields("catid")
strManagerName = .Fields("catalog")
' Tvwcatalog.Nodes.Add "C", _
' tvwChild, _
' .Fields("catalog"), _
' .Fields("catalog"), _
' 1, 1
'Input #iFileNum, strTeamMemberName, strManagerName '将数据读入两个变量

'Call AddRootNode(strTeamMemberName)

'While Not EOF(iFileNum)
' Input #iFileNum, strTeamMemberName, strManagerName
Call AddNode(strTeamMemberName, strManagerName)
.MoveNext
Loop
.MoveLast
End With

Tvwcatalog.Nodes(1).Expanded = True

End Sub

Sub AddRootNode(strManagerName As String)
Dim ndNewNode As Node
Set ndNewNode = Tvwcatalog.Nodes.Add(, , strManagerName, strManagerName, 1, 2)

End Sub

Sub AddNode(strTeamMemberName As String, strManagerName As String)
' Adds a node to the treeview given a managers name and the Team members name

Dim ndNewNode As Node
Set ndNewNode = Tvwcatalog.Nodes.Add(strManagerName, tvwChild, _
strTeamMemberName, _
strTeamMemberName, 2, 3)
End Sub

Private Sub Command1_Click()
Dim rscata As Recordset
Set rscata = New Recordset


rscata.Open "select * from catalog", db, adOpenStatic, adLockOptimistic

'If Tvwcatalog.SelectedItem.Key = "" And Tvwcatalog.Nodes.Count = 0 Then
' 'MsgBox "", vbInformation, "Add Category"
' Exit Sub
'End If
Dim strname As String
Dim Resp As String
Resp = InputBox("请键入分类名(最大为50个字符):", "增加分类", "在这里输入你的分类")

With rscata

' .MoveFirst
' strTeamMemberName = .Fields("catid")
' Call AddRootNode(strTeamMemberName)
Do Until .EOF
' .MoveNext
strname = .Fields("catid")
If Trim(Resp) = strname Then
MsgBox "这个分类已经存在了", vbInformation, "系统提示"
Exit Sub
End If
.MoveNext
Loop
End With

If IsNumeric(Left(Resp, 1)) = True Then
MsgBox "分类不允许数字开头", vbInformation, "系统提示"
Exit Sub
End If

If InStr(1, Resp, Chr(39)) Then

MsgBox "字符[']不能接受", vbInformation, "增加分类"

' Call Commands_ButtonClick(Commands.Buttons("Add_Cat"))
Exit Sub

End If

If Trim(Resp) = "" Then Exit Sub


Dim ndroot As Node
Set ndroot = Tvwcatalog.Nodes.Item(1)
Set nd = ndroot.Child
rscata.AddNew
rscata.Fields("catid") = Left(Trim(Resp), 50)
rscata.Fields("catalog") = ndroot.Text
rscata.Update

Fill_TreeCategories

End Sub

Private Sub Command2_Click()

Dim ndtemp As Node
Dim strMemberName As String
Dim rscata As Recordset
Set rscata = New Recordset

If Tvwcatalog.SelectedItem.Text = "藏品分类" Then
MsgBox "请选择类别", vbInformation, "系统信息"
Exit Sub
End If


rscata.Open "select * from catalog", db, adOpenStatic, adLockOptimistic

On Error GoTo errhandler
strMemberName = InputBox("请键入子类名(最大字符为50) :", _
"增加子类", _
"请输入你的新的子类名称")

If IsNumeric(Left(strMemberName, 1)) = True Then
MsgBox "分类不允许数字开头", vbInformation, "系统提示"
Exit Sub
End If

If InStr(1, strMemberName, Chr(39)) Then

MsgBox "Character ['] not accepted", _
vbInformation, _
"Add SubCategory"
Exit Sub

End If

If Trim(strMemberName) = "" Then Exit Sub

With rscata

.MoveFirst

Do Until .EOF
' .MoveNext
strname = .Fields("catid")
If Trim(strMemberName) = strname Then
MsgBox "这个子类已经存在了", vbInformation, "系统提示"
Exit Sub
End If
.MoveNext
Loop
End With

rscata.MoveLast
rscata.AddNew
rscata.Fields("catid") = Left(Trim(strMemberName), 50)
rscata.Fields("catalog") = Tvwcatalog.SelectedItem.Text
rscata.Update

Fill_TreeCategories

' TreeView.Nodes("C" & ID).Selected = True
' TreeView.Nodes("C" & ID).EnsureVisible
Exit Sub
errhandler:
If Err = 91 Then MsgBox "You must select a Manager for the New Employee"
Resume exitlabel
exitlabel:


End Sub

Private Sub Command3_Click()
Dim ndTempNode As Node
'Set ndTempNode = ndNode.Child

If Tvwcatalog.SelectedItem.Text = "藏品分类" Then
MsgBox "根类不允许删除", vbInformation, "系统信息"
Exit Sub
End If

'Tvwcatalog.Nodes.Remove Tvwcatalog.SelectedItem.Text

If Tvwcatalog.SelectedItem.Children <> 0 Then

Dim response As String

If MsgBox("如果你要删除所选择的类别，将会删除此类别下面的所有子类", vbQuestion + vbYesNo, "提示") = vbYes Then

db.BeginTrans
db.Execute "delete from catalog where catid='" & Trim(Tvwcatalog.SelectedItem.Text) & "'"
db.Execute "delete from catalog where catalog='" & Trim(Tvwcatalog.SelectedItem.Text) & "'"
db.CommitTrans
Else
Exit Sub
End If

Else
db.BeginTrans
db.Execute "delete from catalog where catid='" & Trim(Tvwcatalog.SelectedItem.Text) & "'"
db.CommitTrans
End If

Fill_TreeCategories
End Sub

Private Sub Command5_Click()

Dim frm As New Frmwwlr
frm.Txtcpfl.Text = Label1.Caption
frm.Txtcpfl.Refresh
Me.Hide
End Sub

Private Sub Form_Load()
Fill_TreeCategories
End Sub


Private Sub Tvwcatalog_NodeClick(ByVal Node As MSComctlLib.Node)


DoEvents

Tvwcatalog.SelectedItem.Expanded = True

Label1.Caption = Tvwcatalog.SelectedItem.FullPath

End Sub


Private Sub Tvwcatalog_DragOver(Source As Control, X As Single, Y As Single, State As Integer)

Set Tvwcatalog.DropHighlight = Tvwcatalog.HitTest(X, Y)

End Sub