Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: E N T E R en Agosto 31, 2011, 09:09:31 pm
-
Hay alguna manera de pintar solo la columna seleccionada y tambien colorear la fuente.
Ejemplo:
(http://enterpy.net/upload06/archivossubidos/2dpnk_pintar_columna_listview.jpg)
-
Si usas listview 6, aqui hay un ejemplo para colorear columna seleccionada
http://vbnet.mvps.org/index.html?code/comctl/lvcolumnhilite.htm (http://vbnet.mvps.org/index.html?code/comctl/lvcolumnhilite.htm)
(http://vbnet.mvps.org/images/gfx/comctl/lvcolumnhilite.gif)
Debes guardar todo el codigo en un archivo llamado form1.frm
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
-
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
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
-
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 (http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/355-coloreaer-columnas-en-listview.htm)
(http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/imagenes/cargar-recordset-listview-y-colorear-columnas.gif)
' 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
:)
-
Tambien en el ucListView hay otra forma de colorear columnas en el evento "OnItemPrePaint"
-
Perfecto, gracias a los dos.
Saludos!!!