listtreeview.ctl

来自「很好！ 很实用！ 免费！」· CTL 代码 · 共 436 行 · 第 1/2 页

    UserControl.Height = txtList.Height
    TreeView1.Visible = False
    RaiseEvent Selected
End Sub
Private Sub selectNode(ByVal iTreeID As String)
    Dim xNode As Node
    If iTreeID = "" Then Exit Sub
    
    For Each xNode In TreeView1.Nodes
        If xNode.Key = iTreeID Then
            xNode.Selected = True
            Exit For
        End If
    Next
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim rsTemp As ADODB.Recordset
Dim tmpNode As Node
    If Node.Children > 0 Then Exit Sub

    Select Case iType
        Case vbListTreeView.vbListTreeViewArea
            Set rsTemp = g_System.Area.GetList("ID,No,Name", "ParentID=" + CheckString(Node.Key))  '调用类模块查询子节点
            Do While Not rsTemp.EOF
                Set tmpNode = TreeView1.Nodes.Add(Node.index, 4, rsTemp("ID").value, rsTemp("No").value + "-" + rsTemp("Name"), 2, 2)
                tmpNode.Tag = rsTemp("No").value
                rsTemp.MoveNext
            Loop
            rsTemp.Close
            Set rsTemp = Nothing
            Node.Expanded = True
        
    End Select
End Sub

Private Sub txtList_Change()
    RaiseEvent Change
End Sub

Private Sub txtList_Click()
    RaiseEvent Click
End Sub

Private Sub txtList_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub txtList_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub txtList_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub txtList_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub txtList_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, x, Y)
End Sub

Private Sub txtList_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, x, Y)
End Sub

Private Sub txtList_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, x, Y)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtList,txtList,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "Returns/sets the text contained in the control."
    Text = txtList.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    txtList.Text() = New_Text
    PropertyChanged "Text"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=cmdList,cmdList,-1,Caption
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
    Caption = cmdList.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    cmdList.Caption() = New_Caption
    PropertyChanged "Caption"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Appearance
Public Property Get Appearance() As Integer
Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
    Appearance = UserControl.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
    UserControl.Appearance() = New_Appearance
    PropertyChanged "Appearance"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,0
Public Property Get ItemID() As String
Attribute ItemID.VB_Description = "存放对话框所得的ID"
    ItemID = m_ID
End Property

Public Property Get ItemNo() As String
    ItemNo = m_No
End Property

Public Property Get ItemName() As String
    ItemName = m_Name
End Property

Public Property Let ItemID(ByVal New_ID As String)
    m_ID = New_ID
    PropertyChanged "ItemID"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtList,txtList,-1,MaxLength
Public Property Get MaxLength() As Long
Attribute MaxLength.VB_Description = "Returns/sets the maximum number of characters that can be entered in a control."
    MaxLength = txtList.MaxLength
End Property

Public Property Let MaxLength(ByVal New_MaxLength As Long)
    txtList.MaxLength() = New_MaxLength
    PropertyChanged "MaxLength"
End Property

Private Sub UserControl_Initialize()
    TreeView1.ImageList = ImageList1
End Sub
'因为没有了ROOT节点，所以用此过程生成最初的结点
Private Sub getFirstNode()
Dim rsTemp  As ADODB.Recordset
Dim tmpNode As Node
    Select Case iType
        Case vbListTreeView.vbListTreeViewArea
            Set rsTemp = g_System.Area.GetList("ID,No,Name", "ParentID is null") '调用类模块查询子节点
            Do While Not rsTemp.EOF
                Set tmpNode = TreeView1.Nodes.Add(, , rsTemp("ID").value, rsTemp("No").value + "-" + rsTemp("Name"), 2, 2)
                tmpNode.Tag = rsTemp("No").value
                rsTemp.MoveNext
            Loop
            rsTemp.Close
            Set rsTemp = Nothing
    End Select
End Sub
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    txtList.Text = PropBag.ReadProperty("Text", "")
    cmdList.Caption = PropBag.ReadProperty("Caption", "..")
    UserControl.Appearance = PropBag.ReadProperty("Appearance", 1)
    txtList.MaxLength = PropBag.ReadProperty("MaxLength", 0)
End Sub

Private Sub UserControl_Resize()
    If TreeView1.Visible = False Then
        txtList.Height = UserControl.Height
        cmdList.Height = UserControl.Height
    End If
    
    txtList.Top = 0
    txtList.Left = 0
    txtList.Width = UserControl.Width - cmdList.Width
    cmdList.Left = UserControl.Width - cmdList.Width
    If m_UserControlWidth > 0 Then
        UserControl.Width = m_UserControlWidth
    End If
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("Text", txtList.Text, "")
    Call PropBag.WriteProperty("Caption", cmdList.Caption, "..")
    Call PropBag.WriteProperty("Appearance", UserControl.Appearance, 1)
    Call PropBag.WriteProperty("MaxLength", txtList.MaxLength, 0)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get iType() As vbListTreeView
    iType = m_Type
End Property

Public Property Let iType(ByVal New_iType As vbListTreeView)
    m_Type = New_iType
    PropertyChanged "iType"
End Property