Option Explicit

'=-=-=-=增加API声明，by kmlxk=-=-=-=
Private Type InitCommonControlsEx
    dwSize As Long 'size of this structure
    dwICC As Long 'flags indicating which classes to be initialized
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (ByRef TLPINITCOMMONCONTROLSEX As InitCommonControlsEx) As Long
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Declare Function CreateWindowEx Lib "user32.dll" 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 DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SendLongMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

Private Const ICC_LISTVIEW_CLASSES = &H1
Private Const WC_LISTVIEW = "SysListView32"
Private Const WS_EX_CLIENTEDGE = &H200

Private Const LVS_LIST = &H3
Private Const LVS_REPORT = &H1

Private Const LVS_EX_FULLROWSELECT = &H20
Private Const LVS_EX_CHECKBOXES = &H4
Private Const LVS_EX_GRIDLINES = &H1
Private Const LVS_SORTDESCENDING = &H20

Private Const LVM_FIRST = &H1000
Private Const LVM_SETBKCOLOR = (LVM_FIRST + 1)
Private Const LVM_SETTEXTBKCOLOR = (LVM_FIRST + 38)
Private Const LVM_INSERTCOLUMN = (LVM_FIRST + 27)
Private Const LVM_INSERTITEM = (LVM_FIRST + 7)
Private Const LVM_ENSUREVISIBLE = (LVM_FIRST + 19)

Private Const LVM_GETITEMTEXT = (LVM_FIRST + 45)
Private Const LVM_SETITEMTEXT = (LVM_FIRST + 46)        ' 插入列表项子项
Private Const LVM_GETITEM = (LVM_FIRST + 5)
Private Const LVM_SETITEM = (LVM_FIRST + 6)

Private Const LVM_GETNEXTITEM = (LVM_FIRST + 12)
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)

Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54)  ' 设置列表视图的扩展风格
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)        ' 取得 ListView 项目记数
Private Const LVM_DELETEITEM = (LVM_FIRST + 8)
'----------------------------------------------------------

' 列表头 of Info
'-----------------------------------------------------------
Private Type LVCOLUMN
    mask As Long
    fmt As Long
    CX As Long
    pszText As String
    cchTextMax As Long
    iSubItem As Long
    iImage As Long
    iOrder As Long
End Type

'-------------------------------------------------------

' LVCOLUMN mask 列表头
Private Const LVCF_FMT = &H1        ' FMT 为有效
Private Const LVCF_WIDTH = &H2      ' 宽度有效
Private Const LVCF_TEXT = &H4       ' 文字有效
Private Const LVCF_SUBITEM = &H8    ' 子项有效
Private Const LVCF_IMAGE = &H10     ' 图片有效

' LVCOLUMN fmt 列表头
Private Const LVCFMT_LEFT = &H0     ' 文字左对齐
Private Const LVCFMT_RIGHT = &H1    ' 文字右对齐
Private Const LVCFMT_CENTER = &H2   ' 文字中对齐
Private Const LVCFMT_JUSTIFYMASK = &H3
Private Const LVCFMT_IMAGE = &H800
Private Const LVCFMT_BITMAP_ON_RIGHT = &H1000
Private Const LVCFMT_COL_HAS_IMAGES = &H8000
'--------------------------------------------------------
' List View Item Info 列表项
'--------------------------------------------------------
Private Type LVITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

' LVITEM mask
Private Const LVIF_TEXT = &H1               ' 文字有效
Private Const LVIF_IMAGE = &H2              ' 图片有效
Private Const LVIF_PARAM = &H4              ' 排序有效
Private Const LVIF_STATE = &H8              ' 状态(情形)有效
Private Const LVIF_INDENT = &H10            ' 图象缩进有效
Private Const LVIF_NORECOMPUTE = &H800

' LVITEM state
Private Const LVIS_FOCUSED = &H1            '
Private Const LVIS_SELECTED = &H2
Private Const LVIS_CUT = &H4
Private Const LVIS_DROPHILITED = &H8
Private Const LVIS_ACTIVATING = &H20
Private Const LVIS_SELCHECK = &H2000
Private Const LVIS_OVERLAYMASK = &HF00
Private Const LVIS_STATEIMAGEMASK = &HF000
'----------------------------------------------------------
Private N As Long
Private hwndLV As Long

Public Function CreateListView(hWndParent As Long, ID As Long, x&, y&, nWidth&, nHeight&, Optional Style As Long)
    hwndLV = CreateWindowEx(WS_EX_CLIENTEDGE, WC_LISTVIEW, vbNullString, WS_CHILD Or WS_VISIBLE Or _
    LVS_REPORT Or Style, x, y, nWidth, nHeight, hWndParent, ID, App.hInstance, 0&)
End Function

Public Function ListView_InsertColumn(hwnd As Long, iCol As Long, ColumnText As String, Optional mnWidth As Long = 88) As Boolean
    ' 插入列表头
    Dim pcol As LVCOLUMN
    With pcol
        .mask = LVCF_FMT Or LVCF_TEXT Or LVCF_WIDTH
        .fmt = LVCFMT_LEFT
        .CX = mnWidth
        .pszText = ColumnText
    End With
    Call SendMessage(hwnd, LVM_INSERTCOLUMN, iCol, pcol)
End Function
   
Public Function ListView_SetExtendedListViewStyleEx(Optional dwExStyle As Long)
    ' Visual C++ Macros
    ' 设置扩展风格
    'SendLongMessage
    Call SendLongMessage(hwndLV, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES Or dwExStyle)
End Function

Public Function ListView_InsertItem(hwnd As Long, I As Long, ItemText As String, Optional State As Long)
    ' 插入列表项 (但不能插入子项)
    Dim pitem As LVITEM
    With pitem
        .mask = LVIF_TEXT Or LVIF_STATE
        .iItem = I
        .pszText = ItemText
        .State = State
        .stateMask = LVIS_STATEIMAGEMASK
    End With
    Call SendMessage(hwnd, LVM_INSERTITEM, 0, pitem)
    Call SendMessage(hwnd, LVM_SETITEMSTATE, ByVal I, pitem)
End Function
   
Public Function ListView_SetItemText(hwnd As Long, I As Long, iSubItem As Long, pszText As String)
     ' 插入列表项子项(i 为 列表项的 ID (行数) )
 Dim pitem As LVITEM
    With pitem
        .mask = LVIF_TEXT Or LVIF_STATE
        .pszText = pszText
        .iSubItem = iSubItem  ' 列数(在第几列)
    End With
    Call SendMessage(hwnd, LVM_SETITEMTEXT, I, pitem)
End Function
   
Public Function ListView_SetItem(I As Long, strItemText As String)
    Dim pitem As LVITEM
    With pitem
        .mask = LVIF_TEXT Or LVIF_STATE
        .iItem = I
        .pszText = strItemText
    End With
    Call SendMessage(hwndLV, LVM_SETITEM, 0, pitem)
End Function

Public Function ListView_GetItem(I As Long) As String
    Dim lpPitem As LVITEM, ItemText As String
    ItemText = String$(260, 0)
    With lpPitem
        .mask = LVIF_TEXT
        .iItem = I
        .pszText = ItemText
        .cchTextMax = 256
        .iSubItem = 0
    End With
    Call SendMessage(hwndLV, LVM_GETITEM, 0, lpPitem)
    ListView_GetItem = Left$(lpPitem.pszText, InStr(lpPitem.pszText, vbNullChar) - 1)
End Function
   
Public Function ListView_GetItemText(I As Long, iSubItem As Long) As String
    Dim lpPitem As LVITEM
    Dim SubItemText As String
    SubItemText = String$(28, 0)
    lpPitem.iSubItem = iSubItem
    lpPitem.cchTextMax = 28
    lpPitem.pszText = SubItemText
   
    Call SendMessage(hwndLV, LVM_GETITEMTEXT, ByVal I, lpPitem)
    ListView_GetItemText = Left$(lpPitem.pszText, InStr(lpPitem.pszText, vbNullChar) - 1)
End Function

Public Function ListView_SetItemState(sta As Long, Optional staMask As Long)
    Dim pitem As LVITEM
    With pitem
        .mask = LVIF_STATE
        .State = sta
        .stateMask = staMask Or LVIS_STATEIMAGEMASK
    End With
    Call SendMessage(hwndLV, LVM_SETITEMSTATE, -1, pitem)
End Function

Public Function ListView_SetBkColor(hwnd As Long, Optional clrBk As Long)
    ' 设置 List View 背景色 (不是列表项目)
    'SendLongMessage
    Call SendLongMessage(hwnd, LVM_SETBKCOLOR, 0, clrBk)
End Function

Public Function ListView_SetTextBkColor(Optional clrText As Long) As Boolean
    ' 设置列表项目的背景色
    'SendLongMessage
    Call SendLongMessage(hwndLV, LVM_SETTEXTBKCOLOR, 0&, clrText)
End Function

Public Function ListView_DeleteItem(iItem As Long) As Boolean
    'SendLongMessage
    ListView_DeleteItem = SendLongMessage(hwndLV, LVM_DELETEITEM, iItem, 0)
End Function
Public Function ListView_GetItemCount() As Long
    'SendLongMessage
    ListView_GetItemCount = SendLongMessage(hwndLV, LVM_GETITEMCOUNT, 0, 0)
End Function
Public Function ListView_GetNextItem() As Long
    'SendLongMessage
    ListView_GetNextItem = SendLongMessage(hwndLV, LVM_GETNEXTITEM, -1, LVIS_SELECTED)
End Function

Public Function ListView_GetItemState(I As Long) As Long
    '(其中LVIS_STATEIMAGEMASK = 0xF000)得到指定项的设置，如果设置为0x2000，
    'SendLongMessage
    ListView_GetItemState = SendLongMessage(hwndLV, LVM_GETITEMSTATE, I, LVIS_STATEIMAGEMASK)
End Function

Public Property Get hwnd() As Long
    hwnd = hwndLV
End Property

Private Sub Class_Initialize()
    Dim icex As InitCommonControlsEx
    icex.dwSize = Len(icex)
    icex.dwICC = ICC_LISTVIEW_CLASSES
  
    Call InitCommonControlsEx(icex)
    hwndLV = 0
End Sub

Private Sub Class_Terminate()
    If hwndLV <> 0 Then
        Call DestroyWindow(hwndLV)
    End If
End Sub