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)
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
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
End SubFunction 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
TreeView 应该是 TVM_ 开头的才是。
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 SubFunction 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