| 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. |
|
