Sunday, June 17, 2012

Contoh Mengurutkan ListView Berdasarkan Tanggal

'Kode pada Module
Option Explicit

Public Type POINT
x As Long
y As Long
End Type

Public Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINT
vkDirection As Long
End Type

Public Type LV_ITEM
mask As Long
iItem As Long
iSubItem As Long
State As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type

Private Const LVFI_PARAM = 1
Private Const LVIF_TEXT = &H1
Private Const LVM_FIRST = &H1000
Private Const LVM_FINDITEM = LVM_FIRST + 13
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Function CompareDates(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long

Dim strName1 As String
Dim strName2 As String
Dim dDate1 As Date
Dim dDate2 As Date

ListView_GetItemData lngParam1, hWnd, strName1, dDate1
ListView_GetItemData lngParam2, hWnd, strName2, dDate2

If dDate1 < dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else
CompareDates = 2
End If

End Function

Public Sub ListView_GetItemData(lngParam As Long, hWnd As Long, strName As String, dDate As Date)
Dim objFind As LV_FINDINFO
Dim lngIndex As Long
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long

objFind.flags = LVFI_PARAM
objFind.lParam = lngParam
lngIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))

objItem.mask = LVIF_TEXT
objItem.iSubItem = 0
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)

objItem.mask = LVIF_TEXT
objItem.iSubItem = 1
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
If lngLength > 0 Then
dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
End If

End Sub

Public Sub ListView_GetListItem(lngIndex As Long, hWnd As Long, strName As String, dDate As Date)
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long

objItem.mask = LVIF_TEXT
objItem.iSubItem = 0
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)

objItem.mask = LVIF_TEXT
objItem.iSubItem = 1
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
If lngLength > 0 Then
dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
End If

End Sub


'Kode pada Form
Option Explicit

Private Sub Form_Load()

Dim clmAdd As ColumnHeader
Dim itmAdd As ListItem

Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Name")
Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Date")

ListView1.View = lvwReport

Set itmAdd = ListView1.ListItems.Add(Text:="Joe")
itmAdd.SubItems(1) = "05/07/97"

Set itmAdd = ListView1.ListItems.Add(Text:="Sally")
itmAdd.SubItems(1) = "04/08/97"

Set itmAdd = ListView1.ListItems.Add(Text:="Bill")
itmAdd.SubItems(1) = "05/29/97"

Set itmAdd = ListView1.ListItems.Add(Text:="Fred")
itmAdd.SubItems(1) = "05/17/97"

Set itmAdd = ListView1.ListItems.Add(Text:="Anne")
itmAdd.SubItems(1) = "04/01/97"

End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)

Dim strName As String
Dim dDate As Date
Dim lngItem As Long

If ColumnHeader.Text = "Name" Then
ListView1.Sorted = True
ListView1.SortKey = 0
Else
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareDates
End If

ListView1.Refresh

For lngItem = 0 To ListView1.ListItems.Count - 1
ListView_GetListItem lngItem, ListView1.hWnd, strName, dDate
Next

End Sub