
La funcionalidad extendida de la dll Comctl32.dll sólo está disponible para la versión 4.70 y superiores (instaladas por el IE 3.x y el IE 4)
Hay ocasiones en que la fuente de la cabecera del ListView es inadecuada a nuestras necesidades. Desafortunadamente las estructuras y constantes del API del ListView no proveen una manera directa de especificar el tipo de letra de la cabecera. Pero usando varias funciones estandard del API que no se suelen asociar con los ListViews podremos manipular dicha fuente.
El API de windows provee acceso a las fuentes usadas por ventanas y controles mediante los objetos fuente y la estructura LOGFONT. El desarrollador tiene acceso a varias fuentes por defecto (DEFAULT_GUI_FONT, SYSTEM_FONT,OEM_FIXED_FONT etc), y también la posibilidad de crear nuevas fuentes sobre la marcha empleando la función CreateFontIndirect. Este ejemplo emplea CreateFontIndirect, la estructura LOGFONT, GetObject, SelectObject, DestroyObject y SendMessage para obtener la fuente actual de la cabecera del ListView y hacer las modificaciones en la estructura LOGFONT para obtener el aspecto deseado.
Aunque las opciones subrayado y tachado probablemente nunca se utilicen las implementaremos de todas formas.
En un módulo :
'hHeaderFont es el handle de la fuente usada en la cabecera
'y no debe ser destruida hasta que deje de ser necesaria
'(ver el evento Unload del formulario)
Public hHeaderFont As Long
'contantes y estructuras necesarias para cambiar la fuente de la cabecera
Public Const LVM_FIRST = &H1000
Public Const LVM_GETHEADER = (LVM_FIRST + 31)
'grosores de la fuente
Public Const FW_NORMAL = 400
Public Const FW_BOLD = 700
'para SendMessage
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 SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) 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
Para modificar la fuente podremos emplear una rutina de este estilo :
Private Sub SetHeaderFontStyle(Neg as Boolean, Cur as Boolean _
Sub as Boolean, Tach as Boolean)
Dim LF As LOGFONT
Dim r As Long
Dim hCurrFont As Long
Dim hOldFont As Long
Dim hHeader As Long
'obtener un handle a la cabecera del listview
hHeader = SendMessageLong(ListView1.hwnd, LVM_GETHEADER, 0, 0)
'obtener un handle al fuente usada en la cabecera
hCurrFont = SendMessageLong(hHeader, WM_GETFONT, 0, 0)
'rellenar la estructura LF con las propiedades del font usado en
'la cabecera
r = GetObject(hCurrFont, Len(LF), LF)
'si GetObject fue correcto
If r > 0 Then
'modificar las propiedades de la fuente según loc checkbox
If Neg Then
LF.lfWeight = FW_BOLD
Else: LF.lfWeight = FW_NORMAL
End If
LF.lfItalic = Cur
LF.lfUnderline = Sub
LF.lfStrikeOut = Tach
'borrar la fuente anterior
r = DeleteObject(hHeaderFont)
'crear una nueva fuente. Esta fuente no debe ser borrada
'hasta que ya no sea necesaria, normalmente se borrará
'en el evento unload del formulario
hHeaderFont = CreateFontIndirect(LF)
'seleccionar la nueva fuente como fuente de la cabecera
hOldFont = SelectObject(hHeader, hHeaderFont)
'informar a la cabecera del ListView del cambio
r = SendMessageLong(hHeader, WM_SETFONT, hHeaderFont, True)
End If
End Sub
Para asegurarnos de liberar los recursos, añadiremos el siguiente código en el evento Unload del formulario (si eliges asignar el tipo de letra a uno de los estandar de windows, cosa que este ejemplo no hace, nunca debes borrarla).
If hHeaderFont > 0 Then
Dim r As Long
r = DeleteObject(hHeaderFont)
End If

