Colorear columna ListView

[E N T E R]

Hay alguna manera de pintar solo la columna seleccionada y tambien colorear la fuente.

Ejemplo:

[Lolabyte]

Si usas listview 6, aqui hay un ejemplo para colorear columna seleccionada

http://vbnet.mvps.org/index.html?code/comctl/lvcolumnhilite.htm



Debes guardar todo el codigo en un archivo llamado form1.frm

Código: (vb6) [Seleccionar]

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4545
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   7155
   LinkTopic       =   "Form1"
   ScaleHeight     =   4545
   ScaleWidth      =   7155
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1
      Height          =   315
      Left            =   4680
      ScaleHeight     =   255
      ScaleWidth      =   375
      TabIndex        =   4
      Top             =   4140
      Visible         =   0   'False
      Width           =   435
   End
   Begin MSComctlLib.ListView ListView1
      Height          =   3855
      Left            =   120
      TabIndex        =   3
      Top             =   60
      Width           =   6915
      _ExtentX        =   12197
      _ExtentY        =   6800
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton Command1
      Caption         =   "Highlight Column"
      Height          =   375
      Left            =   1740
      TabIndex        =   2
      Top             =   4080
      Width           =   1875
   End
   Begin VB.ComboBox Combo1
      Height          =   315
      Left            =   840
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   4080
      Width           =   675
   End
   Begin VB.Label Label1
      Caption         =   "Col:"
      Height          =   315
      Left            =   240
      TabIndex        =   0
      Top             =   4080
      Width           =   495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Enum ImageSizingTypes
   [sizeNone] = 0
   [sizeCheckBox]
   [sizeIcon]
End Enum

Private Enum LedgerColours
  vbledgerWhite = &HF9FEFF
  vbLedgerGreen = &HD0FFCC
  vbLedgerYellow = &HE1FAFF
  vbLedgerRed = &HE1E1FF
  vbLedgerGrey = &HE0E0E0
  vbLedgerBeige = &HD9F2F7
  vbLedgerSoftWhite = &HF7F7F7
  vbledgerPureWhite = &HFFFFFF
End Enum

Private sFilenameIn As String

'Below used for listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

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



Private Sub Form_Load()
 
   Command1.Caption = "Highlight Column"
   
   With Combo1
      .AddItem 1
      .AddItem 2
      .AddItem 3
      .AddItem 4
      .AddItem 5
      .ListIndex = 0
   End With
     
   LoadData sizeNone  'change to sizeIcon if using an imagelist
   
End Sub


Private Sub Command1_Click()

   With ListView1
      .Visible = False
      .CheckBoxes = False
      .FullRowSelect = True
      Call SetHighlightColumn(ListView1, _
                              vbLedgerRed, _
                              vbledgerPureWhite, _
                              Combo1.List(Combo1.ListIndex), _
                              sizeNone)
     
      .Refresh
      .Visible = True            'Restore visibility

   End With

End Sub


Private Sub SetHighlightColumn(lv As ListView, _
                               clrHighlight As LedgerColours, _
                               clrDefault As LedgerColours, _
                               nColumn As Long, _
                               nSizingType As ImageSizingTypes)

   Dim cnt     As Long  'counter
   Dim cl      As Long  'columnheader left
   Dim cw      As Long  'columnheader width
         
   On Local Error GoTo SetHighlightColumn_Error
   
   If lv.View = lvwReport Then
   
     'set up the listview properties
      With lv
        .Picture = Nothing  'clear picture
        .Refresh
        .Visible = 1
        .PictureAlignment = lvwTile
      End With  ' lv
       
     'set up the picture box properties
      With Picture1
         .AutoRedraw = False       'clear/reset picture
         .Picture = Nothing
         .BackColor = clrDefault
         .Height = 1
         .AutoRedraw = True        'assure image draws
         .BorderStyle = vbBSNone   'other attributes
         .ScaleMode = vbTwips
         .Top = Form1.Top - 10000  'move it off screen
         .Visible = False
         .Height = 1               'only need a 1 pixel high picture
         .Width = Screen.Width
           
        'draw a box in the highlight colour
        'at location of the column passed
         cl = ListView1.ColumnHeaders(nColumn).Left
         cw = ListView1.ColumnHeaders(nColumn).Left + _
              ListView1.ColumnHeaders(nColumn).Width
         Picture1.Line (cl, 0)-(cw, 210), clrHighlight, BF
         
         .AutoSize = True
      End With  'Picture1
     
     'set the lv picture to the
     'Picture1 image
      lv.Refresh
      lv.Picture = Picture1.Image
     
   Else
   
      lv.Picture = Nothing
       
   End If  'lv.View = lvwReport

SetHighlightColumn_Exit:
On Local Error GoTo 0
Exit Sub
   
SetHighlightColumn_Error:

  'clear the listview's picture and exit
   With lv
      .Picture = Nothing
      .Refresh
   End With
   
   Resume SetHighlightColumn_Exit
   
End Sub

Private Sub LoadData(nSizingType As ImageSizingTypes)

   Dim cnt As Long
   Dim itmX As ListItem
   
   With ListView1
      .ListItems.Clear
      .ColumnHeaders.Clear
      .ColumnHeaders.Add , , "Number"
      .ColumnHeaders.Add , , "Time"
      .ColumnHeaders.Add , , "Mode"
      .ColumnHeaders.Add , , "State"
      .ColumnHeaders.Add , , "Warnings"
      .View = lvwReport
      .Sorted = False
   End With
   
  'Create some fake data
   For cnt = 1 To 100
   
      Set itmX = Form1.ListView1.ListItems.Add(, , Format$(cnt, "###"))

      itmX.SubItems(1) = "Weld process"
      itmX.SubItems(2) = "T-manual"
     
      If cnt Mod 2 = 0 Then
         itmX.SubItems(2) = "Auto detect"
      End If
     
      If cnt Mod 3 = 0 Then
         itmX.SubItems(4) = "Trouble at " & Format$(Time, "hh:mm:ss am/pm")
         itmX.SubItems(3) = "Stopped"
         If nSizingType = sizeIcon Then itmX.SmallIcon = 1
      End If
         
   Next

  'Now that the control contains data, this
  'causes the columns to resize to fit the items
   Call lvAutosizeControl(Form1.ListView1)
   ListView1.Refresh
   
End Sub


Private Sub lvAutosizeControl(lv As ListView)

   Dim col2adjust As Long

  'Size each column based on the maximum of
  'EITHER the column header text width, or,
  'if the items below it are wider, the
  'widest list item in the column
   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
   
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)

   Next
   
   
End Sub


[Lolabyte]

Y si usas listview 5, bueno, raul338 en su ucListView tiene una funcion ColumnFocused, pero esta pinta la columna con el color del tema de windows

Código: (vb6) [Seleccionar]

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LVM_FIRST                    As Long = &H1000
Private Const LVM_SETSELECTEDCOLUMN        As Long = (LVM_FIRST + 140)

m_hListView = ListView1.hWnd

Public Function ColumnFocused(ByVal Column As Integer)
    If m_hListView Then
        Call SendMessage(m_hListView, LVM_SETSELECTEDCOLUMN, Column, 0)
    End If
End Function


[Lolabyte]

Y para colorear la fuente de la columna encontre esto

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/355-coloreaer-columnas-en-listview.htm

Código: (vb6) [Seleccionar]

' Sub que cambia el color de la fuente   
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''   
 
Sub ForeColorColumn(Color, Columna As Integer, LV As ListView)   
    Dim Item As ListItem   
    Dim i As Integer 
       
    ' Verifica que el control contenga items   
    If LV.ListItems.Count = 0 Then 
       Exit Sub 
    End If 
       
    ' Verifica que el Listview esté en vista de reporte   
    If LV.View <> lvwReport Then 
       MsgBox "el listview debe estar en vista reporte", vbQuestion   
       Exit Sub 
    End If 
       
    ' chequea el índice de la columna que sea válido   
    If (Columna + 1) > LV.ColumnHeaders.Count Then 
        MsgBox "El número de columna está fuera del intervalo" 
        Exit Sub 
    End If 
       
    ' Color de fuente Para los items   
    If Columna = 0 Then 
        ' recorre la lista   
        For i = 1 To LV.ListItems.Count   
            ' cambia el color de la fuente de la columna indicada   
            LV.ListItems(i).ForeColor = Color   
        Next 
    ' Color de fuente para los Subitems   
    Else 
        ' recorre   
        For i = 1 To LV.ListItems.Count   
            ' cambia el color de la fuente de la columna indicada   
            LV.ListItems(i).ListSubItems(Columna).ForeColor = Color   
        Next 
    End If 
       
    ' refresca el control   
    LV.Refresh   
       
End Sub 


[raul338]

Tambien en el ucListView hay otra forma de colorear columnas en el evento "OnItemPrePaint"

[E N T E R]

Perfecto, gracias a los dos.

Saludos!!!