COLORIZE a bold font in the header of column 1

[sal21]

here my code to fill the column:

 Private Sub CREA_LVORARI()

    Dim DA As Date, A As Date
    Dim D As Date

    If Not (RS Is Nothing) Then
        If (RS.State And adStateOpen) = adStateOpen Then RS.Close
        Set RS = Nothing
    End If

    SQL = "SELECT * FROM TIPO_SERVIZIO"
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
    RS.Sort = ("ID")

    With Me.LVORARI

        LockWindowUpdate Me.hwnd

        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , "TAVOLO", 2000
        .ColumnHeaders.Add , , "DATA", 1000, lvwColumnCenter
        .ColumnHeaders.Add , , "INDICE", 0, lvwColumnCenter

        Do While Not RS.EOF

            DA = RS.Fields(2).Value
            A = RS.Fields(3).Value

            For D = DA To A + 0.000001 Step TimeSerial(0, 30, 0)
                .ColumnHeaders.Add , , Format$(D, "HH:MM"), 600, lvwColumnCenter
            Next D

            RS.MoveNext
        Loop
        
        .ColumnHeaders.Add , , "FULL", 700, lvwColumnCenter

        LockWindowUpdate 0&

    End With

    If Not (RS Is Nothing) Then
        If (RS.State And adStateOpen) = adStateOpen Then RS.Close
        Set RS = Nothing
    End If

End Sub

possible to colorize the font in bold with the color in rectangle.?

are the steep of hour from breakfast lunch and dinner

 

[strongm]

Again, you are wanting to do something with the control that it cannot do ...

Again, the solution is some custom OwnerDraw code.

But we can't directly use the customdraw code we have used previously. Mainly because of the way CustomDraw notifications work - which is that they are sent to the parent of the control. So, our code subclassed the Form because the Form gets the LV ownerdraw notifications.

However, the header in a ListView is itself a control. So it sends its ownerdraw notifications to ... the listview itself - so we would have to subclass the listview instead ...

Not tried this myself, to be honest. But the theory is sound.

 

[sal21]

HI strongm!
googoling....

found this but not for me.

 

[strongm]

Yep, and pretty much following the concept I outlined above. As I have previously said, OwnerDraw (or, to be pedantic, CustomDraw) is not particularly straightforward, as you should have been able to see from my example(s) to you over the last several months. And whilst the example you seem to have found now does seem to me to be a bit overengineered, it also illustrates that this is not particularly simple to implement.

If - and there's no promise or commitment here - IF I get some free time I'll look to what should be a relatively simple modification to my code that illustrated different colour highlighting to illustrate bold, coloured headings instead

 

[strongm]

OK, got some code that results in the following:

 

[strongm]

OK, you need a form with a listview

The copy an dpaste the following code into the form

[COLOR=blue]Option Explicit

Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
Private OnceExecuted As Boolean

Private Sub Form_Activate()
    Dim myFont As IFont
    
    [COLOR=green]' Use secondary interface so we can get a GDI font handle to a font that is based on LV font object[/color]
    Set myFont = ListView1.Font
    myFont.Clone clonefont
    clonefont.Name = "Verdana"
    clonefont.Bold = True
    clonefont.Size = 9
    
    [COLOR=green]' Now populate the LV and subclass it for CustomDraw of the Header row[/color]
    If Not OnceExecuted Then
        PopulateListView ListView1
        SubClass ListView1.hWnd
        OnceExecuted = True
        LVHighlightColour = vbBlue
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnSubClass
    Set Form1 = Nothing
End Sub

Private Sub SubClass(ByVal hWnd As Long)
    UnSubClass
    mWndProcNext = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    If mWndProcNext Then mhWndSubClassed = hWnd
End Sub

Private Sub UnSubClass()
    If mWndProcNext Then
        SetWindowLong mhWndSubClassed, GWL_WNDPROC, mWndProcNext
        mWndProcNext = 0
    End If
End Sub

[COLOR=green]' This just provides some basic content for the LV[/color]
Private Sub PopulateListView(lv As ListView)
    Dim i As Integer
    Dim st As String
    Dim lvItem As ListItem
    Dim i2 As Long
    Dim mycol As ColumnHeader
    
    lv.ColumnHeaders.Add.Text = "TAVALO"
    lv.ColumnHeaders.Add.Text = "DATA"
    
    For i = 7 To 19 Step 5
        For i2 = 0 To 5
            Set mycol = lv.ColumnHeaders.Add
            mycol.Text = Format(TimeSerial(i, i2 * 30, 0), "hh:mm")
            mycol.Width = 800
        Next
    Next
    lv.ColumnHeaders.Add.Text = "Full"
       
    For i = 1 To 30
        Set lvItem = lv.ListItems.Add(i, , "This item contains text " & i, 3, 3)
        With lvItem
            .Tag = ""
            .ListSubItems.Add 1, , Format$(DateSerial(2005, 1, 31 - i), "dd.mm.yyyy")
            .ListSubItems.Add 2, , Format$(Rnd * 10000, ".0000")
            .SmallIcon = 3
        End With
    Next
        
    lv.SortOrder = lvwDescending
    lv.ListItems(1).Selected = True
    
End Sub[/color]

And then the following code in a module:

[COLOR=blue]Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Public hFont As Long
Public clonefont As IFont

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

Private Type NMHDR
    hwndFrom As Long
    idfrom As Long
    code As Long
End Type
'
Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long [COLOR=green]' this is control specific, but it's how to specify an item.  valid only with CDDS_ITEM bit set[/color]
    uItemState As Long
    lItemlParam As Long
End Type

Private Type NMLVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    iSubItem As Long
End Type

Private Type lvItem
    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

Public Const GWL_WNDPROC = (-4)

Private Const NM_FIRST As Long = 0
Private Const NM_CUSTOMDRAW As Long = (NM_FIRST - 12)
Private Const WM_NOTIFY As Long = &H4E

[COLOR=green]' CustomDraw paint stages.[/color]
Private Const CDDS_PREPAINT = &H1
Private Const CDDS_ITEMPREPAINT = (&H10000 Or &H1)
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)

[COLOR=green]' CustomDraw return values.[/color]
Private Const CDRF_NOTIFYITEMDRAW = &H20&
Private Const CDRF_NOTIFYPOSTPAINT As Long = &H10
Private Const CDRF_DODEFAULT As Long = &H0
Private Const CDRF_NEWFONT As Long = &H2


Public mhWndSubClassed As Long
Public mWndProcNext As Long
Public LVHighlightColour As Long

Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Dim tNMH As NMHDR
    
    If uMsg = WM_NOTIFY Then
        CopyMemory tNMH, ByVal lParam, Len(tNMH)
        If tNMH.code = NM_CUSTOMDRAW Then
            WindowProc = plCustomDrawHeader(lParam)
            Exit Function
        End If
    End If
    
    WindowProc = CallWindowProc(mWndProcNext, hWnd, uMsg, wParam, ByVal lParam)
    
End Function

Private Function plCustomDrawHeader(ByVal lParam As Long) As Long
    Dim NMLVCD As NMLVCUSTOMDRAW
    Dim lLen As Long
    Dim lvRowIndex As Long

    [COLOR=green]' Get the CustomDraw data.[/color]
    lLen = LenB(NMLVCD)
    CopyMemory NMLVCD, ByVal lParam, lLen
    
    lvRowIndex = NMLVCD.nmcd.dwItemSpec
    
    Select Case NMLVCD.nmcd.dwDrawStage
        Case CDDS_PREPAINT
            [COLOR=green]' Tell it we want to be told when an item is drawn.[/color]
            plCustomDrawHeader = CDRF_NOTIFYITEMDRAW
        Case CDDS_ITEMPREPAINT
            SelectObject NMLVCD.nmcd.hDC, clonefont.hFont
            Select Case NMLVCD.nmcd.dwItemSpec
                Case 2 To 7
                    SetTextColor NMLVCD.nmcd.hDC, vbBlue
                Case 8 To 13
                    SetTextColor NMLVCD.nmcd.hDC, vbRed
                Case 14 To 19
                    SetTextColor NMLVCD.nmcd.hDC, RGB(225, 127, 0) [COLOR=green]'orangish[/color]
                Case Else
            End Select

            plCustomDrawHeader = CDRF_NOTIFYPOSTPAINT
        Case CDDS_ITEMPOSTPAINT
            plCustomDrawHeader = CDRF_NEWFONT
        Case Else
            plCustomDrawHeader = CDRF_DODEFAULT
    End Select
    
End Function
[/color]

 

[sal21]

GREAT!