⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uctreeview.ctl

📁 星级酒店管理系统VB源代码
💻 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 + -