change font in listview sub item
change font in listview sub item
change font in listview sub item
change font in listview sub item
change font in listview sub item
change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item
change font in listview sub item change font in listview sub item
change font in listview sub item
Go Back  Xtreme Visual Basic Talk > > > change font in listview sub item


Reply
 
Thread Tools Display Modes
  #1  
Old 08-16-2017, 09:52 AM
sal21 sal21 is offline
Junior Contributor
 
Join Date: Mar 2004
Posts: 260
Default change font in listview sub item


Possible to chnge font from arial 8 to wingding 8 in single cell/listsubitem in listview?

or possible to use:

lvItem.ListSubItems(3).Font.Name = "Wingdings 2"

Last edited by sal21; 08-16-2017 at 11:05 AM.
Reply With Quote
  #2  
Old 08-17-2017, 05:51 AM
fafalone fafalone is offline
Freshman
 
Join Date: May 2010
Posts: 37
Default

There's no Font property for a ListSubItem, no.

The only way to do it is to subclass the ListView for the NM_CUSTOMDRAW message.

First, you need to create the font at a module level:
Code:
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Public Const LOGPIXELSY = 90

Public Enum FontWeight
        FW_DONTCARE = 0
        FW_THIN = 100
        FW_EXTRALIGHT = 200
        FW_LIGHT = 300
        FW_NORMAL = 400
        FW_MEDIUM = 500
        FW_SEMIBOLD = 600
        FW_BOLD = 700
        FW_EXTRABOLD = 800
        FW_HEAVY = 900
        FW_ULTRALIGHT = FW_EXTRALIGHT
        FW_REGULAR = FW_NORMAL
        FW_DEMIBOLD = FW_SEMIBOLD
        FW_ULTRABOLD = FW_EXTRABOLD
        FW_BLACK = FW_HEAVY  
End Enum
Public Const DEFAULT_PITCH = 0
Public Const FIXED_PITCH = 1
Public Const VARIABLE_PITCH As Integer = 2
Public Const FF_DONTCARE = 0
Public Const FF_ROMAN = 16
Public Const FF_SWISS = 32
Public Const FF_MODERN = 48
Public Const FF_SCRIPT = 64
Public Const FF_DECORATIVE = 80

Public Const DEFAULT_QUALITY = 0
Public Const DRAFT_QUALITY = 1
Public Const PROOF_QUALITY = 2
Public Const NONANTIALIASED_QUALITY = 3
Public Const ANTIALIASED_QUALITY = 4
Public Const CLEARTYPE_QUALITY = 5
Public Const CLEARTYPE_NATURAL_QUALITY = 6

Public Const DEFAULT_CHARSET As Byte = &H1

Public Const LF_FACESIZE = 32

Public Type LOGFONT 'LOGFONTA, use with CreateFontIndirectA
        LFHeight As Long
        LFWidth As Long
        LFEscapement As Long
        LFOrientation As Long
        LFWeight As FontWeight
        LFItalic As Byte
        LFUnderline As Byte
        LFStrikeOut As Byte
        LFCharset As Byte
        LFOutPrecision As Byte
        LFClipPrecision As Byte
        LFQuality As Byte
        LFPitchAndFamily As Byte
        LFFaceName(LF_FACESIZE - 1) As Byte
End Type
Public hFont1 As Long 'Your main font
Public hFont2 As Long 'Wingdings

Public Sub InitFonts()
Dim lfFont1 As LOGFONT, lfFont2 As LOGFONT
With lfFont1
    .LFFaceName(0) = &H41 'ARIAL
    .LFFaceName(1) = &H52
    .LFFaceName(2) = &H49
    .LFFaceName(3) = &H41
    .LFFaceName(4) = &H4C
    
    .LFHeight =  -MulDiv(8, GetDeviceCaps(GetDC(0&), LOGPIXELSY), 72) 'where 8 is point size
    .LFCharset = DEFAULT_CHARSET
    .LFPitchAndFamily = VARIABLE_PITCH Or FF_DONTCARE
    .LFQuality = CLEARTYPE_QUALITY

    .LFWeight = FW_NORMAL
    hFont1 = CreateFontIndirect(lfFont1)
End With
With lfFont2
    .LFFaceName(0) = &H57 'WINGDINGS 2
    .LFFaceName(1) = &H49
    .LFFaceName(2) = &H4E
    .LFFaceName(3) = &H47
    .LFFaceName(4) = &H44
    .LFFaceName(5) = &H49
    .LFFaceName(6) = &H4E
    .LFFaceName(7) = &H47
    .LFFaceName(8) = &H53
    .LFFaceName(9) = &H20
    .LFFaceName(10) = &H32
    
    .LFHeight =  -MulDiv(8, GetDeviceCaps(GetDC(0&), LOGPIXELSY), 72)
    .LFCharset = DEFAULT_CHARSET
    .LFPitchAndFamily = VARIABLE_PITCH Or FF_DONTCARE
    .LFQuality = CLEARTYPE_QUALITY

    .LFWeight = FW_NORMAL
    hFont2 = CreateFontIndirect(lfFont2)
End With
End Sub
You'll want to call that in your startup routine, before you subclass the ListView.

There's dozens of ListView subclass examples out there, so I won't presume to choose which one works best for you, but they all have a point where they're handling WM_NOTIFY (or OCM_NOTIFY like Brad Martinez's VBExplorer) messages... NM_CUSTOMDRAW goes with the other ListView notifications (LVN_whatever)...
Code:
Public Const NM_CUSTOMDRAW = (-12&)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Type NMHDR
  hWndFrom As Long   ' Window handle of control sending message
  IDFrom As Long        ' Identifier of control sending message
  Code  As Long          ' Specifies the notification code
End Type
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDc As Long
    RC As RECT
    dwItemSpec As Long
    uItemState As Long
    lItemlParam As Long
End Type
Public Enum LVCD_ItemType
    LVCDI_ITEM = &H0
    LVCDI_GROUP = &H1
    LVCDI_ITEMSLIST = &H2
End Enum
Public Type NMLVCUSTOMDRAW
  NMCD As NMCUSTOMDRAW
  ClrText As Long
  ClrTextBk As Long
  ' if IE >= 4.0 this member of the struct can be used
  iSubItem As Integer
  '>=5.01
  dwItemType As LVCD_ItemType
  clrFace As Long
  iIconEffect As Integer
  iIconPhase As Integer
  iPartId As Integer
  iStateId As Integer
  rcText As RECT
  uAlign As Long
End Type
Public Const CDDS_PREPAINT As Long = &H1&
Public Const CDDS_ITEM As Long = &H10000
Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Public Const CDDS_SUBITEM = &H20000
Public Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)
Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Public Const CDRF_NOTIFYSUBITEMDRAW As Long = &H20&
Public Const CDRF_NEWFONT As Long = &H2&


'{psuedocode}Public Function WndProc(uMsg, etc)
'If uMsg = WM_NOTIFY/OCM_NOTIFY...
'{/pseudocode}
Dim tNMH As NMHDR
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.Code
    'LVN_ messages
    '...
    '...
            Case NM_CUSTOMDRAW
                Dim NMLVCD As NMLVCUSTOMDRAW
                CopyMemory NMLVCD, ByVal lParam, Len(NMLVCD)
                With NMLVCD.NMCD
                    Select Case .dwDrawStage
                        Case CDDS_PREPAINT
                            WndProc = CDRF_NOTIFYITEMDRAW 'or DoLVNotify= etc
                            Exit Function
                        Case CDDS_ITEMPREPAINT
                            WndProc = CDRF_NOTIFYSUBITEMDRAW
                            Exit Function
                        Case CDDS_ITEMPREPAINT Or CDDS_SUBITEM
                                If NMLVCD.iSubItem = 3 Then
                                    SelectObject .hDC, hFont2 'your Wingdings font handle
                                Else
                                    SelectObject .hDC, hFont1 'your normal font; if not reset subitem 4,5,etc will be hFont2
                                End If
                                WndProc = CDRF_NOTIFYSUBITEMDRAW
                                Exit Function

                        Case CDDS_ITEMPOSTPAINT
                            WndProc = CDRF_NEWFONT
                            Exit Function
                    End Select
                End With
End Select
Finally when you exit your program destroy your fonts...
Code:
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Sub DestroyFont()
DeleteObject hFont1
DeleteObject hFont2
End Sub
I've got a ListView set up for custom fonts already, so I tested out doing the above to turn the 3rd subitem into WingDings, worked perfect:
Attached Images
File Type: jpg wd.jpg (48.9 KB, 5 views)

Last edited by fafalone; 08-17-2017 at 06:50 AM.
Reply With Quote
Reply

Tags
arial, font, listsubitem, listview, wingding, item, change


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
change font in listview sub item
change font in listview sub item
change font in listview sub item change font in listview sub item
change font in listview sub item
change font in listview sub item
change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item change font in listview sub item
change font in listview sub item
change font in listview sub item
 
change font in listview sub item
change font in listview sub item
 
-->