listtreeview.ctl
来自「很好！ 很实用！ 免费！」· CTL 代码 · 共 436 行 · 第 1/2 页
CTL
436 行
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.UserControl ListTreeView
ClientHeight = 2850
ClientLeft = 0
ClientTop = 0
ClientWidth = 4815
ScaleHeight = 2850
ScaleWidth = 4815
ToolboxBitmap = "ListTreeView.ctx":0000
Begin MSComctlLib.TreeView TreeView1
Height = 2295
Left = 0
TabIndex = 2
Top = 240
Visible = 0 'False
Width = 2415
_ExtentX = 4260
_ExtentY = 4048
_Version = 393217
HideSelection = 0 'False
Indentation = 176
LabelEdit = 1
Style = 7
Appearance = 1
End
Begin VB.CommandButton cmdList
Caption = ".."
Height = 255
Left = 2280
TabIndex = 1
Top = 0
Width = 255
End
Begin VB.TextBox txtList
Height = 285
Left = 0
TabIndex = 0
Top = 0
Width = 2535
End
Begin MSComctlLib.ImageList ImageList1
Left = 3120
Top = 840
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":0532
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":0984
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":0DD6
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":1228
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":167A
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "ListTreeView.ctx":1ACC
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "ListTreeView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Property Variables:
Dim m_Type As Integer
Dim m_ID As String
Dim m_No As String
Dim m_Name As String
'Event Declarations:
Event Click() 'MappingInfo=txtList,txtList,-1,Click
Event Change() 'MappingInfo=txtList,txtList,-1,Click
Event Selected() 'MappingInfo=txtList,txtList,-1,Click
Event DblClick() 'MappingInfo=txtList,txtList,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=txtList,txtList,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=txtList,txtList,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=txtList,txtList,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) 'MappingInfo=txtList,txtList,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) 'MappingInfo=txtList,txtList,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single) 'MappingInfo=txtList,txtList,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
Private m_UserControlWidth As Long
Private Sub cmdList_Click()
If TreeView1.Nodes.Count = 0 Then
Call getFirstNode '因为没有了ROOT节点，所以用此过程生成最初的结点
End If
'TreeView1.ZOrder = 1
m_UserControlWidth = UserControl.Width
TreeView1.Width = UserControl.Width
TreeView1.Top = txtList.Height
TreeView1.Left = 0
TreeView1.Visible = True
TreeView1.SetFocus
UserControl.Height = txtList.Height + TreeView1.Height
selectNode m_ID
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
ForeColor = UserControl.ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
UserControl.ForeColor() = New_ForeColor
PropertyChanged "ForeColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
BackStyle = UserControl.BackStyle
End Property
Public Property Let BackStyle(ByVal New_BackStyle As Integer)
UserControl.BackStyle() = New_BackStyle
PropertyChanged "BackStyle"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
BorderStyle = UserControl.BorderStyle
End Property
Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
UserControl.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
UserControl.Refresh
End Sub
Private Sub TreeView1_DblClick()
Dim objTemp As Object
Dim rsObjTemp As ADODB.Recordset
If TreeView1.SelectedItem Is Nothing Then
Exit Sub
End If
If TreeView1.SelectedItem.Tag > 0 Then
Select Case m_Type
Case vbListTreeViewArea
txtList.Text = TreeView1.SelectedItem.Text
m_No = TreeView1.SelectedItem.Tag
m_ID = TreeView1.SelectedItem.Key
TreeView1_LostFocus
Case Else
txtList.Text = TreeView1.SelectedItem.Text
m_ID = TreeView1.SelectedItem.Key
m_No = TreeView1.SelectedItem.Tag
TreeView1_LostFocus
End Select
End If
End Sub
Private Sub TreeView1_LostFocus()
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?