📄 uctreeview.ctl
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl UCTreeView
ClientHeight = 5685
ClientLeft = 0
ClientTop = 0
ClientWidth = 4740
PropertyPages = "UCTreeView.ctx":0000
ScaleHeight = 5685
ScaleWidth = 4740
Begin VB.PictureBox picTab
Height = 3855
Index = 0
Left = 360
ScaleHeight = 3795
ScaleWidth = 3615
TabIndex = 1
Top = 660
Width = 3675
Begin MSComctlLib.TreeView tvwPublishers
Height = 3615
Left = 120
TabIndex = 4
Top = 120
Width = 3315
_ExtentX = 5847
_ExtentY = 6376
_Version = 393217
Style = 7
Appearance = 1
End
End
Begin VB.PictureBox picTab
Height = 3915
Index = 2
Left = 660
ScaleHeight = 3855
ScaleWidth = 3795
TabIndex = 3
Top = 1080
Width = 3855
End
Begin VB.PictureBox picTab
Height = 3915
Index = 1
Left = 480
ScaleHeight = 3855
ScaleWidth = 3795
TabIndex = 2
Top = 840
Width = 3855
End
Begin MSComctlLib.TabStrip TabStrip1
Height = 5655
Left = 0
TabIndex = 0
Top = 0
Width = 4635
_ExtentX = 8176
_ExtentY = 9975
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 3
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "a"
Key = "a"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "b"
Key = "b"
ImageVarType = 2
EndProperty
BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "c"
Key = "c"
ImageVarType = 2
EndProperty
EndProperty
End
End
Attribute VB_Name = "UCTreeView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Private Sub TabStrip1_Click()
Dim pic As PictureBox
For Each pic In picTab
pic.Visible = (pic.Index = TabStrip1.SelectedItem.Index - 1)
Next
End Sub
Private Sub tvwPublishers_NodeClick(ByVal Node As MSComctlLib.Node)
If IsNumeric(Node.Tag) Then
myIndex = Node.Tag
End If
End Sub
Private Sub UserControl_Initialize()
Dim pic As PictureBox
' Show the database.
On Error Resume Next
cn.Open "DSN=DM;UID=;PWD=;"
If Err Then
MsgBox "Unable to database ", vbCritical
End
End If
For Each pic In picTab
pic.Move TabStrip1.ClientLeft, TabStrip1.ClientTop, TabStrip1.ClientWidth, TabStrip1.ClientHeight
pic.BorderStyle = 0
Next
DatabaseRefresh
End Sub
Private Sub UserControl_Resize()
tvwPublishers.Move 0, 9, ScaleWidth, ScaleHeight
End Sub
Private Sub DatabaseRefresh()
On Error Resume Next
' Open the Authors recordset.
rs.Open "文档信息表", cn, adOpenForwardOnly, adLockReadOnly
If Err Then
MsgBox "Unable to open Publishers table", vbCritical
End
End If
' Build the treeview control.
Dim rootNode As Node, nd As Node
' Add the "Publishers" root (expanded).
Set rootNode = tvwPublishers.Nodes.Add(, , "\\Publishers", "Publishers")
rootNode.Expanded = True
' Add all the publishers, with a plus sign.
Do Until rs.EOF
Set nd = tvwPublishers.Nodes.Add(rootNode.Key, tvwChild, , rs.Fields("主题"))
' We can't use PubID as the Key, because it is a number.
nd.Tag = rs.Fields("主题")
AddDummyChild nd
rs.MoveNext
Loop
rs.Close
End Sub
Sub AddDummyChild(nd As Node)
' add a dummy child node, if necessary
If nd.Children = 0 Then
' dummy nodes' Text property is "***"
tvwPublishers.Nodes.Add nd.Index, tvwChild, , "***"
End If
End Sub
Private Sub tvwPublishers_Expand(ByVal Node As MSComctlLib.Node)
' a node if being expanded
Dim nd As Node
' exit if the node had been already expanded in the past
If Node.Children = 0 Or Node.Children > 1 Then Exit Sub
' also exit if it doesn't have a dummy child node
If Node.Child.Text <> "***" Then Exit Sub
' remove the dummy child item
tvwPublishers.Nodes.Remove Node.Child.Index
' add all the titles for this Node object
AddTitles Node
End Sub
Private Sub AddTitles(ByVal Node As MSComctlLib.Node)
Dim nd As Node
' Show all the titles for the expanded publishers.
rs.Open "Select 编号, 标题 From 文档信息表 Where 主题 = '" & Node.Tag & "'", cn, adOpenForwardOnly, adLockReadOnly
Do Until rs.EOF
Set nd = tvwPublishers.Nodes.Add(Node, tvwChild, , rs.Fields("标题"))
nd.Tag = rs.Fields("编号")
rs.MoveNext
Loop
rs.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -