Visual Basic Common Control API Routines
CreateFontIndirect: Change ListView Header Text Style
     
Posted:   Monday September 1, 1997
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
This method is intended for Visual Basic 5 or Visual Basic 6 where the Common Control library used is the MSComCtl 5 version (comctl32.ocx). Because the VB6-specific mscomctl.ocx (Common Controls 6) is a complete implementation of comctl32.dll and not reliant on the version of comctl32.dll installed, this routine may not work when applied to a listview created from the VB6-specific mscomctl.ocx.

Enhanced Comctl32 functionality is only available to users with comctl32.dll version 4.70 or greater installed. This dll is typically installed with IE3.x or greater.


Depending on the needs of your application, the standard header font of a listview may prove inadequate for your needs. Unfortunately, the listview API structures and constants do not provide a direct means to specify the font attributes of the header. But by using several standard API functions not normally associated with listview controls, the font can be controlled by the developer.

The Windows API provides access to the display fonts used for windows and controls through the font objects and the LOGFONT structure. The developer has access to several standard (default) font styles (DEFAULT_GUI_FONT, SYSTEM_FONT, OEM_FIXED_FONT etc), as well as the capability to create new fonts on the fly using the CreateFontIndirect API. This demo uses CreateFontIndirect, the LOGFONT structure, GetObject, SelectObject, DestroyObject and our old friend SendMessage to obtain the current font used in the listview header, and then make modifications to the details in the LOGFONT structure to affect the desired look. Though the underlined or strikeout options would most probably never be used, they are nonetheless presented here for completeness.

This example does not contain all code required to construct the illustration shown. The routine provided here is designed to be applied to an existing project utilizing a ListView control with subitems.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'hHeaderFont is the handle to the font used to draw the 
'header text, and must not be destroyed unless no longer 
'needed (see the Unload event).   
Public hHeaderFont As Long
   
'vars representing the checkbox options in 
'the Check1 control array.   
Public Const optBold = 0
Public Const optItalic = 1
Public Const optUnderlined = 2
Public Const optStrikeout = 3
   
'-----------------------------------------------
'APIs, constants and structures required to change the listview header font   
Public Const LVM_FIRST = &H1000
Public Const LVM_GETHEADER = (LVM_FIRST + 31)
      
'font weight vars   
Public Const FW_NORMAL = 400
Public Const FW_BOLD = 700
   
'SendMessage vars   
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31

Public Const LF_FACESIZE = 32

Public Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   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) As Byte
End Type

Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" _ 
   (ByVal hwnd As Long, _
    ByVal Msg As Long, _ 
    ByVal wParam As Long, _
    lParam As Any) As Long

Public Declare Function GetObject Lib "gdi32" _
    Alias "GetObjectA" _
   (ByVal hObject As Long, _
    ByVal nCount As Long, _
    lpObject As Any) As Long

Public Declare Function SelectObject Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal hObject As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" _
   (ByVal hObject As Long) As Long

Public Declare Function CreateFontIndirect Lib "gdi32" _
    Alias "CreateFontIndirectA" _
   (lpLogFont As LOGFONT) As Long
 Form Code
Add four check buttons (Check1()) in a control array with the font captions indicated in the illustration. The initial value for each should be 0 - Unchecked.   Paste the following code into the General Declarations area of the form:

Option Explicit

Private Sub Check1_Click(Index As Integer)

   SetHeaderFontStyle

End Sub

Private Sub SetHeaderFontStyle()

   Dim LF As LOGFONT
   Dim hCurrFont As Long
   Dim hOldFont As Long
   Dim hHeader As Long   
   
  'get the windows handle to the header
  'portion of the listview   
   hHeader = SendMessage(ListView1.hwnd, LVM_GETHEADER, 0, ByVal 0)
   
  'get the handle to the font used in the header   
   hCurrFont = SendMessage(hHeader, WM_GETFONT, 0, ByVal 0)
   
  'get the LOGFONT details of the
  'font currently used in the header   
  If GetObject(hCurrFont, Len(LF), LF) > 0 Then
     'if GetObject was successful...   
     'set the font attributes according to the selected check boxes  
      If Check1(optBold).Value = 1 Then
         LF.lfWeight = FW_BOLD
      Else
         LF.lfWeight = FW_NORMAL
      End If

      LF.lfItalic = Check1(optItalic).Value = 1
      LF.lfUnderline = Check1(optUnderlined).Value = 1
      LF.lfStrikeOut = Check1(optStrikeout).Value = 1
     
     'clean up by deleting any previous font   
      Call DeleteObject(hHeaderFont)
      
     'create a new font for the header control to use.
     'This font must NOT be deleted until it is no
     'longer required by the control, typically when
     'the application ends (see the Unload sub), or 
     'above as a new font is to be created.   
      hHeaderFont = CreateFontIndirect(LF)
      
     'select the new font as the header font    
     hOldFont = SelectObject(hHeader, hHeaderFont)
      
     'and inform the listview header of the change 
      Call SendMessage(hHeader, WM_SETFONT, hHeaderFont, ByVal True)
   
   End If

End Sub


'In order to assure that resources are freed, add the following 
'into the form's Unload event.  (If you chose to set the font type 
'to one of the stock fonts supplied by Windows (which this example 
'is not doing), never delete that)
Private Sub Form_Unload(Cancel As Integer)

   If hHeaderFont > 0 Then
      Call DeleteObject(hHeaderFont)
   End If
  
End Sub
 Comments
Populate your ListView as usual; the listview header will reflect the currently selected font options.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter