clvheadersorticons.cls

优盘 锁定监视器

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

Option Explicit

#Const WIN32_IE = &H300

Private m_ListView As ListView
Private m_himl As Long

Public Enum SortOrderConstants
 soAscending = 0
 soDescending = 1
End Enum

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 Const LVM_FIRST = &H1000
#If (WIN32_IE >= &H300) Then
 Private Const LVM_GETHEADER = (LVM_FIRST + 31)
#End If

Private Const HDM_FIRST = &H1200
Private Const HDM_SETITEM = (HDM_FIRST + 4)

#If (WIN32_IE >= &H300) Then
 Private Const HDM_SETIMAGELIST = (HDM_FIRST + 8)
#End If

Private Type HDITEM
 mask As Long
 cxy As Long
 pszText As String
 hbm As Long
 cchTextMax As Long
 fmt As Long
 lParam As Long
 #If (WIN32_IE >= &H300) Then
  iImage As Long
  iOrder As Long
 #End If
End Type

Private Const HDI_FORMAT = &H4

#If (WIN32_IE >= &H300) Then
 Private Const HDI_IMAGE = &H20
#End If

Private Const HDF_LEFT = 0
Private Const HDF_RIGHT = 1

#If (WIN32_IE >= &H300) Then
 Private Const HDF_IMAGE = &H800
 Private Const HDF_BITMAP_ON_RIGHT = &H1000
#End If

Private Const HDF_STRING = &H4000

Private Const ILC_MASK = &H1
Private Const ILC_COLOR8 = &H8

Private Declare Function ImageList_Create Lib "comctl32.dll" (ByVal cX As Long, ByVal cY As Long, ByVal Flags As Long, ByVal cInitial As Long, ByVal cGrow As Long) As Long
Private Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal hIml As Long) As Boolean
Private Declare Function ImageList_ReplaceIcon Lib "comctl32.dll" (ByVal hIml As Long, ByVal i As Long, ByVal hIcon As Long) As Long

Private Sub Class_Terminate()
 If m_himl Then Call ImageList_Destroy(m_himl)
End Sub

#If (WIN32_IE >= &H300) Then
Private Function Header_SetImageList(hwnd As Long, hIml As Long) As Long
 Header_SetImageList = SendMessage(hwnd, HDM_SETIMAGELIST, 0, ByVal hIml)
End Function
#End If

Private Function Header_SetItem(hwndHD As Long, i As Long, phdi As HDITEM) As Boolean
 Header_SetItem = SendMessage(hwndHD, HDM_SETITEM, i, phdi)
End Function

Private Function ImageList_AddIcon(hIml As Long, hIcon As Long) As Long
 ImageList_AddIcon = ImageList_ReplaceIcon(hIml, -1, hIcon)
End Function

Public Property Set ListView(lv As Object)
 Set m_ListView = lv
End Property

Public Property Get ListView() As ListView
 Set ListView = m_ListView
End Property

#If (WIN32_IE >= &H300) Then
Private Function ListView_GetHeader(hwnd As Long) As Long
 ListView_GetHeader = SendMessage(hwnd, LVM_GETHEADER, 0, 0)
End Function
#End If

Public Function SetHeaderIcons(iActiveColumn As Long, iSortOrder As SortOrderConstants) As Boolean
Static hwndHdr As Long
Dim i As Long
Dim fShow As Boolean
Dim fAlignRight As Boolean
Dim hdi As HDITEM
 If (m_himl = 0) Or (m_ListView Is Nothing) Then Exit Function
 If (m_ListView.View <> lvwReport) Then Exit Function
 If (hwndHdr = 0) Then
  hwndHdr = ListView_GetHeader(m_ListView.hwnd)
  Call Header_SetImageList(hwndHdr, m_himl)
 End If
 If (hwndHdr = 0) Then Exit Function
 With m_ListView.ColumnHeaders
  For i = 0 To .Count - 1
   hdi.mask = HDI_FORMAT Or HDI_IMAGE
   fAlignRight = .item(i + 1).Alignment = lvwColumnRight
   hdi.fmt = HDF_STRING Or (fAlignRight And HDF_RIGHT)   ' HDF_LEFT = 0
   If (i = iActiveColumn) Then
    hdi.fmt = hdi.fmt Or HDF_IMAGE Or ((fAlignRight = False) And HDF_BITMAP_ON_RIGHT)
   End If
   hdi.iImage = Abs(CBool(iSortOrder))
   Call Header_SetItem(hwndHdr, i, hdi)
  Next i
 End With
 SetHeaderIcons = True
End Function