clslistview.cls

一个clock的 vb 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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
    ' 设置扩展风格
    Call SendLongMessage(hwndLV, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, LVS_EX_FULLROWSELECT Or LVS_EX_CHECKBOXES 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 背景色 (不是列表项目)
    Call SendLongMessage(hWnd, LVM_SETBKCOLOR, 0, clrBk)
End Function

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

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

Public Function ListView_GetItemState(I As Long) As Long
    '(其中LVIS_STATEIMAGEMASK = 0xF000)得到指定项的设置，如果设置为0x2000，
    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 INITCOMMONCONTROLSEXS
    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