VB或VBA中使用API动态生成树控件

如题，想实现这样的功能，思路我有一些，但实际操作中不会弄，能不能给一些实例代码做参考呀，非常感谢

9 个解决方案

#1

标准树控件离不开 COMCTL32.ocx 或 MSCOMCTL.ocx，通过 API 调用比起直接引用来纯属多此一举。
如果完全自作树控件，没有现成的哪来的 API！

#2

我就是想通过API函数调用COMCTL32.ocx里面的控件，现在动画控件、跳表格控件和状态栏控件都有实例，只有树控件没有，而我恰恰遇到的就是树控件的问题

#3

MSDN 帮助中所有以 LVM_ 开头的消息都是，通过 SendMessage 调用。

#4

LVM_是  ListView  控件的消息吧？

#5

没错。
TreeView 应该是 TVM_ 开头的才是。

#6

api 做控件确实是一种自虐行为，除非真正需要

给你发点参考代码

    PG.n_hWndTreeList = CreateWindowEx(0&, "systreeview32", vbNullString, TVS_INFOTIP Or WS_CLIPSIBLINGS Or WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or TVS_HASBUTTONS Or TVS_HASLINES Or TVS_LINESATROOT Or TVS_SHOWSELALWAYS, 0, 0, ScaleWidth, ScaleHeight, UserControl.hWnd, 301, App.hInstance, ByVal 0&)
    SendMessage PG.n_hWndTreeList, TVM_SETBKCOLOR, ByVal 0&, ByVal iBackColor
    SendMessage PG.n_hWndTreeList, TVM_SETTEXTCOLOR, ByVal 0&, ByVal GetRegisterValue("Explorer_ForeColor", 0&)
    SendMessage PG.n_hWndTreeList, TVM_SETITEMHEIGHT, ByVal 18&, ByVal 0&
    SendMessage PG.n_hWndTreeList, WM_SETFONT, ByVal SendMessage(UserControl.hWnd, WM_GETFONT, ByVal 0&, ByVal 0&), ByVal 1&
    
    '// 创建图像列表
    PG.n_hImageList = ImageList_Create(16, 16, ILC_COLOR32, ByVal 0&, ByVal 0&)
'    ImageList_SetBkColor PG.n_hImageList, iBackColor

    
'    hBP.From = &HFF00FF: hBP.to = iBackColor
    '// 加载图像
    
    Dim i As Long
    For i = 0 To 13
'                hBitmap = CreateMappedBitmapA(App.hInstance, ByVal 101& + i&, 0, hBP, 1)
'                hBitmap = LoadImageID(App.hInstance, 101& + i&, IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR Or LR_DEFAULTSIZE Or LR_LOADTRANSPARENT Or LR_LOADMAP3DCOLORS)
        hBitmap = LoadBitmapAsId(App.hInstance, 101& + i)
        ImageList_Add PG.n_hImageList, hBitmap, 0&
        DeleteObject hBitmap
    Next

    
    Const TVSIL_NORMAL As Long = 0&
    SendMessage PG.n_hWndTreeList, TVM_SETIMAGELIST, ByVal TVSIL_NORMAL&, ByVal PG.n_hImageList&


'-－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 

Sub SelectNote(ByVal hItem As Long)
    
    '// 设置选定项
    Const TVGN_CARET = &H9&
    
    Dim tItem           As TV_ITEM
    tItem.State = TVIS_SELECTED
    tItem.Mask = TVIF_STATE Or TVIF_PARAM
    tItem.stateMask = TVIS_SELECTED

    SendMessage PG.n_hWndTreeList, TVM_SELECTITEM, ByVal TVGN_CARET&, ByVal hItem
    SendMessage PG.n_hWndTreeList, TVM_GETITEM, ByVal 0&, tItem
    PG.c_CurrentSelectObject = tItem.lParam
    
End Sub


Sub ExpandNote(ByVal ModuleStyle As FileClassStyle)
    
    
    Dim HandleOfRoot As Long
    
    If PG.n_FolderExeProject Then
        HandleOfRoot = PG.n_FolderExeProject
    ElseIf PG.n_FolderDLLProject Then
        HandleOfRoot = PG.n_FolderDLLProject
    Else: HandleOfRoot = PG.n_FolderVxdProject
    End If
    
    SendMessage PG.n_hWndTreeList, TVM_EXPAND, ByVal TVE_EXPAND&, ByVal HandleOfRoot&
    
        Select Case ModuleStyle
                Case File_ExeProject
                Case File_DLLProject
                Case File_VxdProject
                Case File_SdiForm, File_MdiForm: HandleOfRoot = PG.n_FolderForm
                Case File_Module: HandleOfRoot = PG.n_FolderModule
                Case File_Class: HandleOfRoot = PG.n_FolderClass
                Case File_Macro: HandleOfRoot = PG.n_FolderMacro
                Case File_Export: HandleOfRoot = PG.n_FolderExport
                Case File_Resource: HandleOfRoot = PG.n_FolderRes
                Case File_UserData: HandleOfRoot = PG.n_FolderUserFile
        End Select
    
'    SendMessage PG.n_hWndTreeList, TVM_SORTCHILDREN, ByVal 0&, ByVal HandleOfRoot&
    SendMessage PG.n_hWndTreeList, TVM_EXPAND, ByVal TVE_EXPAND&, ByVal HandleOfRoot&
        
End Sub



Function AddItem(ByVal ModuleStyle As FileClassStyle, ByVal ModuleName As String, Optional objForm As Object) As Long
    
    Dim Tvitem       As TV_INSERTSTRUCT
    Dim HandleOfRoot As Long
        
    On Error Resume Next
    PG.n_KeyChecker.Add ModuleName, objForm
    If Err.Number Then AddItem = 0: Exit Function
    On Error GoTo 0
    
    If PG.n_FolderExeProject Then
        HandleOfRoot = PG.n_FolderExeProject
    ElseIf PG.n_FolderDLLProject Then
        HandleOfRoot = PG.n_FolderDLLProject
    Else: HandleOfRoot = PG.n_FolderVxdProject
    End If
    
    With Tvitem
        
        .Item.pszText = StrPtr(StrConv(ModuleName, vbFromUnicode))
        .Item.cchTextMax = lstrlenA(ModuleName)
        .Item.iImage = ModuleStyle - 101
        .Item.Mask = TVIF_IMAGE Or TVIF_TEXT Or TVIF_PARAM Or TVIF_SELECTEDIMAGE Or TVIF_STATE
        .hInsertAfter = TVI_SORT
        .Item.State = TVIS_EXPANDED
        .hParent = HandleOfRoot
        .Item.lParam = -1
         CopyMemory .Item.lParam, objForm, 4
        .Item.iImage = ModuleStyle - 101
        .Item.iSelectedImage = .Item.iImage
        .Item.pszText = StrPtr(StrConv(ModuleName, vbFromUnicode))
        .Item.cchTextMax = lstrlenA(ModuleName)
         AddItem = SendMessage(PG.n_hWndTreeList, TVM_INSERTITEM, ByVal 0&, Tvitem)
          
    End With
    
    ExpandNote ModuleStyle
    
End Function

#7

崇拜会自己做控件的高手

#8

做控件的牛人

#9

6楼是自虐高手啊，哈哈，谢谢了