ListView : Añadir un CheckBox
En un módulo :
Codigo:--------------------------------------------------------------------------------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 :
Codigo:--------------------------------------------------------------------------------Call SendMessageLong(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, _
LVS_EX_CHECKBOXES, true)--------------------------------------------------------------------------------
Y para dejarlo como estaba :
Codigo:--------------------------------------------------------------------------------Call SendMessageLong(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, _
LVS_EX_CHECKBOXES, false)--------------------------------------------------------------------------------
Para saber si un elemento está seleccionado :
Codigo:--------------------------------------------------------------------------------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 :
Codigo:--------------------------------------------------------------------------------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 :
Codigo:--------------------------------------------------------------------------------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 :
Codigo:--------------------------------------------------------------------------------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 :
Codigo:--------------------------------------------------------------------------------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
de ese link lo saque fijate si te sirve
http://www.solotuweb.com/fs~id~4786.html
