Listview custom sort - ItemClick problem

Hi sombell,

another similar link: http://www.codeguru.com/vb/articles/1818.shtml

Don't know if it's help and i hope so, regards.

Another possible solution, create another column which contains the numbers from your second column prefixed with "0000000" so you get a fixed length value which can be correctly sorted. Set the column width of this to zero and when you get the column click event, sort on the third correctly formatted column rather than the second with the unstuffed numbers in it.

Try this functions

You must use the SortListView function

ListView -> Your listView control to sort
Index    -> Index of the column to sort, in the columnheaderclick, you can use ColumnHeader.Index -1
DataType -> Choose one in the enum
Ascending -> true for Ascending, False for Descending

Sorry, all comment in functions are in french

'
' Pour les ListView
'
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_HITTEST As Long = (LVM_FIRST + 18)
Public Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
Public Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)
Public Const LVHT_NOWHERE As Long = &H1
Public Const LVHT_ONITEMICON As Long = &H2
Public Const LVHT_ONITEMLABEL As Long = &H4
Public Const LVHT_ONITEMSTATEICON As Long = &H8
Public Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or LVHT_ONITEMSTATEICON)

Public Type POINTAPI
 x As Long
 y As Long
End Type

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Type LVHITTESTINFO
  pt As POINTAPI
  flags As Long
  iItem As Long
  iSubItem  As Long
End Type

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'
' Pour trier les Listview
'
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Public Enum ListDataType
    ldtString = 0
    ldtNumber = 1
    ldtDateTime = 2
End Enum


Public Sub SortListView(ListView As ListView, ByVal Index As Integer, ByVal DataType As ListDataType, ByVal Ascending As Boolean)
'
' Classer un ListView en fonction du type d'une de ces colonnes
'
Dim I As Integer
Dim l As Long
Dim strFormat As String
Dim blnRestoreFromTag As Boolean
Dim lngCursor As Long
Dim dte As Date

On Error Resume Next
'
' Mettre le sablier
'
lngCursor = ListView.MousePointer
ListView.MousePointer = vbHourglass
'
' Bloquer le ListView, pendant le temps de blocage, les MAJ sont impossibles
'
LockWindowUpdate ListView.hwnd

'
' Suivant le type de la colonne, utiliser une methode de classement diff?rente
'
Select Case DataType
Case ldtString
'
' Pour les chaines, utiliser la methode du ListView
'
   
    blnRestoreFromTag = False
   
Case ldtNumber
'
' Pour les nombres, les formatter avant le tri
'
    strFormat = String$(20, "0") & "." & String$(10, "0")
   
    With ListView.ListItems
        If (Index = 0) Then
            For l = 1 To .Count
                With .Item(l)
                    .Tag = .Text & Chr$(0) & .Tag
                    If IsNumeric(.Text) Then
                        If CDbl(.Text) >= 0 Then
                            .Text = Format(CDbl(.Text), strFormat)
                        Else
                            .Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
                        End If
                    Else
                        .Text = ""
                    End If
                End With
            Next l
        Else
            For l = 1 To .Count
                .Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
                If IsNumeric(.Item(l).SubItems(Index)) Then
                    If CDbl(.Item(l).SubItems(Index)) >= 0 Then
                        .Item(l).SubItems(Index) = Format(CDbl(.Item(l).SubItems(Index)), strFormat)
                    Else
                        .Item(l).SubItems(Index) = "&" & InvNumber(Format(0 - CDbl(.Item(l).SubItems(Index)), strFormat))
                    End If
                Else
                    .Item(l).SubItems(Index) = ""
                End If
            Next l
        End If
    End With
   
    blnRestoreFromTag = True

Case ldtDateTime
'
' Formatter les dates avant de les trier
'
    strFormat = "YYYYMMDDHhNnSs"

    With ListView.ListItems
        If (Index = 0) Then
            For l = 1 To .Count
                With .Item(l)
                    .Tag = .Text & Chr$(0) & .Tag
                    dte = CDate(.Text)
                    .Text = Format$(dte, strFormat)
                End With
            Next l
        Else
            For l = 1 To .Count
                .Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
                dte = CDate(.Item(l).SubItems(Index))
                .Item(l).SubItems(Index) = Format$(dte, strFormat)
            Next l
        End If
    End With
   
    blnRestoreFromTag = True
   
End Select
'
' Classer le ListView par ordre alpha
'
ListView.SortOrder = IIf(Ascending, lvwAscending, lvwDescending)
ListView.SortKey = Index
ListView.Sorted = True
'
' Enlever le formattage
'
If blnRestoreFromTag Then
   
    With ListView.ListItems
        If (Index = 0) Then
            For l = 1 To .Count
                With .Item(l)
                    I = InStr(.Tag, Chr$(0))
                    .Text = Left$(.Tag, I - 1)
                    .Tag = Mid$(.Tag, I + 1)
                End With
            Next l
        Else
            For l = 1 To .Count
       
                I = InStr(.Item(l).Tag, Chr$(0))
                .Item(l).SubItems(Index) = Left$(.Item(l).Tag, I - 1)
                .Item(l).Tag = Mid$(.Item(l).Tag, I + 1)
            Next l
        End If
    End With
End If
'
' D?bloquer l'affichage
'
LockWindowUpdate 0&
'
' Placer l'ancien curseur
'
ListView.MousePointer = lngCursor

End Sub

Private Function InvNumber(ByVal Number As String) As String
'
' Inverser le nombre
'
Static I As Integer

For I = 1 To Len(Number)
    Select Case Mid$(Number, I, 1)
    Case "-"
        Mid$(Number, I, 1) = " "
    Case "0"
        Mid$(Number, I, 1) = "9"
    Case "1"
        Mid$(Number, I, 1) = "8"
    Case "2"
        Mid$(Number, I, 1) = "7"
    Case "3"
        Mid$(Number, I, 1) = "6"
    Case "4"
        Mid$(Number, I, 1) = "5"
    Case "5"
        Mid$(Number, I, 1) = "4"
    Case "6"
        Mid$(Number, I, 1) = "3"
    Case "7"
        Mid$(Number, I, 1) = "2"
    Case "8"
        Mid$(Number, I, 1) = "1"
    Case "9"
        Mid$(Number, I, 1) = "0"
    End Select
Next

InvNumber = Number

End Function

'Make sure the module name is
'mLVSort.  Set this in
'your properties window

Option Explicit
Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
 
'variable to hold the sort order (ascending or descending)
Public sOrder As Boolean
'variable to hold sort column
Public sColumn As Long

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 String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type
 
'Constants
Public Const LVFI_PARAM = 1
Public Const LVIF_TEXT = &H1

Public Const LVM_FIRST = &H1000
Public Const LVM_FINDITEM = LVM_FIRST + 13
Public Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48
     
'API declarations
Public 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

Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private lngListColour As Long
 
 
Public Function CompareDates(ByVal lParam1 As Long, _
                             ByVal lParam2 As Long, _
                             ByVal hWnd As Long) As Long
     
'CompareDates: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than

Dim dDate1 As Date, dDate2 As Date, dE As Boolean, d2E As Boolean
On Error GoTo CDERR

  'Obtain the item names and dates corresponding to the
  'input parameters
   dDate1 = ListView_GetItemDate(hWnd, lParam1)
   dDate2 = ListView_GetItemDate(hWnd, lParam2)
     
  'based on the Public variable sOrder set in the
  'columnheader click sub, sort the dates appropriately:
   Select Case sOrder
      Case True:    'sort descending
           
            If dDate1 < dDate2 Then
                  CompareDates = 0
            ElseIf dDate1 = dDate2 Then
                  CompareDates = 1
            Else
                CompareDates = 2
            End If
     
      Case Else: 'sort ascending
   
            If dDate1 > dDate2 Then
                  CompareDates = 0
            ElseIf dDate1 = dDate2 Then
                  CompareDates = 1
            Else
                CompareDates = 2
            End If
   
   End Select
   Exit Function
CDERR:
    CompareDates = 1
End Function


Public Function CompareValues(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hWnd As Long) As Long
     
'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than
 
Dim val1 As Long, val2 As Long
On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemValueStr(hWnd, lParam1)
    val2 = ListView_GetItemValueStr(hWnd, lParam2)
     
    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
        Case True:    'sort descending
           
            If val1 < val2 Then
                CompareValues = 0
            ElseIf val1 = val2 Then
                CompareValues = 1
            Else
                CompareValues = 2
            End If
     
        Case Else: 'sort ascending
   
            If val1 > val2 Then
                CompareValues = 0
            ElseIf val1 = val2 Then
                CompareValues = 1
            Else
                CompareValues = 2
            End If
   
    End Select
    Exit Function
CDERR:
    CompareValues = 1
End Function

Public Function CompareCurrency(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hWnd As Long) As Long
     
'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than
 
Dim val1 As Currency, val2 As Currency
On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemCurrency(hWnd, lParam1)
    val2 = ListView_GetItemCurrency(hWnd, lParam2)
     
    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
        Case True:    'sort descending
           
            If val1 < val2 Then
                CompareCurrency = 0
            ElseIf val1 = val2 Then
                CompareCurrency = 1
            Else
                CompareCurrency = 2
            End If
     
        Case Else: 'sort ascending
   
            If val1 > val2 Then
                CompareCurrency = 0
            ElseIf val1 = val2 Then
                CompareCurrency = 1
            Else
                CompareCurrency = 2
            End If
   
    End Select
    Exit Function
CDERR:
    CompareCurrency = 1
End Function

Public Function ComparePercent(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hWnd As Long) As Long
     
'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than
 
Dim val1 As Single, val2 As Single
On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemPercent(hWnd, lParam1)
    val2 = ListView_GetItemPercent(hWnd, lParam2)
     
    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
        Case True:    'sort descending
           
            If val1 < val2 Then
                ComparePercent = 0
            ElseIf val1 = val2 Then
                ComparePercent = 1
            Else
                ComparePercent = 2
            End If
     
        Case Else: 'sort ascending
   
            If val1 > val2 Then
                ComparePercent = 0
            ElseIf val1 = val2 Then
                ComparePercent = 1
            Else
                ComparePercent = 2
            End If
   
    End Select
    Exit Function
CDERR:
    ComparePercent = 1
End Function

Private Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)
     
    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)
     
    'get the string at subitem 1
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
     
    'and convert it into a date and exit
    If r > 0 Then
        If IsDate(Left$(objItem.pszText, r)) Then
            ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
        Else
            ListView_GetItemDate = DateSerial(4501, 1, 1)
        End If
    End If
End Function


Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long
Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)
     
    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)
     
    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
     
    'and convert it into a long
    If r > 0 Then
        ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
    End If
End Function

Public Function ListView_GetItemCurrency(hWnd As Long, lParam As Long) As Long
Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)
     
    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)
     
    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
     
    'and convert it into a long
    If r > 0 Then
        ListView_GetItemCurrency = CCur(Left$(objItem.pszText, r))
    End If
End Function

Public Function ListView_GetItemPercent(hWnd As Long, lParam As Long) As Long
Dim r As Long, hIndex As Long, temp As String
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)
     
    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)
     
    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
     
    'and convert it into a long
    If r > 0 Then
        temp = Left$(objItem.pszText, r)
        If Right$(temp, 1) = "%" Then
            temp = Left$(temp, Len(temp) - 1)
        End If
        ListView_GetItemPercent = CSng(temp)
    End If
End Function

Public Sub SortLvwOnDate(lvw As ListView, ColIndex As Long)
    Screen.MousePointer = vbHourglass
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareDates
    Screen.MousePointer = vbDefault
End Sub

Public Sub SortLvwOnLong(lvw As ListView, ColIndex As Long)
    Screen.MousePointer = vbHourglass
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareValues
    Screen.MousePointer = vbDefault
End Sub

Public Sub SortLvwOnCurrency(lvw As ListView, ColIndex As Long)
    Screen.MousePointer = vbHourglass
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareCurrency
    Screen.MousePointer = vbDefault
End Sub

Public Sub SortLvwOnPercent(lvw As ListView, ColIndex As Long)
    Screen.MousePointer = vbHourglass
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf ComparePercent
    Screen.MousePointer = vbDefault
End Sub

Private Function GetListColour() As Long
'=========================================

  Dim DB As Object
  Dim rs As Object

On Error Resume Next

    Set DB = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    ' Only retrieve connection string if it has not been set already
    If gConnectionString = "" Then gConnectionString = GEN_GetConnectionString
   
    DB.Open gConnectionString
    rs.Open "SELECT ListColour FROM Users WHERE UserID = " & gUserID, DB, 0, 1
   
    If Not rs.EOF Then
        GetListColour = rs!ListColour
    End If
   
    rs.Close
    DB.Close
   
End Function

Public Sub SetListViewColor(pCtrlListView As ListView, _
                            pCtrlPictureBox As PictureBox, _
                            Color1 As Long, Color2 As Long)
'==========================================================================

On Error GoTo SetListViewColor_Error

   Dim iLineHeight As Long
   Dim iBarHeight  As Long
   Dim lBarWidth   As Long
   
   ' Variables not really necessary
   ' Can set the values directly
'   Dim lColor1     As Long
'   Dim lColor2     As Long

'   lColor1 = Color1
'   lColor2 = Color2
   
   ' Only retrieve the list colour if it has not been set already
   If lngListColour = 0 Then lngListColour = GetListColour
   
   If pCtrlListView.View = lvwReport Then
'       pCtrlListView.Picture = LoadPicture("")
'       pCtrlListView.Refresh
'       pCtrlPictureBox.Cls
       
       With pCtrlListView
        .Picture = LoadPicture("")
        .Refresh
       End With
       
'       pCtrlPictureBox.AutoRedraw = True
'       pCtrlPictureBox.BorderStyle = vbBSNone
'       pCtrlPictureBox.ScaleMode = vbTwips
'       pCtrlPictureBox.Visible = False
       
       With pCtrlPictureBox
        .Cls
        .AutoRedraw = True
        .BorderStyle = vbBSNone
        .ScaleMode = vbTwips
        .Visible = False
       End With
             
'       pCtrlListView.PictureAlignment = lvwTile
'       pCtrlPictureBox.Font = pCtrlListView.Font
'       pCtrlPictureBox.Top = pCtrlListView.Top
'       With pCtrlPictureBox.Font
'           .Size = pCtrlListView.Font.Size ' + 2.75
'           .Bold = pCtrlListView.Font.Bold
'           .Charset = pCtrlListView.Font.Charset
'           .Italic = pCtrlListView.Font.Italic
'           .Name = pCtrlListView.Font.Name
'           .Strikethrough = pCtrlListView.Font.Strikethrough
'           .Underline = pCtrlListView.Font.Underline
'           .Weight = pCtrlListView.Font.Weight
'       End With
'       pCtrlPictureBox.Refresh
       
       pCtrlListView.PictureAlignment = lvwTile
       
       With pCtrlPictureBox
          .Font = pCtrlListView.Font
          .Top = pCtrlListView.Top
          With .Font
              .Size = pCtrlListView.Font.Size
              .Bold = pCtrlListView.Font.Bold
              .Charset = pCtrlListView.Font.Charset
              .Italic = pCtrlListView.Font.Italic
              .Name = pCtrlListView.Font.Name
              .Strikethrough = pCtrlListView.Font.Strikethrough
              .Underline = pCtrlListView.Font.Underline
              .Weight = pCtrlListView.Font.Weight
          End With
          .Refresh
       End With
       
       iLineHeight = pCtrlPictureBox.TextHeight("W") + Screen.TwipsPerPixelY
       iBarHeight = (iLineHeight * 1)
       lBarWidth = pCtrlListView.Width
   
       pCtrlPictureBox.Height = iBarHeight * 2
       pCtrlPictureBox.Width = lBarWidth
   
       'paint the two bars of color
       pCtrlPictureBox.Line (0, 0)-(lBarWidth, iBarHeight), Color1, BF
       'pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Color2, BF
       pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), lngListColour, BF
             
       pCtrlPictureBox.AutoSize = True
       'set the pCtrlListView picture to the
       'pCtrlPictureBox image
       pCtrlListView.Picture = pCtrlPictureBox.Image
   Else
       pCtrlListView.Picture = LoadPicture("")
   End If
   
   pCtrlListView.Refresh
   Exit Sub
   
SetListViewColor_Error:
   ' Clear ListView's picture and then exit
'   pCtrlListView.Picture = LoadPicture("")
'   pCtrlListView.Refresh
  With pCtrlListView
    .Picture = LoadPicture("")
    .Refresh
  End With
 
End Sub

Thanks for the comments and suggestions so far.

I'm running through them one by one and will come back with any feedback once ive been through them.

Just to make myself clear. I am already aware of all sorts of other methods of "tweaking" the listview to do the sort in a different way.

What I'm looking for is a method to "resynchronise" the data held by the listview itself (and shown on screen) and the data maintained in the listitems collection by the VBwrapper for listview.

Sombell

OK.
I've been through the comments posted so far. I'll take them one by one.

Please understand, I'm not saying most(if not all of these suggestions work as alternative methods of sorting - I've used most of them in the past myself. But I'm not looking for an alternative sorting method - I was hoping to solve the problem that makes using LVM_SORTITEMS pretty useless

ryancys:
 This sample uses a kludge I am aware of for sorting listviews. Once again it points out the problem to which I am trying to find a solution, but then neither does it solve the problem.

TimCottee:
 Same again I'm afraid.

casassus:
 A rather more involved (but more general solution) using the "dummy column" technique. But without actually using a dummy column. (the french wasnt a problem I worked for a french company for 20 years, so my schoolboy language skills are well tuned :o)

Vogon:
I presume quite a bit of this code is not pertinant to your answer. If this is code you use in your projects then you have exactly the problem I'm trying to find a solution to. If you click on an item after sorting using the LVM_SORTITEMS message to get it sorted, then the ITEM passed to the _ItemClicked event is NOT always the same as the one you think you clicked on the screen (they'll be the same if their position in the order hasnt changed otherwise you get the wrong it).

I know I can avoid this whole problem by using some other method (which is what i do at the moment), but what I want to do is to find some way of solving the problem that is created by using the LVM_SORTITEMS message. It's not blocking my development since it's currently coded to use an "alternate kludge". It just seems to me that with all the expertise available we ought to be able to find a solution.

Think of it as an intellectual exercise.

So, just to refresh. It seems there are two potential routes to a solution.
Route 1 is to re-synchronise the VBWrapper data collection to the order displayed in the ListView
Route 2 is to determine which element of the listview has been clicked and get the right object in the VBwrapper collection using that.

The question is, how ? (and i suppose which is cleaner and/or more efficient)

Sombell

Mind I have a ride?

No problem, the more the merrier

Hi

The problem is - VB ListView control is not same as SysListView32 window class. It store listitems in separate collection, so when you use custom sorting, indexes in collection and in listview aren't same.

>>HOWEVER, if you click on an item when the list is sorted by Number, the ITEM parameter passed to the
_ItemClick event is NOT the item that was clicked in the listview.<<

Nope! _ItemClick (or.SelectedItem) return CORRECT ListItem, only index is diffrent (it was setting BEFORE sorting) so you can not access any item by index. You have two ways -
1. Using subclassing and continue all staff with API.
2. Store info in .Key or .Tag properties.

IMHO, better to use .Key property (note that it shoul begin from letter, not digit, but you can add any letter before digits).

Cheers

Excellent !
That does the trick.

Just to explain (and hopefully make the problem and solution clear):

The VB Listview control is a "wrapper" for the Listview common control. This allows use of the control to be simplified, and allows for the items in the list to be managed as a collection.

One of the things that this wrapping also does is to provide a "standard" sorting mechanism implemented in VB with the .Sortkey, .Sortorder and .Sorted properties.
Unfortunately this "standard" sorting only uses text comparison of values in the column used as the sort key (it also only allows the use of one key - equal key values remain sorted in the previous sorted [or unsorted] sequence).
The major impact of this is that using a column of numerical values as a sort key results in a sequence not ordered by value (the same applies to date columns unless the date is formatted in descending unit order - yyyy/mm/dd).

While it is possible to work around this problem by formatting a "dummy" column for the purpose of sorting, this method is a bit "kludgy".

It is possible, however, to invoke a cutom sort order for the Listview common control using the LVM_SORTITEMS message. This allows sorting to be done using any sequencing method (for instance its possible to sort a text colum in some arbitrary order - such as calendar months (Jan, Feb etc) in calendar order and not in alphabetical order).

The problem with this is that when an item in the list is clicked after the list has been sorted using this custom method, the item object passed to the _ItemClicked event is not the item that has been clicked on the screen:

When using the "standard" sorting method of the vb control
the item object collection is re-ordered and displayed in that order on screen (item.index=1 for the first item on screen, item.index=2 for the second etc)

When using the LVM_SORTITEMS sorting method the screen is updated to show the items on screen in their sorted order, but the item object collection is NOT re-ordered, so possibly item.index=12 for the first item on screen, item.index=5 for the second, and so on.

The solution provided by Ark is to ignore the item object passed to the _ItemClicked event and use the .ItemSelected object which will be the correct item.

I'll post a simple example illustrating this problem and its solution later today.

Meanwhile, thank you Ark.

Sombell

Forgot to accept the answer earlier !

OK here is the example showing the solution
You need a form with a listview on it (make is a bit wider than default) and a module.

then paste the first block into the form, the second block into the module:

==================== First Block
Option Explicit

Private Sub Form_Load()
    Dim xCol As ColumnHeader
    Dim xItem As ListItem

    'Add two Column Headers to the ListView control
    Set xCol = ListView1.ColumnHeaders.Add(, , "Name")
    Set xCol = ListView1.ColumnHeaders.Add(, , "Number")
    Set xCol = ListView1.ColumnHeaders.Add(, , "Date")
    Set xCol = ListView1.ColumnHeaders.Add(, , "Name")
   
    'Set the view property of the Listview control to Report view
    ListView1.View = lvwReport

    'Add data to the ListView control
    Set xItem = ListView1.ListItems.Add(, , "Fred Bloggs")
    xItem.SubItems(1) = "3"
    xItem.SubItems(2) = "13/1/1999"
    xItem.SubItems(3) = "Fred Bloggs"
   
    Set xItem = ListView1.ListItems.Add(, , "Bill Smith")
    xItem.SubItems(1) = "17"
    xItem.SubItems(2) = "1/1/1999"
    xItem.SubItems(3) = "Bill Smith"
   
    Set xItem = ListView1.ListItems.Add(, , "Sid Williams")
    xItem.SubItems(1) = "1"
    xItem.SubItems(2) = "4/1/1999"
    xItem.SubItems(3) = "Sid Williams"
   
    Set xItem = ListView1.ListItems.Add(, , "Fred Jones")
    xItem.SubItems(1) = "22"
    xItem.SubItems(2) = "1/2/1999"
    xItem.SubItems(3) = "Fred Jones"
   
    Set xItem = ListView1.ListItems.Add(, , "Anna Conder")
    xItem.SubItems(1) = "2"
    xItem.SubItems(2) = "1/1/1998"
    xItem.SubItems(3) = "Anna Conder"
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
       
    Select Case ColumnHeader.Index - 1
        Case 0 'name - invoke the standard sort method
            ListView1.SortKey = 0
            ListView1.Sorted = True
        Case 1 ' number
            ListView1.Sorted = False
            SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareNumber
        Case 2 '
            ListView1.Sorted = False
            SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareDate
        Case 3 '
            ListView1.Sorted = False
            SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareSurname
    End Select
   
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Debug.Print "++++++++++++++++++++++++++++++++++++++++"
Debug.Print , "Param Item", "Selected Item"
Debug.Print "Index:", Item.Index, ListView1.SelectedItem.Index
Debug.Print "Text:", Item.Text, ListView1.SelectedItem.Text

End Sub
Private Sub DebugDump(s As String, pItem As ListItem)
Debug.Print s
Debug.Print "   Index="; pItem.Index
Debug.Print "   Text = "; pItem.Text
End Sub


==================== Second Block
Option Explicit
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

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

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

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

  Dim xVal1 As Integer, xVal2 As Integer
 
  xVal1 = CInt(lvGetItemData(lngParam1, hWnd, 1))
  xVal2 = CInt(lvGetItemData(lngParam2, hWnd, 1))
 
  'Compare the dates
  'Return 0 ==> Less Than
  '       1 ==> Equal
  '       2 ==> Greater Than
  ' concatenate surname forename for comparison
  If xVal1 < xVal2 Then
    CompareNumber = 0
  ElseIf xVal1 = xVal2 Then
    CompareNumber = 1
  Else
    CompareNumber = 2
  End If

End Function
Public Function CompareDate(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long

  Dim xVal1 As Date, xVal2 As Date
 
  xVal1 = CDate(lvGetItemData(lngParam1, hWnd, 2))
  xVal2 = CDate(lvGetItemData(lngParam2, hWnd, 2))
 
  If xVal1 < xVal2 Then
    CompareDate = 0
  ElseIf xVal1 = xVal2 Then
    CompareDate = 1
  Else
    CompareDate = 2
  End If

End Function
Public Function CompareSurname(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long

  Dim xVal1 As String, xVal2 As String, v() As String
 
  xVal1 = lvGetItemData(lngParam1, hWnd, 3)
  xVal2 = lvGetItemData(lngParam2, hWnd, 3)
 
  v = Split(xVal1)
  xVal1 = v(UBound(v))
  v = Split(xVal2)
  xVal2 = v(UBound(v))
 
 
  'Compare the dates
  'Return 0 ==> Less Than
  '       1 ==> Equal
  '       2 ==> Greater Than
  ' concatenate surname forename for comparison
  If xVal1 < xVal2 Then
    CompareSurname = 0
  ElseIf xVal1 = xVal2 Then
    CompareSurname = 1
  Else
    CompareSurname = 2
  End If

End Function

'GetItemData - Given Retrieves

Private Function lvGetItemData(lngParam As Long, hWnd As Long, pCol As String) As String
  Dim objFind As LV_FINDINFO
  Dim lngIndex As Long
  Dim objItem As LV_ITEM
  Dim baBuffer(32) As Byte
  Dim lngLength As Long

  '
  ' Convert the input parameter to an index in the list view
  '
  objFind.flags = LVFI_PARAM
  objFind.lParam = lngParam
  lngIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))

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

End Function

There are a few comments on the above:

1)
If you add a new listitem to the listview when it is sorted using the "standard" method, it will get inserted in the correct place according to the sort parameters. If the list is sorted using the "custom" method it will be inserted at the end (assuming an index isnt given in the .Add method).

2)
the Comparexxxx functions return 0, 1 and 2
I have seen them coded using -1, 0 and 1 elsewhere, and it seems to work just as well.
Anyone have any comments ?

3)
There is still quite a bit of "hard coding" in the sorting code. Really I'd like to get rid of this and have a "general" solution.
I can see two possible ways to achieve this:
 a) find the listview object from the .hwnd property passed as a parameter - is this possible if so how ?
 b) use a different parameter, that allows the listview object to be found in the compare routine. Is there a way of doing this ?
If anyone has a solution for 3) i'll be happy to post it as a proper question & award points

Hi
Take a look at http://www.freevbcode.com/ShowCode.Asp?ID=2977
Here is brief extraction of my compare process wihich I used to sort FileList by Name/Date/Size. You can see that it works OK. I removed part of code to determine if item is folder (Folder should be sorted separately before files).
Any time you need sorting (add new item, column click etc):

n = ListView1.SortKey
If ListView1.SortOrder = lvwDescending Then n = n Or SORT_DESCENDING
Call ListView_SortItems(ListView1.hWnd, AddressOf CompareProc, n)

'===Bas module====

Public Function ListView_SortItems(hwndLV As Long, pfnCompare As Long, lParamSort As Long) As Boolean
   ListView_SortItems = SendMessage(hwndLV, LVM_SORTITEMS, ByVal lParamSort, ByVal pfnCompare)
End Function

'VB TreeView and ListView can sort items only by strings
'Here is process to compare items by date and size
'Works both with TreeView and ListView
'>>the Comparexxxx functions return 0, 1 and 2<<
'-1,0 and 1 more better when using Sgn function

Public Function CompareProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As Long) As Long
   Dim nColumn As Long
   Dim hr As Long
   Dim sCompare1 As String
   Dim sCompare2 As String
   Dim Item1 As Object, Item2 As Object
   On Error GoTo ErrCompare
   Set Item1 = GetItemFromlParam(lParam1)
   Set Item2 = GetItemFromlParam(lParam2)
   nColumn = lParamSort And Not SORT_DESCENDING
   If nColumn = 0 Then
      sCompare1 = Item1.Text
      sCompare2 = Item2.Text
   Else
      sCompare1 = Item1.SubItems(nColumn)
      sCompare2 = Item2.SubItems(nColumn)
   End If
   If IsDate(sCompare1) And IsDate(sCompare2) Then
      hr = Sgn(CDate(sCompare1) - CDate(sCompare2))
'Change to IsNumeric if you want
   ElseIf IsSize(sCompare1) And IsSize(sCompare2) Then
      hr = Sgn(fldItem1.Size - fldItem2.Size)
   Else
      hr = StrComp(sCompare1, sCompare2)
   End If
   If (lParamSort And SORT_DESCENDING) Then hr = hr * (-1)
ErrCompare:
    Set Item1 = Nothing
    Set Item2 = Nothing
    CompareProc = hr
End Function

'Determining if string can be size.
'Donno about all locales (espec. China, Japan etc)
'But usually size string looks like xxx KB, where
'xxx is numeric
Private Function IsSize(s As String) As Boolean
  On Error Resume Next
  IsSize = IsNumeric(Left(s, Len(s) - 3))
End Function

'Thanks to Brad Martinez for this trick. It's very usefull
'for comparing process

Public Function GetItemFromlParam(lParam As Long) As Object
  Dim pItem As Long
  Dim oItem As Object
  If lParam Then
    CopyMemory pItem, ByVal lParam + 8, 4
    If pItem Then
      CopyMemory oItem, pItem, 4&
      Set GetItemFromlParam = oItem
      FillMemory oItem, 4, 0
    End If
  End If
End Function

Cheers