Trucos ListView : Cambiar tipo de letra de la cabecera

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



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com