ucListViewEx 2.5 + clsIconList [UPDATED]

[chip]

WinXP only shows Group without Substitle,Footer and collapse button. That means you can't collapse the groups. In Vista/Win7,the looking is better than ever.

Thanks Jen. So if I only want to use the groups to filter/hide list items as raul338 has suggested, "set 1 to the "visible" items and -1 to "not visible" items", would that require collapsing?  I wouldnt be home for a couple more hours to try this out.

[chip]

To answer my question above...   

Using "Groups" to hide items works beautifully on Windows 7, but does not work on WinXP.

[chip]

Sorting of Columns when in Group Mode on Windows XP does not work.


EDIT:   this does not work on Windows XP  Service Pack 2, but it does work for Service Pack 3.

[chip]

greetings again. 

Here is the work I have done to modify this ucListview to fit my needs (basic theme-aware ListView with Sort and Filter)

new:
FilterItems (works both WinXP + Vista/7)
FilterEnabled (bool property)
FreezePaint (use before/after large updates to ListView)
DoubleBuffer style (reduces flicker when resizing, moving, adding, etc:  http://www.codeproject.com/KB/list/listviewxp.aspx)

minor:
removed 'force admin' from the manifest file for the compiled .exe
fixed backgroundimage bugs (clears BackGroundImage and also proper loading of images in the example)

http://www.convivea.com/download/ucListView2.5.chip.rar


let me know.

thanks,
chip

[LeandroA]

Muy buenos cambios!!

Otra funcionalidad para window 7 y vista

Código: [Seleccionar]

Private Const HDS_CHECKBOXES      As Long = &H400

Código: [Seleccionar]

Public Property Get ColumnCheckValue(ByVal Column As Long) As Boolean

    Dim uLVC As LVCOLUMN

    If (m_hListView And m_hHeader) Then
        With uLVC
            .mask = LVCF_FMT
            Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
            ColumnCheckValue = uLVC.fmt And HDF_CHECKED
        End With
    End If
End Property

Public Property Let ColumnCheckValue(ByVal Column As Long, ByVal value As Boolean)
    Dim uLVC As LVCOLUMN

    If (m_hListView And m_hHeader) Then
        With uLVC
            .mask = LVCF_FMT
            Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
            uLVC.fmt = (uLVC.fmt And Not HDF_CHECKED) Or (value And HDF_CHECKED)
            Call SendMessage(m_hListView, LVM_SETCOLUMN, Column, uLVC)
        End With
    End If
   
End Property


Public Property Get ColumnCheckStyle(ByVal Column As Long) As Boolean

    Dim uLVC As LVCOLUMN

    If (m_hListView And m_hHeader) Then
        With uLVC
            .mask = LVCF_FMT
            Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
            ColumnCheckStyle = uLVC.fmt And HDF_CHECKBOX
        End With
    End If
End Property

Public Property Let ColumnCheckStyle(ByVal Column As Long, ByVal value As Boolean)
    Dim uLVC As LVCOLUMN

    If (m_hListView And m_hHeader) Then
        With uLVC
            .mask = LVCF_FMT
            Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
            uLVC.fmt = (uLVC.fmt And Not HDF_CHECKBOX) Or (value And HDF_CHECKBOX)
            Call SendMessage(m_hListView, LVM_SETCOLUMN, Column, uLVC)
        End With
    End If
   
End Property

Public Property Get ColumnCheckBoxes() As Boolean
    If m_hListView And m_hHeader Then ColumnCheckBoxes = GetWindowLong(m_hHeader, GWL_STYLE) And HDS_CHECKBOXES
End Property

Public Property Let ColumnCheckBoxes(ByVal value As Boolean)
    If m_hListView And m_hHeader Then
        Call SetWindowLong(m_hHeader, GWL_STYLE, GetWindowLong(m_hHeader, GWL_STYLE) And Not HDS_CHECKBOXES Or (value And HDS_CHECKBOXES))
    End If
End Property


Código: [Seleccionar]

    ucListView1.ColumnCheckBoxes = True
    ucListView1.ColumnCheckStyle(0) = True
    ucListView1.ColumnCheckValue(0) = True

para los eventos

Código: [Seleccionar]

Private Const HDN_ITEMCHECK        As Long = (HDN_FIRST - 16) 'The name is invented, not found his real name
Public Event ColumnCheck(Column As Long, Value As Boolean)

Código: [Seleccionar]

                                    Case HDN_ITEMCHECK
                                       
                                        Call CopyMemory(uNMHE, ByVal lParam, Len(uNMHE))
                                        RaiseEvent ColumnCheck(uNMHE.iItem, Not Me.ColumnCheckValue(uNMHE.iItem))

[raul338]

Actually there a bunch of bugs that Jen and I are fixing

For "hiding" items, well, it cannot be done simply like the Common Controls OCX

But there's a trick. Enabling groups (without adding a group) doesn't show all items wich group is 0 or -1. So, the trick is to set 1 to the "visible" items and -1 to "not visible" items and voila! (I didnt tried this, but it should work)

Hello, after a long (?) time, I found a way to do what I wanted to explain

Only show Items with certain Filter

Código: (vb) [Seleccionar]

Private Sub ucListView1_FilterTimeout(ByVal Column As Long)
    With ucListView1
        Dim i As Integer, s As String
        If .ColumnFilterText(Column) <> "" Then
            .GroupsEnable = False
            .GroupClear
            Call .GroupAdd(0, "Resultado de busqueda")
            For i = 0 To .Count - 1
                If Column = 0 Then
                    s = .ItemText(i)
                Else
                    s = .SubItemText(i, Column)
                End If
                If s Like .ColumnFilterText(Column) Then
                    .ItemGroup(i) = 0
                Else
                    .ItemGroup(i) = 1 ' Grupo inexistente, no se mostrará
                    ' The group with ID 1 doesn't exists, so, the item will not be shown
                End If
            Next
            .GroupsEnable = True
        Else
            .GroupsEnable = False
        End If
    End With
End Sub

When GroupsEnable is setted to False all items with no valid group ID isn't shown

Testing:
In  the second Column, I filter by "6" and the others items just disappear until i set the field to blank. In the last else you have to back to normal your listview if you were using groups


I'm still working fixing several bugs and Adding features Just Wait

[chip]

hi guys.. I fixed the  Public Property Get GroupHeaderText(ByVal GroupID As Long) As String

(previously crashed on Windows XP)
Declares

Código: [Seleccionar]

'ADDED BY CHIP!

Private Declare Function lstrcpyA Lib "Kernel32.dll" ( _
    ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32.dll" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "Kernel32.dll" ( _
    ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenW Lib "Kernel32.dll" (ByVal lpString As Long) As Long

Private Type LVGROUP_lp
    cbSize                  As Long
    mask                    As Long
    pszHeader               As Long
    cchHeader               As Long
   
    pszFooter               As Long
    cchFooter               As Long
   
    iGroupId                As Long
   
    stateMask               As Long
    State                   As Long
    uAlign                  As Long
    ' IF >= WinVista
    pszSubtitle            As Long
    cchSubtitle            As Long
    pszTask                As Long
    cchTask                As Long
    pszDescriptionTop      As Long
    cchDescriptionTop      As Long
    pszDescriptionBottom   As Long
    cchDescriptionBottom   As Long
    iTitleImage            As Long
    iExtendedImage         As Long
    iFirstItem             As Long     ' Read only
    cItems                 As Long     ' Read only
    pszSubsetTitle         As Long   ' NULL if group is not subset
    cchSubsetTitle         As Long
End Type


Código: [Seleccionar]

Public Property Get GroupHeaderText(ByVal GroupID As Long) As String
    'EDITED BY CHIP! - FIXED GET TEXT POINTERS - ADDED LVGROUP_LP DATA TYPE
   
    If m_hListView Then
               
                Dim tLVG    As LVGROUP_lp
                Dim sBuffer As String
       
                sBuffer = Space$(260)
               
                With tLVG
                    .cbSize = Len(tLVG)
                    .mask = LVGF_HEADER
                    .cchHeader = 260
                    .pszHeader = StrPtr(sBuffer)
                End With
               
                If SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tLVG) <> -1 Then GroupHeaderText = CopyString(ByVal tLVG.pszHeader, True)
               
    End If

End Property

Private Function CopyString(ByVal inPtr As Long, _
    Optional ByVal inAsWide As Boolean = False) As String
    Dim BufLen As Long
    If (inAsWide) Then
        BufLen = lstrlenW(inPtr)
        If (BufLen > 0) Then
            CopyString = Space$(BufLen)
            Call lstrcpyW(ByVal StrPtr(CopyString), inPtr)
        End If
    Else
        BufLen = lstrlenA(inPtr)
        If (BufLen > 0) Then
            CopyString = Space$(BufLen)
            Call lstrcpyA(CopyString, inPtr)
        End If
    End If
End Function

Note, you do not need the CopyString function, but I have included it for reference. If you do not wish to include the function, then you can copy the Pointer to the String using:  lstrcpyW  (in cases that are not Unicode, then you would use lstrcpyA).

Here is a slightly optimized Let GroupHeaderText( that uses StrPtr() instead of the StrConv().

Código: [Seleccionar]

Public Property Let GroupHeaderText(ByVal GroupID As Long, newText As String)

    If m_hListView Then
        Dim group As LVGROUP_lp

        With group
            .cbSize = Len(group)
            .mask = LVGF_HEADER
            .pszHeader = StrPtr(newText)
            .cchHeader = Len(.pszHeader)
        End With
        Call SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, group)
       
    End If
   
End Property



Finally, I will have an updated version of my FilterItems() that includes support for filtering WHILE they groups are displayed (very cool), both Windows Vista/7 & Windows XP.

Thanks guys!

[Jen]

Gracefully resolve UNICODE for GroupHeader/GroupFooter/GroupSubtitle.

Código: [Seleccionar]

Public Enum eGroupInfo
    [iGroupHeaderText] = 0
    [iGroupFooterText] = 1
    [iGroupSubtitle] = 2
End Enum

Private Type LVGROUPW
    cbSize                  As Long
    Mask                    As Long
    pszHeader               As Long
    cchHeader               As Long

    pszFooter               As Long
    cchFooter               As Long

    iGroupId                As Long

    stateMask               As Long
    State                   As Long
    uAlign                  As Long
    ' SO >= WinVista
    pszSubtitle            As Long
    cchSubtitle            As Long
    pszTask                As Long
    cchTask                As Long
    pszDescriptionTop      As Long
    cchDescriptionTop      As Long
    pszDescriptionBottom   As Long
    cchDescriptionBottom   As Long
    iTitleImage            As Long
    iExtendedImage         As Long
    iFirstItem             As Long     ' Read only
    cItems                 As Long     ' Read only
    pszSubsetTitle         As Long     ' NULL if group is not subset
    cchSubsetTitle         As Long
End Type

Private 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

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 Declare Function SendMessageLongW Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, _
                                                                             ByVal wMsg As Long, _
                                                                             ByVal wParam As Long, _
                                                                             ByVal lParam As Long) As Long

Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, _
                                                    ByVal wMsg As Long, _
                                                    ByVal wParam As Long, _
                                                    lParam As Any) As Long

'//
'String manuplate (Unicode/ANSI)
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long

Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
Private Declare Function HeapSize Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long

'// Heap constants
Private Const HEAP_NO_SERIALIZE As Long = &H1
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4

'// LocalAlloc flags
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Const LPTR As Long = (LMEM_FIXED Or LMEM_ZEROINIT)

Private Const GMEM_FIXED As Long = &H0
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GPTR As Long = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long


Código: [Seleccionar]

Public Property Get GroupHeaderText(ByVal GroupID As Long) As String

Dim tGRP As LVGROUPW

    tGRP.cbSize = Len(tGRP)
    tGRP.Mask = LVGF_HEADER
    GroupHeaderText = psGetGroupText(GroupID, tGRP, iGroupHeaderText)

End Property

Public Property Let GroupHeaderText(ByVal GroupID As Long, Text As String)

'//XP/SP3 doesn't support,For Vista/Win7 above

Dim tGRP As LVGROUPW

    tGRP.cbSize = Len(tGRP)
    tGRP.Mask = LVGF_HEADER
    If Not pbSetGroupInfo(GroupID, tGRP, Text) Then
        'MsgBox "Failed to set groupheader."
    End If

End Property


Código: [Seleccionar]

Private Function psGetGroupText(ByVal GroupID As Long, _
                                tGRP As LVGROUPW, _
                                Optional ByVal iOption As eGroupInfo = iGroupHeaderText) As String

Dim lR As Long
Dim hMem As Long
Dim lPtrMem As Long
Dim b() As Byte
Dim sOut As String
Dim iPos As Long

    With tGRP
        Select Case iOption
        Case iGroupHeaderText
            .cchHeader = 260
            .pszHeader = pHeapAlloc(.cchHeader * 2)
            lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
            If Not lR = GroupID Then
                Call pHeapFree(.pszHeader)
                Exit Function
            End If
            sOut = pStringFromPointer(.pszHeader, m_bIsNT, True)
            iPos = InStr(sOut, vbNullChar)
            If (iPos > 1) Then
                psGetGroupText = Left(sOut, iPos - 1)
            Else
                psGetGroupText = sOut
            End If
            Exit Function

        Case iGroupFooterText
            .cchFooter = 260
            .pszFooter = pHeapAlloc(.cchFooter * 2)
            lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
            If Not lR = GroupID Then
                Call pHeapFree(.pszFooter)
                Exit Function
            End If
            sOut = pStringFromPointer(.pszFooter, m_bIsNT, True)
            iPos = InStr(sOut, vbNullChar)
            If (iPos > 1) Then
                psGetGroupText = Left(sOut, iPos - 1)
            Else
                psGetGroupText = sOut
            End If
            Exit Function

        Case iGroupSubtitle
            .cchSubtitle = 260
            .pszSubtitle = pHeapAlloc(.cchSubtitle * 2)
            lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
            If Not lR = GroupID Then
                Call pHeapFree(.pszSubtitle)
                Exit Function
            End If
            sOut = pStringFromPointer(.pszSubtitle, m_bIsNT, True)
            iPos = InStr(sOut, vbNullChar)
            If (iPos > 1) Then
                psGetGroupText = Left(sOut, iPos - 1)
            Else
                psGetGroupText = sOut
            End If
            Exit Function
        End Select

    End With
   

End Function

Private Function pbSetGroupInfo(ByVal GroupID As Long, _
                                tGRP As LVGROUPW, _
                                ByVal sText As String) As Boolean

Dim lR As Long
Dim hMem As Long
Dim lPtrMem As Long
Dim b() As Byte
Dim sAllocText As String

    With tGRP
        If .Mask = LVGF_HEADER Then
            If Len(sText) > 0 Then
                b = sText
                ReDim Preserve b(0 To UBound(b) + 2) As Byte
            Else
                ReDim b(0 To 1) As Byte
            End If
            .cchHeader = (UBound(b) + 1) / 2
           
            hMem = pHeapAlloc(Len(sText) * 2 + 2)
            CopyMemory ByVal hMem, b(0), .cchHeader * 2
            .pszHeader = hMem
       
            If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
                Call pHeapFree(.pszHeader)
                Exit Function
            End If
            Call pHeapFree(.pszHeader)
            pbSetGroupInfo = True
            Exit Function
        End If

        If .Mask = LVGF_FOOTER Then
            If Len(sText) > 0 Then
                b = sText
                ReDim Preserve b(0 To UBound(b) + 2) As Byte
            Else
                ReDim b(0 To 1) As Byte
            End If
            .cchFooter = (UBound(b) + 1) / 2
            hMem = pHeapAlloc(Len(sText) * 2 + 2)
            CopyMemory ByVal hMem, b(0), .cchFooter * 2
            .pszFooter = hMem
           
            If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
                Call pHeapFree(.pszFooter)
                Exit Function
            End If
            Call pHeapFree(.pszFooter)
            pbSetGroupInfo = True
            Exit Function
        End If

        If .Mask = LVGF_SUBTITLE Then
            If Len(sText) > 0 Then
                b = sText
                ReDim Preserve b(0 To UBound(b) + 2) As Byte
            Else
                ReDim b(0 To 1) As Byte
            End If
            .cchSubtitle = (UBound(b) + 1) / 2
            hMem = pHeapAlloc(Len(sText) * 2 + 2)
            CopyMemory ByVal hMem, b(0), .cchSubtitle * 2
            .pszSubtitle = hMem
           
            If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
                Call pHeapFree(.pszSubtitle)
                Exit Function
            End If
            Call pHeapFree(.pszSubtitle)
            pbSetGroupInfo = True
            Exit Function
        End If

    End With

End Function

'   Allocates an empty heap buffer of the specified size. This
'   function is used when receiving strings from APIs, for example.

Private Function pHeapAlloc(ByVal Length As Long) As Long

    pHeapAlloc = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Length)

End Function

'   pStringFromPointer
'   Dereferences a string buffer allocated by pHeapAlloc(),
'   optionally freeing it afterwards. If you use this function to dereference
'   pointers to strings not allocated by the framework, make sure you don't
'   try to free them as well or you'll get a GPF.

Public Function pStringFromPointer(ByVal Pointer As Long, Optional bUnicode As Boolean = True, Optional ByVal bFreeMemory As Boolean = False) As String

Dim sOut As String
Dim lLen As Long
Dim b() As Byte
           
    If bUnicode Then
        If Pointer Then
            lLen = lstrlenW(ByVal Pointer)
            If lLen Then
                ' allocate string with nLen chars
                pStringFromPointer = String$(lLen, 0)
                ' copy 2x nLen bytes for Unicode
                CopyMemory ByVal StrPtr(pStringFromPointer), ByVal Pointer, 2 * lLen
                'lstrcpyW ByVal StrPtr(pStringFromPointer), ByVal Pointer
            End If
            If bFreeMemory Then Call pHeapFree(Pointer)
        End If
    Else
        If Pointer Then
            lLen = lstrlenA(ByVal Pointer)
            If lLen Then
                ' allocate buffer with nLen bytes
                ReDim b(0 To lLen - 1) As Byte
                ' copy nLen bytes for ANSI
                CopyMemory b(0), ByVal Pointer, lLen
                pStringFromPointer = StrConv(b(), vbUnicode)
            End If
            If bFreeMemory Then Call pHeapFree(Pointer)
        End If
    End If

End Function


'   Frees a string buffer allocated by cbxAllocStr() or
'   pHeapAlloc(). You should not use the memory pointer
'   to by Pointer after you call in here since the memory
'   location itself will no longer exist and you'll just GPF.

Public Function pHeapFree(ByVal Pointer As Long) As Long

    If Pointer Then
        pHeapFree = HeapFree(GetProcessHeap(), 0, ByVal Pointer)
    End If

End Function



[Jen]

Bugs report: ucListviewEx 2.5 can't return LVIS_FOCUSED.  ( LVIS_FOCUSED is different with LVIS_SELECTED,of cource)

Edited: it may not be a bug. I think we need a workaround using subclass.

Código: [Seleccionar]

   Dim i As Long
   ucListView1.ItemFocused(2) = True
   Debug.Print ucListView1.ItemFocused(2)
    i = ucListView1.RowInFocus
   Debug.Print "RowInFocus=";i


Código: [Seleccionar]

Public Property Get ItemFocused(ByVal Item As Long) As Boolean

    If (m_hListView) Then
        ItemFocused = CBool(SendMessageLong(m_hListView, LVM_GETITEMSTATE, Item, LVIS_FOCUSED))
    End If

End Property

Public Property Let ItemFocused(ByVal Item As Long, ByVal Focused As Boolean)

Dim uLVI As LVITEM 'LVITEMW

    If (m_hListView) Then
        With uLVI
            .stateMask = LVIS_FOCUSED
            .State = -Focused * LVIS_FOCUSED
            .Mask = LVIF_STATE
        End With
        Call SendMessage(m_hListView, LVM_SETITEMSTATE, Item, uLVI)
    End If

End Property
Public Property Get RowInFocus() As Long
'*/ [get] focused item
Dim i As Long
Dim bFocus As Boolean
   
    RowInFocus = -1
    If (m_hListView) Then
       For i = 0 To Me.ItemCount - 1
        bFocus = CBool(SendMessageLongW(m_hListView, LVM_GETITEMSTATE, i, LVIS_FOCUSED))
        If bFocus Then RowInFocus = i: Exit For
       Next
    End If
   
End Property

Challenge for everyone:
   Obama said: "We can do new things,we do big things". 
   How to fully simulate Win7 Explorer Listview's item & subitem Drag-Drop? I never saw someone did in VB6.

[raul338]

Thanks to all, It looks like I have a lot of work to do 

Challenge for everyone:
   Obama said: "We can do new things,we do big things". 
   How to fully simulate Win7 Explorer Listview's Drag-Drop? I never saw someone did in VB6.

Leandro Ascierto did that in "Explorador Remoto 2" in the File Explorer, just Drag&Drop to download File

[Jen]

Thanks to all, It looks like I have a lot of work to do 

Challenge for everyone:
   Obama said: "We can do new things,we do big things". 
   How to fully simulate Win7 Explorer Listview's Drag-Drop? I never saw someone did in VB6.

Leandro Ascierto did that in "Explorador Remoto 2" in the File Explorer, just Drag&Drop to download File

I means Items or SubItems drag-drop at internal control or two ucListviewex control.

[raul338]

I means Items or SubItems drag-drop at internal control or two ucListviewex control.

It just depends on how you handle de OLEDrop and OLEStartDrag by setting the datatype and what to drag (string/binary data, etc)

[chip]

Gracefully resolve UNICODE for GroupHeader/GroupFooter/GroupSubtitle.

Código: [Seleccionar]

Public Property Get GroupHeaderText(ByVal GroupID As Long) As String

Dim tGRP As LVGROUPW

    tGRP.cbSize = Len(tGRP)
    tGRP.Mask = LVGF_HEADER
    GroupHeaderText = psGetGroupText(GroupID, tGRP, iGroupHeaderText)

End Property

Public Property Let GroupHeaderText(ByVal GroupID As Long, Text As String)

'//XP/SP3 doesn't support,For Vista/Win7 above

Dim tGRP As LVGROUPW

    tGRP.cbSize = Len(tGRP)
    tGRP.Mask = LVGF_HEADER
    If Not pbSetGroupInfo(GroupID, tGRP, Text) Then
        'MsgBox "Failed to set groupheader."
    End If

End Property


Hi Jen, thanks for the example. I am always looking to learn. Are you suggesting this is better than the solution I suggested? If so, would you mind sharing more? Does UNICODE chars not work with my solution? I see you have used HeapAlloc, LocalAlloc & CopyMemory which I had found to be a solution as well, but then I found it to work with the simpler StrPtr() and lstrlenW/lstrcpyW?

Also, I tested both Get GroupHeaderText and Let GroupHeaderText using my solution on both Win7 & Win XP and it worked. (however you had suggested Let GroupHeaderText '//XP/SP3 doesn't support,For Vista/Win7 above)

Please advise, and thank you.

Gracias !

[Jen]

From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))
The Code your provided might be OK though there's a mistake:

 .cchHeader = Len(.pszHeader)  'Always is 4 because .pszHeader is defined in Long,Should be Len(newText)

Código: [Seleccionar]

Public Property Let GroupHeaderText(ByVal GroupID As Long, newText As String)

    If m_hListView Then
        Dim group As LVGROUP_lp

        With group
            .cbSize = Len(group)
            .mask = LVGF_HEADER
            .pszHeader = StrPtr(newText)
            .cchHeader =Len(.pszHeader)
        End With
        Call SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, group)
       
    End If
   
End Property


[raul338]

From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))

I dont know why, but, sometimes the group header text can be changed, other times no. I still don't know why Im testing that too on WinXP (If works in winxp it should work in vista/7 too)