树菜单添加不同图标及字体添加加颜色

时　间:2017-12-12 07:46:31
作　者:大海   ID：42003  城市：深圳
摘　要:树菜单添加不同图标及字体添加加颜色
正　文:

树菜单添加不同图标及字体添加加颜色:

Private Sub Form_Load()
    Dim i As Integer
    Dim objTree As TreeView
    Dim objNode As Node
    Dim rst As DAO.Recordset
    Dim strParentID As String
    i = 1
    Set objTree = Me.TreeView0.Object
    objTree.Nodes.Clear
    objTree.Font.Name = "微软雅黑"
    objTree.Font.Size = 9
    Set objNode = objTree.Nodes.Add(, , "K", "(物资)", 37, 36)
    objNode.Expanded = True
    Set rst = CurrentDb.OpenRecordset("Select * FROM 物资分类表 orDER BY 编号", , dbReadOnly)
    Do Until rst.EOF
        If i = 38 Then i = 1
        Set objNode = objTree.Nodes.Add("K" & rst!父级, tvwChild, "K" & rst!编号, rst!分类名称, i, 36)
        objNode.Expanded = True
        rst.MoveNext
        i = i + 1
    Loop
    rst.Close
    Set rst = Nothing
    Set objTree = Nothing
    Set objNode = Nothing
    Call 树菜单加颜色
End Sub
Sub 树菜单加颜色()
    Dim objTree As TreeView
    Dim objNode As Node
    Dim k As Integer
    On Error Resume Next
    Set objTree = Me.TreeView0.Object
    For Each objNode In objTree.Nodes
        k = (Rnd() * 9)
        objNode.ForeColor = 随机选择(k)
        '        objTree.Font.Size = 13
        '        objTree.Font.Bold = True
    Next
    Set objTree = Nothing
End Sub
Function 随机选择(k As Integer)
    On Error Resume Next
    Dim ColorValue As Long
    Select Case k
    Case 0
        ColorValue = 0
    Case 1
        ColorValue = 255
    Case 2
        ColorValue = 65280
    Case 3
        ColorValue = 16711680
    Case 4
        ColorValue = 16711935
    Case 5
        ColorValue = 16776960
    Case 6
        ColorValue = 8388608
    Case 7
        ColorValue = 6684774
    Case 8
        ColorValue = 3355443
    Case 9
        ColorValue = 128
    End Select
    随机选择 = ColorValue
End Function

附   件:

点击下载此附件

图   示: