Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Ever Cerna en Octubre 19, 2010, 01:42:32 pm
-
Hola, como estan bueno, queria pedirles una ayudadita estoy usando el LitView 5, lo uso mas que todo por la apariencia de windows que toma con el MANIFEST, ahora estaba biendo esto, http://www.leandroascierto.com.ar/foro/index.php?topic=75.0 (http://www.leandroascierto.com.ar/foro/index.php?topic=75.0), pero me percarte que usa el ListView 6 quise probar el codigo con el ListView 5 y no logro hacer ese efecto Cebra, haber si alguien me ayuda.
Salu2.
-
A los listview 6 tambien se les puede dar la apariencia de windows xp si te interesa puedes cambiarlo en tus proximos proyectos ya la version 6 es mejor aqui el ejemplo
http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/484-explorador-con-skin.htm (http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/484-explorador-con-skin.htm)
Esto no responde a tu pregunta pero hace tiempo tambien utilizaba el listview 5 por la apariencia de xp y le faltaban varias cosas que se tenian que resolver metiendo bastante codigo y el listview 6 las tiene como cualquier otra propiedad.
Aqui hay otro ejemplo y me parece que es el mismo que tu has mencionado
http://www.recursosvisualbasic.com.ar/htm/listado-api/263-listview-xp.htm (http://www.recursosvisualbasic.com.ar/htm/listado-api/263-listview-xp.htm)
-
Jack06 te paso una rutina para implemtarlo al la version 5 de Microsoft windows common controls
Aplica el estilo cebra, lineas de la grilla, y el Full Row select
Option Explicit
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com.ar
'Refencia: http://www.leandroascierto.com.ar/foro/index.php?topic=75.0
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 Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Type LVBKIMAGE
ulFlags As Long
hbm As Long
pszImage As String
cchImageMax As Long
xOffsetPercent As Long
yOffsetPercent As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)
Private Const LVM_GETHEADER As Long = (LVM_FIRST + 31)
Private Const LVM_SETTEXTBKCOLOR As Long = (LVM_FIRST + 38)
Private Const LVM_SETBKIMAGE As Long = (LVM_FIRST + 68)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 55)
Private Const HDM_FIRST As Long = &H1200
Private Const HDM_GETITEMRECT As Long = (HDM_FIRST + 7)
Private Const LVS_EX_GRIDLINES As Long = &H1
Private Const LVS_EX_FULLROWSELECT As Long = &H20
Private Const LVBKIF_STYLE_TILE As Long = &H10
Private Const LVBKIF_FLAG_TILEOFFSET As Long = &H100
Private Const LVBKIF_SOURCE_HBITMAP As Long = &H1
Private Const CLR_NONE As Long = &HFFFFFFFF
Public Sub AltLVBackGround(LV As ListView, ByVal BackColorOne As OLE_COLOR, ByVal BackColorTwo As OLE_COLOR)
Dim lExStyle As Long
Dim hdc As Long
Dim DC As Long
Dim hBMP As Long
Dim OldBmp As Long
Dim i As Long
Dim tLBI As LVBKIMAGE
Dim hHeader As Long
Dim LVItemHeight As Long
Dim CHItemHeight As Long
Dim Rec As RECT
If LV.View = lvwReport And LV.ListItems.Count Then
hHeader = SendMessage(LV.hwnd, LVM_GETHEADER, 0&, ByVal 0&)
Call SendMessage(hHeader, HDM_GETITEMRECT, 0&, Rec)
CHItemHeight = Rec.Bottom - Rec.Top
Call SendMessage(LV.hwnd, LVM_GETITEMRECT, 0&, Rec)
LVItemHeight = Rec.Bottom - Rec.Top
hdc = GetDC(0)
DC = CreateCompatibleDC(0)
hBMP = CreateCompatibleBitmap(hdc, 1, LVItemHeight * 2)
ReleaseDC 0&, hdc
OldBmp = SelectObject(DC, hBMP)
For i = 0 To LVItemHeight - 1
SetPixelV DC, 0, i, BackColorOne
SetPixelV DC, 0, LVItemHeight + i, BackColorTwo
Next
If (GetVersion And &HFF) > 5 Then tLBI.yOffsetPercent = LVItemHeight - CHItemHeight
tLBI.ulFlags = LVBKIF_SOURCE_HBITMAP Or LVBKIF_FLAG_TILEOFFSET Or LVBKIF_STYLE_TILE
tLBI.hbm = hBMP
SendMessage LV.hwnd, LVM_SETBKIMAGE, 0&, tLBI
SendMessage LV.hwnd, LVM_SETTEXTBKCOLOR, 0&, ByVal CLR_NONE
DeleteObject SelectObject(DC, OldBmp)
DeleteDC DC
lExStyle = SendMessage(LV.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, ByVal 0&)
lExStyle = lExStyle Or LVS_EX_GRIDLINES Or LVS_EX_FULLROWSELECT
SendMessage LV.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, ByVal lExStyle
End If
End Sub
Forma de uso
Option Explicit
Private Sub Form_Load()
Dim i As Long
Dim LVItem As ListItem
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "Columna 1"
ListView1.ColumnHeaders.Add , , "Columna 2"
For i = 1 To 100
Set LVItem = ListView1.ListItems.Add(, , "Item " & i)
LVItem.SubItems(1) = "SubItem 1"
Next
Call AltLVBackGround(ListView1, RGB(209, 222, 252), RGB(255, 255, 255))
End Sub
Saludos.
-
muy bueno, gracias a Jack06 por preguntar y leandroA por el codigo, ahora le pondre estilo cebra a unos sistemas que tengo con el lv5.
Cuando no leandro con el buche lleno de codigos, saludos
-
A todo esto, es posible aplicar el estilo cebra en un control MSHFlexGird? o MSFlexGrid? aunque yo uso el primero de ellos en casi todo.
Una vez lo hice pero me va un poco lento cuando son cientos de registros y lo hice usando un for next y columna por columna pintando a mano, creo que no hay de otra y solo quedaría hacerlo asi, o no?
-
hice una porque olvide quitar el backcolor
Saludos.
-
Wowww :o gracias Leandro, no hay nada imposible para ti.
Salu2.
-
A todo esto, es posible aplicar el estilo cebra en un control MSHFlexGird? o MSFlexGrid? aunque yo uso el primero de ellos en casi todo.
Una vez lo hice pero me va un poco lento cuando son cientos de registros y lo hice usando un for next y columna por columna pintando a mano, creo que no hay de otra y solo quedaría hacerlo asi, o no?
Aqui tienes para ambos objetos...!
'En un modulo bas
Public Sub AltLVBackGroundFlex(Flex As Object, _
ByVal BackColorOne As OLE_COLOR, _
ByVal BackColorTwo As OLE_COLOR)
Dim Row As Long
Dim Col As Integer
With Flex
.Redraw = False
.BackColor = BackColorOne
For Row = 1 To .Rows - 1 Step 2
.Row = Row
For Col = 0 To .Cols - 1
.Col = Col
.CellBackColor = BackColorTwo
Next
Next
.Redraw = True
End With
End Sub
'Luego en el Form donde este el Grid para usarlo
Private Sub CargarFlex_Click()
'Luego de realizar la carga de datos, colocas esto si es para el MSHFlexGrid
Call AltLVBackGroundFlex(MSHFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
'O este si es para el MSFlexGrid
Call AltLVBackGroundFlex(MSFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
End Sub
Pruebalos y cualquier cosa me comentas
-
Gracias Miguel, voy a probarlo.
-
Hola Leandro, el codigo esta espectacular, yo uso Win 7, y no se porque pinta desordenado. Todavia no lo pruebo en WIN XP a lo mejor alli si funciona normal.
(http://img230.imageshack.us/img230/4553/capturaqp.th.jpg) (http://img230.imageshack.us/i/capturaqp.jpg/)
Haber si me hechas otra manito.
Salu2.
-
Hola Leandro, el codigo esta espectacular, yo uso Win 7, y no se porque pinta desordenado. Todavia no lo pruebo en WIN XP a lo mejor alli si funciona normal.
(http://img230.imageshack.us/img230/4553/capturaqp.th.jpg) (http://img230.imageshack.us/i/capturaqp.jpg/)
Haber si me hechas otra manito.
Salu2.
Solucionado (modifique el primer post)
Por lo visto Seven Y Vista, trabajan diferente comienzan a rendereizar el bitmap por devajo de las columnas, asi que puse la constante LVBKIF_FLAG_TILEOFFSET para indicar donde deve comenzar a pintar calculando el la diferencia entre el alto del item y el alto del columnHeder, ademas utilize apis para calcular el alto asi no hay problemas si el formulario esta en vbPixels o vbtwips
hay que dejar en claro que esto funciona estando presente los temas de windows en la aplicación (.manifest)
de yapa te dejo una para aplicar una selecion de items mas linda en caso de que corra vajo Seven o Vista
Private Declare Function SetWindowTheme Lib "uxtheme.dll" (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Sub Form_Load()
If (GetVersion And &HFF) > 5 Then Call SetWindowTheme(ListView1.hwnd, StrPtr("explorer"), 0)
End Sub
para mi gusto no es para este caso ya que la grilla come un pixel de la selecion pero para otros casos queda lindo.
Saludos.
-
:-X Gracias Leandro, ahora si funciona perfecto.
Salu2.
-
Gracias Miguel, voy a probarlo.
Te funcionó sin problemas?
-
Gracias Miguel, voy a probarlo.
Te funcionó sin problemas?
Hola Miguel
Mira, lo he llevado al limite para probarlo y he cargado en un MSHFlexGrid unos 10,500 registros, cambie de color a la zebra, y lo puse para que pinte desde la columna 1, aplique la función y use filtros de búsquedas por cada pulsación de tecla para actualizar en el grid los resultados y va muuuuy bien. Lo que demora por pintar es casi imperceptible, casi no demora nada, creo que el truco esta en .Redraw = False, esa no la había probado.
Muy bien, gracias, he creado otra función que llama a la tuya para hacerlo mas digerible en mi programación, por ejemplo:
Call ZebraGrid(Grid1, 1)
Call ZebraGrid(Grid1, 2)
etc
Donde 1, 2, son los colores alternativos que usare para diferentes tipos de datos que cargare en los diferentes grids.
Saludos....
P.D:
Doc, aun estoy interesado en el otro tema, me avisas cuando consigas las claves de acceso al FBI que me indicaste y poder copypastear la lista NOD. Saludos.
Este mensaje se podría autodestruir en 5 segundos.
-
Otra vez levantando temas antiguos, sorry.
Uso AltLVBackGroundFlex y todo perfecto, logro el efecto Zebra y todo bien. Pero ahora el cliente me pide que quiere hacer clic en la cabecera del grid para ordenar los registros, eso ya lo tengo resuelto, el problema es que se jode la zebra, se vuelve un mapache je. Las filas empiezan a tener los colores desordenados, y a medida que le doy mas clic al grid en le cabecera, esta se va volviendo al final en un solo color.
Quise ponerle en la cabecera a que me pinte tdo de un solo color antes que entre a AltLVBackGroundFlex y no funca. En el grid puse esto:
If Grid1.MouseRow = 0 Then
Grid1.BackColor = vbWhite <--- Para que me pinte todo el grid en blanco y luego aplique el zebra
Call ZebraGrid(Grid)
End Ify nada, sigue saliendo desordenado. Ven alguna forma de resolverlo?
ZebraGrid trae esto:
Public Sub ZebraGrid(Flex As Object)
Call AltLVBackGroundFlex(Flex, RGB(255, 255, 255), RGB(230, 243, 255))
End Sub
y AltLVBackGroundFlex trae esto:
Public Sub AltLVBackGroundFlex(Flex As Object, ByVal BackColorOne As OLE_COLOR, ByVal BackColorTwo As OLE_COLOR)
Dim Row As Long
Dim Col As Integer
With Flex
.Redraw = False
.BackColor = BackColorOne
For Row = 1 To .Rows - 1 Step 2
.Row = Row
For Col = 1 To .Cols - 1
.Col = Col
.CellBackColor = BackColorTwo
Next
Next
.Redraw = True
End With
End Sub
Ojala que la solucion no sea volver a recorrer todo el grid fila por fila y columna por columna para pintar de un solo color el grid y luego volver a pasar para pintarlo de Zebra, alli si estaria feo.
-
jaja, cayo VB-Mundo, justo estaba posteando este tema alli y se cayo el foro. No lo iba a hacer en TheHacker porque vi que los moderadores son los mismo de aqui, pero no me queda de otra, sorry, me urge esto y de pronto alguien por alli me pueda echar una manito.
-
No importa, termino contestando acá :P
El problema es que pinta según el index del ítem. Hay que pintar según la posición del ítem una vez ordenado... El tema es: Se puede obtener la posición ? xD
-
Despues de ordenar, vuelvo a repintar, de la forma fea (http://msn.mess.be/data/thumbnails/43/frankenstein.gif)
Pero viendo el codigo de LynxGrid de psc, al ordenar, tambien vuelve a repintar, y repinta todo! el columnheader y el grid, asi que eso de feo dejemoslo en funcional 8)
-
Hola, no es dificil, lo que tenes que hacer es no pintar todas las rows, sino solo las visible esto acelera un 500% la funcion, la cuestion es que deves hacer cada vez que se dispara el evento MSFlexGrid1_Scroll , ademas en el Form_Load , y depsues de que ordenas, te doy un ejemplo.
Option Explicit
Private Sub Form_Load()
Agregar_Datos_FlexGrid
Call AltLVBackGroundFlex(MSFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
End Sub
Public Sub AltLVBackGroundFlex(Flex As Object, ByVal BackColorOne As OLE_COLOR, ByVal BackColorTwo As OLE_COLOR)
Dim Row As Long
Dim Col As Long
With MSFlexGrid1
.Redraw = False
For Row = .TopRow To .Rows - 1
If .RowIsVisible(Row) = False Then Exit For
.Row = Row
For Col = 0 To .Cols - 1
.Col = Col
If Row Mod 2 Then
.CellBackColor = BackColorTwo
Else
.CellBackColor = BackColorOne
End If
Next
Next
.Redraw = True
End With
End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
With MSFlexGrid1
If .MouseRow <> 0 Then
Exit Sub
End If
'La función retorna el tipo de orden, es decir esta declarada como As SortSettings
If Ordenar_Columna_FlexGrid(MSFlexGrid1, .MouseCol) = flexSortGenericAscending Then
Me.Caption = " FlexGrid en orden: Ascendente "
Else
Me.Caption = " FlexGrid en orden: Descendente "
End If
End With
MSFlexGrid1_Scroll
End Sub
Private Sub Agregar_Datos_FlexGrid()
Dim columna As Integer, i As Integer
MSFlexGrid1.Redraw = False
For i = 1 To 10000
MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
For columna = 0 To 3
MSFlexGrid1.TextMatrix(i, columna) = Numero_Aleatorio(1500, i)
Next
Next
MSFlexGrid1.Redraw = True
End Sub
'Función para generar valores aleatorios para insertar en el FlexGrid
Private Function Numero_Aleatorio(Upper As Integer, Lower As Integer) As Integer
Randomize
'Retornar el número a la función
Numero_Aleatorio = Int((Upper - Lower + 1) * Rnd + Lower)
End Function
Private Sub MSFlexGrid1_Scroll()
Call AltLVBackGroundFlex(MSFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
End Sub
Saludos.
-
Hola Leandro, a ver voy a probarlo y te comento gracias.
-
Que bien funciona tu codigo, es como magia, frente a nuestros ojos la linda zebra, detras nuestro el feo mapache, por cierto la funcion Ordenar_Columna_Flexgrid no esta, pero esta aqui
http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/150-ordenar-columna-flexgrid.htm (http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/150-ordenar-columna-flexgrid.htm)
' esto en las delaraciones del form
Public sCol As Integer, Orden As SortSettings
Function Ordenar_Columna_FlexGrid( _
FlexGrid As Object, _
ByVal columna As Integer) As SortSettings
FlexGrid.Visible = False
FlexGrid.Refresh
If sCol <> columna Then
Orden = 1
ElseIf Orden = 1 Then
Orden = 2
Else
Orden = 1
End If
'Ordena la columna del FlexGRid según _
el valor de la variable Orden
FlexGrid.Sort = Orden
sCol = columna
'Devuelve a la función el tipo de orden
Ordenar_Columna_FlexGrid = Orden
FlexGrid.Visible = True
End Function
-
Ya esta Lea, muchas gracias, cierto es super velocisimo si solo "cebreamos" lo que se ve, pense que iba a "aguantarse" cuando recorra el grid pero nada de nada, pintar las 25 lineas que se ven no es nada ni siquiera para una Pentium IV. La magia estaba aquí:
If .RowIsVisible(Row) = False Then Exit For
Gracias doc.