VB6:从Comctl.dll中加载TREEVIEW并美化OCX版本(修正)

给个图片及下载,大家多提意见!
.

.

,


,


下载测试:

NEW:
https://files.cnblogs.com/starwork/dsTreeView2.rar

OLD:

https://files.cnblogs.com/starwork/dsTreeView.rar

付一个加载TREEVIEW的方法:

新建一个自定义控件: MYTreeView,UserControl.AutoRedraw = True,UserControl.ScaleMode =3

MYTreeView代码开始:

Option Explicit

Private hTree As Long
Private iNodes As Long

Private Const ID_TREEVIEW = 1000

Private Type TvwNode
    hItem As Long
    hParent As Long
    Index As Long
    Key As String
    Text As String

    Tag As String
End Type

Private NodeX() As TvwNode

Public Enum RelationConstants
    tvwSort
    tvwFirst
    tvwLast
    tvwChild
End Enum

Private Const TV_FIRST = &H1100
Private Const TVM_GETITEM = (TV_FIRST + 12)
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVM_INSERTITEM = (TV_FIRST + 0)
Private Const TVM_SETITEM = (TV_FIRST + 13)

Private Const TVM_DELETEITEM = (TV_FIRST + 1)

Private Const TVS_HASBUTTONS = &H1
Private Const TVS_HASLINES = &H2
Private Const TVS_LINESATROOT = &H4

Private Const TVM_GETCOUNT = (TV_FIRST + 5)

Private Const TVIF_PARAM = &H4

Private Const TVIF_STATE = &H8
Private Const TVIF_TEXT = &H1

Private Const WS_BORDER = &H800000
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000

Private Type TVITEMEX
    mask As Long
    hItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
    iIntegral As Long
End Type

Private Type TVINSERTSTRUCT
    hParent As Long
    hInsertAfter As Long
    Item As TVITEMEX
End Type

Private Const TVI_ROOT = &HFFFF0000
Const TVGN_PARENT As Long = &H3

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (ByRef icx As tagINITCOMMONCONTROLSEX) As Long

Private Type tagINITCOMMONCONTROLSEX
    Size As Long
    InitWhat As Long
End Type

Private Const ICC_TREEVIEW_CLASSES = 2&

Private Sub CreateTree(hParent As Long)
    Dim hCont As Long
    hCont = CreateWindowEx(0&, "STATIC", "bTreeViewClass", WS_BORDER Or WS_VISIBLE Or WS_CHILD, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, hParent, 0, App.hInstance, 0)
    hTree = CreateWindowEx(0&, "SysTreeView32", "", WS_VISIBLE Or WS_CHILD Or TVS_HASLINES Or TVS_HASBUTTONS Or TVS_LINESATROOT, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, hCont, ID_TREEVIEW, App.hInstance, 0)

End Sub

Public Function TvwAddItem(hRelItem As Long, Relation As Long, Text As String) As Long

    Dim TVIN As TVINSERTSTRUCT, hRel As Long, TVI As TVITEMEX

    If hRelItem = 0 Then hRelItem = 0&

    If TypeName(hRelItem) = "Long" Then
        hRel = hRelItem

    End If

    TVIN.hParent = hRel

    TVIN.Item.mask = TVIF_TEXT Or TVIF_STATE
    TVIN.Item.pszText = Text & Chr$(0)
    TVIN.Item.cchTextMax = Len(Text) + 1

    If Relation = tvwChild Then
        TVIN.hParent = SendMessageLong(hTree, TVM_GETNEXTITEM, TVGN_PARENT, hRel)

    End If

    hRel = SendMessage(hTree, TVM_INSERTITEM, 0, TVIN)

    If hRel <> 0 Then

        SendMessage hTree, TVM_GETITEM, hRel, TVI
        TVI.mask = TVIF_PARAM
        TVI.lParam = hRel
        SendMessage hTree, TVM_SETITEM, hRel, TVI

        ReDim Preserve NodeX(iNodes)

        iNodes = iNodes + 1

    End If

    TvwAddItem = hRel

End Function

Public Function GetCount() As Long

    GetCount = SendMessage(hTree, TVM_GETCOUNT, TVGN_PARENT, &O0)

End Function

Public Sub ClearTree()
    LockWindow True, frmMain
    SendMessageLong hTree, TVM_DELETEITEM, 0, TVI_ROOT
    LockWindow False, frmMain
End Sub

Private Sub UserControl_Initialize()
    Dim icx As tagINITCOMMONCONTROLSEX

    icx.Size = Len(icx)
    icx.InitWhat = ICC_TREEVIEW_CLASSES

    InitCommonControlsEx icx

End Sub

Private Sub UserControl_Resize()
    CreateTree UserControl.hwnd
End Sub

 

加一个窗体:frmMain

放上Command1,及一个MYTreeView

代码开始:

Option Explicit
Dim LastParent As Long

Private Sub Command1_Click()
    DoLog MYTreeView1, "ABC", False, True
End Sub

Public Sub DoLog(tView As MYTreeView, LogText As String, IsChild As Boolean, Optional AddDate As Boolean = False)
    With tView
        If IsChild = False Then
            LastParent = tView.TvwAddItem(0, 0, LogText)
            If AddDate Then DoLog tView, "Time: " & Now, True, False
    End With
End Sub

 

以上为简单例子,希望大家做出更漂亮的效果来!谢谢!