Trucos ListView : Añadir un CheckBox

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)

En un módulo :

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 SendMessageAny _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Public Const LVM_FIRST As Long = &H1000
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 55)

Public Const LVS_EX_CHECKBOXES As Long = &H4
Public Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)
Public Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Public Const LVM_GETITEMTEXT = (LVM_FIRST + 45)
Public Const LVIS_STATEIMAGEMASK As Long = &HF000
Public Const LVIF_STATE = &H8

Public Type LVITEM
   mask As Long
   iItem As Long
   iSubItem As Long
   state As Long
   stateMask As Long
   pszText As String
   cchTextMax As Long
   iImage As Long
   lParam As Long
   iIndent As Long
End Type
Public Type LVCOLUMN
    mask As Long
    fmt As Long
    cx As Long
    pszText As String
    cchTextMax As Long
    iSubItem As Long
    iImage As Long
    iOrder As Long
End Type


Para que los elementos tengan un checkbox a la izquierda :

Call SendMessageLong(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, _
                     LVS_EX_CHECKBOXES, true)

Y para dejarlo como estaba :

Call SendMessageLong(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, _
                     LVS_EX_CHECKBOXES, false)

Para saber si un elemento está seleccionado :

Dim Posicion as long, r as long

r = SendMessageLong(ListView1.hwnd, LVM_GETITEMSTATE, Posicion, LVIS_STATEIMAGEMASK)
If r And &H2000& Then
   'esta seleccionado
endif

Hay que tener en cuenta que Posicion empieza en cero. Como la colección ListItems empieza en uno el texto del elemento seleccionado será ListView.ListItems(Posicion+1).Text


Podemos cambiar el estado de un elemento empleando esta función :

Public Sub SetCheck(ByVal hwnd As Long, ByVal lItemIndex As Long, ByVal bState As Boolean)
    Dim LV As LVITEM
    With LV
      .mask = LVIF_STATE
      .state = IIf(bState, &H2000, &H1000)
      .stateMask = LVIS_STATEIMAGEMASK
    End With
    Call SendMessageAny(hwnd, LVM_SETITEMSTATE, lItemIndex, LV)
End Sub

a la que se le pasa el hWnd del ListView, el número de elemento (empezando en cero) y un boolean indicando si debe estar (true) o no (false) seleccionado.

Podemos hacer una rutina que seleccione o desmarque todos los elementos del ListView, según le pasemos true o false, respectivamente :

Private Sub SetCheckAllItems(bState As Boolean)
   Dim LV As LVITEM
   Dim lvCount As Long
   Dim lvIndex As Long
   Dim lvState As Long
   Dim r As Long

   lvState = IIf(bState, &H2000, &H1000)
  'los elementos del listview van de 0 hasta count -1
   lvCount = ListView1.ListItems.Count - 1
   Do
      With LV
         .mask = LVIF_STATE
         .state = lvState
         .stateMask = LVIS_STATEIMAGEMASK
      End With
      Call SendMessageAny(ListView1.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
      lvIndex = lvIndex + 1
   Loop Until lvIndex > lvCount
End Sub


O que invierta las selecciones :

Private Sub SetCheckInvertAll()
   Dim LV As LVITEM
   Dim r As Long
   Dim lvCount As Long
   Dim lvIndex As Long

   lvCount = ListView1.ListItems.Count - 1
   Do
      r = SendMessageLong(ListView1.hwnd, LVM_GETITEMSTATE, lvIndex, LVIS_STATEIMAGEMASK)
      With LV
         .mask = LVIF_STATE
         .stateMask = LVIS_STATEIMAGEMASK
         If r And &H2000& Then 'si está marcado, desmarcarlo
               .state = &H1000
         Else: .state = &H2000
         End If
      End With
      Call SendMessageAny(ListView1.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
      lvIndex = lvIndex + 1
   Loop Until lvIndex > lvCount
End Sub

Si lo que mostramos en el ListView fuera una lista de archivos, podríamos lanzar todos los que estén marcados con una rutina como esta :

Declaramos en un módulo:
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
   (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Public Const SW_NORMAL = 1
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWDEFAULT = 10
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1

Private Sub cmdOpenChecked_Click()
   Dim LV As LVITEM
   Dim r As Long
   Dim lvCount As Long
   Dim lvIndex As Long
   Dim hWndDesk As Long
   Dim sfile As String
   Dim params As String

   hWndDesk = GetDesktopWindow()
   lvCount = ListView1.ListItems.Count - 1
   lvIndex = 0
   Do
      r = SendMessageLong(ListView1.hwnd, LVM_GETITEMSTATE, lvIndex, LVIS_STATEIMAGEMASK)
      If r And &H2000& Then
         With LV
            .cchTextMax = MAX_PATH
            .pszText = Space$(MAX_PATH)
         End With
         r = SendMessageAny(ListView1.hwnd, LVM_GETITEMTEXT, lvIndex, LV)
         If r Then
            sfile = fPath & Left$(LV.pszText, InStr(LV.pszText, Chr$(0)) - 1)
            Call ShellExecute(hWndDesk, "Open", sfile, 0&, 0&, SW_SHOWNORMAL)
            DoEvents
         End If
      End If
      lvIndex = lvIndex + 1
   Loop Until lvIndex > lvCount
End Sub



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com