Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

COLORIZE a bold font in the header of column

COLORIZE a bold font in the header of column

COLORIZE a bold font in the header of column

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

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

    With Me.LVORARI

        LockWindowUpdate Me.hwnd

        .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

        .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

RE: COLORIZE a bold font in the header of column

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.

RE: COLORIZE a bold font in the header of column

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

RE: COLORIZE a bold font in the header of column

OK, got some code that results in the following:

RE: COLORIZE a bold font in the header of column

OK, you need a form with a listview

The copy an dpaste the following code into the form

CODE -->

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
    ' Use secondary interface so we can get a GDI font handle to a font that is based on LV font object
    Set myFont = ListView1.Font
    myFont.Clone clonefont
    clonefont.Name = "Verdana"
    clonefont.Bold = True
    clonefont.Size = 9
    ' Now populate the LV and subclass it for CustomDraw of the Header row
    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)
    Set Form1 = Nothing
End Sub

Private Sub SubClass(ByVal hWnd As Long)
    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

' This just provides some basic content for the LV
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
    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
    lv.SortOrder = lvwDescending
    lv.ListItems(1).Selected = True
End Sub 

And then the following code in a module:

CODE -->

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
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long ' this is control specific, but it's how to specify an item.  valid only with CDDS_ITEM bit set
    uItemState As Long
    lItemlParam As Long
End Type

    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

' CustomDraw paint stages.
Private Const CDDS_PREPAINT = &H1
Private Const CDDS_ITEMPREPAINT = (&H10000 Or &H1)
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)

' CustomDraw return values.
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 lLen As Long
    Dim lvRowIndex As Long

    ' Get the CustomDraw data.
    lLen = LenB(NMLVCD)
    CopyMemory NMLVCD, ByVal lParam, lLen
    lvRowIndex = NMLVCD.nmcd.dwItemSpec
    Select Case NMLVCD.nmcd.dwDrawStage
        Case CDDS_PREPAINT
            ' Tell it we want to be told when an item is drawn.
            plCustomDrawHeader = CDRF_NOTIFYITEMDRAW
            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) 'orangish
                Case Else
            End Select

            plCustomDrawHeader = CDRF_NOTIFYPOSTPAINT
            plCustomDrawHeader = CDRF_NEWFONT
        Case Else
            plCustomDrawHeader = CDRF_DODEFAULT
    End Select
End Function

RE: COLORIZE a bold font in the header of column


Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close