CommonControls (Replacement of the MS common controls)

[npac4o]

Hi Krool,

Thank you for your effort to keep this project alive and up-to-date, it's a huge commitment, also huge time-consumer. Appreciate it.

Today I decided to replace some of components in my application with a ListView control. Since dark theme is widely used nowadays, my app also support it. However, when I added Groups to my listview, the result wasn't very beautiful as you can see below:



Initially, I tried to set fore color of the Group text as follows:

Friend Property Let FGroupForeColor(ByVal Value As OLE_COLOR)
Dim groupMetrics As LVGROUPMETRICS

groupMetrics.cbSize = Len(groupMetrics)
groupMetrics.Mask = LVGMF_TEXTCOLOR
groupMetrics.crHeader = Value

If ListViewHandle <> 0 Then
    SendMessage ListViewHandle, LVM_SETGROUPMETRICS, 0, ByVal VarPtr(groupMetrics)
    Me.Refresh
End If
End Property

Unfortunately, LVGMF_TEXTCOLOR is not implemented (really) and the result was...none.

Most of the Google results state that changing color of group text is not possible (like this). However, I found that article in MSDN forum:

https://social.msdn.microsoft.com/Fo...orum=vbgeneral

and after some time, I had this:



After adding centered blank header title:


The code is quite ugly but it works somehow, just to prove that it is completely possible to draw a custom Group header:

       Case NM_CUSTOMDRAW
                        Dim FontHandle As Long, Bold As Boolean, ForeColor As OLE_COLOR
                        Dim NMLVCD     As NMLVCUSTOMDRAW

                        CopyMemory NMLVCD, ByVal lParam, LenB(NMLVCD)

                        Select Case NMLVCD.NMCD.dwDrawStage
                            Case CDDS_PREPAINT
                                WindowProcUserControl = CDRF_NOTIFYITEMDRAW

                                If NMLVCD.dwItemType = LVCDI_GROUP Then
                                    Dim rectHeader As RECT: rectHeader.Top = LVGGR_HEADER
                                    Dim nItem      As Long: nItem = NMLVCD.NMCD.dwItemSpec
                                    Dim nRet       As Long: nRet = SendMessage(ListViewHandle, LVM_GETGROUPRECT, nItem, rectHeader)
                                    
                                    Dim hPen       As Long: hPen = CreatePen(0, 1, vbRed)
                                    Dim OldhPen    As Long: OldhPen = SelectObject(NMLVCD.NMCD.hDC, hPen)
                                    Dim hBrush     As Long: hBrush = CreateSolidBrush(&H80FF&)
                                    Dim OldhBrush  As Long: OldhBrush = SelectObject(NMLVCD.NMCD.hDC, hBrush)
                                                                        
                                    Rectangle NMLVCD.NMCD.hDC, rectHeader.Left, rectHeader.Top, rectHeader.Right, rectHeader.Bottom
                                    Call SetTextColor(NMLVCD.NMCD.hDC, vbGreen)
                                    Call DrawText(NMLVCD.NMCD.hDC, "TEST1-2-3", Len("TEST1-2-3"), rectHeader, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)
                                    
                                    DeleteObject hPen: DeleteObject hBrush
                                End If

                                Exit Function

I believe that many people will appreciate a custom Group Header. My knowledge is not enough to make it bullet-proof, I just copy-paste. For example, now adding a footer doesn't work - IDE crash.

Dark theme really doesn't look good with blue group header

Thank you.

Edit: the code above doesn't break Group.Footer, in my case the Footer works only when SubsetLink is set, otherwise, the IDE crashes. It's the same with Standard EXE Version sample.

        With .Groups.Add(, , "Header Title")
            '.SubsetLink = "Subset Link?"
            .Footer = "Footer Title"
            .FooterAlignment = LvwGroupFooterAlignmentCenter
        End With