[VBnet ComCtrls] SendMessage: Using ListView API Check Boxes


	Visual Basic Common Control API Routines SendMessage: Using ListView API Check Boxes

Posted:	Wednesday January 22, 1998
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB5, Windows 95
OS restrictions:	None
Author:	VBnet - Randy Birch

Prerequisites

This method is intended for Visual Basic 5 or Visual Basic 6 where the Common Control library used is the Mscomctl 5 version (comctl32.ocx). Because the VB6-specific mscomctl.ocx (Common Controls 6) is a complete implementation of comctl32.dll and not reliant on the version of comctl32.dll installed, this routine may not work when applied to a ListView created from the VB6-specific mscomctl.ocx.

Enhanced Comctl32 functionality is only available to users with comctl32.dll version 4.70 or greater installed. This dll is typically installed with IE3.x or greater.

By popular demand, here are several methods you can employ to perform a variety of ListView check box-related operations.

Setcheck: turns on the checkbox for the item passed as the value in the textbox.

GetChecked: displays a MsgBox with a list of currently-selected checked items and their ListIndex.

CheckAll: selects (checks) all the items in the ListView

Uncheck All: just what it says.

Invert Checks: causes checked items to uncheck, and unchecked items to become checked.

Open XXX: Launches the selected item via ShellExecute, which opens the item in the application associated with the registered extension The caption changes to reflect the item type, in the example, 'Application'. The item type is determined by calling SHGetFileInfo in the wrapper function GetFileDescription.

Open All Checked: Uses ShellExecute to launch all selected items. Note that this can consume a ton of resources if many items are checked. In addition, because a null is passed as the parameter, applications expecting a command line may display a dialog. Use this button carefully.

This example does not contain all code required to construct the illustration shown. The routines provided here are designed to be applied to an existing project utilizing a ListView control in report view.

BAS Module Code

None.

Form Code

Add a series of command buttons to a pre-existing ListView project, naming the buttons as indicated in the routines below. Add the following code to the project form:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim fPath As String

Private  Const LVM_FIRST As Long = &H1000
Private  Const LVM_SETITEMSTATE As Long = (LVM_FIRST + 43)
Private  Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)
Private  Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Private  Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)
Private  Const LVM_GETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 55)

Private  Const LVS_EX_GRIDLINES As Long = &H1
Private  Const LVS_EX_CHECKBOXES As Long = &H4
Private  Const LVS_EX_FULLROWSELECT As Long = &H20 'applies to report mode only

Private  Const LVIF_STATE As Long = &H8
Private  Const LVIS_STATEIMAGEMASK As Long = &HF000
 
Private  Const SW_NORMAL As Long = 1
Private  Const SW_SHOWMAXIMIZED As Long = 3
Private  Const SW_SHOWDEFAULT As Long = 10
Private  Const SW_SHOWNOACTIVATE As Long = 4
Private  Const SW_SHOWNORMAL As Long = 1

Private  Const SHGFI_TYPENAME As Long = &H400
Private  Const MAX_PATH As Long = 260

Private  Type LV_ITEM
    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
 
Private  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

Private  Type SHFILEINFO
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

Private  Declare Function SHGetFileInfo Lib "shell32" _
    Alias "SHGetFileInfoA" _
   (ByVal pszPath As String, _ 
    ByVal dwFileAttributes As Long, _ 
    psfi As SHFILEINFO, _ 
    ByVal cbSizeFileInfo As Long, _ 
    ByVal uFlags As Long) As Long
   
Private  Declare Function GetDesktopWindow Lib "user32" () As Long

Private  Declare Function ShellExecute Lib "shell32" _
    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

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 Function GetFileDescription(sFileName As String) As String
  
   Call SHGetFileInfo(sFileName, 0&, shinfo, Len(shinfo), SHGFI_TYPENAME)
   
   GetFileDescription = TrimNull(shinfo.szTypeName)

End Function


Private Function TrimNull(item As String) As String

  Dim pos As Integer
  
  pos = InStr(item, Chr$(0))
  If pos Then item = Left$(item, pos - 1)
  TrimNull = item
  
End Function


Private Sub chkCheckBox_Click()

   Dim state As Long
 
  'state will be true when the checkbox
  'style is 1 (checked) or False when
  'unchecked
   state = chkCheckBox.Value = 1
 
  'set the new listview style
   Call SendMessage(ListView1.hwnd, _
                    LVM_SETEXTENDEDLISTVIEWSTYLE, _
                    LVS_EX_CHECKBOXES, ByVal state)

End Sub


Private Sub chkGridLines_Click()

   Dim state As Long
 
  'state will be true when the checkbox
  'style is 1 (checked) or False when
  'unchecked
   state = chkGridLines.Value = 1
 
  'set the new listview style
   Call SendMessage(ListView1.hwnd, _
                    LVM_SETEXTENDEDLISTVIEWSTYLE, _
                    LVS_EX_GRIDLINES, ByVal state)

End Sub


Private Sub chkFullRowSelect_Click()

   Dim state As Long
 
  'state will be true when the checkbox
  'style is 1 (checked) or False when
  'unchecked
   state = chkSelectMode.Value = 1
 
  'set the new listview style
   Call SendMessage(ListView1.hwnd, _
                    LVM_SETEXTENDEDLISTVIEWSTYLE, _
                    LVS_EX_FULLROWSELECT, ByVal state)

End Sub


Private Sub cmdOpenSelected_Click()

   Dim hWndDesk As Long
   Dim sFile As String
   Dim params As String
   
   If ListView1.SelectedItem.Selected Then
   
      sFile = fPath & ListView1.SelectedItem.Text
      params = vbNullString
      
      hWndDesk = GetDesktopWindow()
      Call ShellExecute(hWndDesk, "Open", sFile, params, 0&, SW_SHOWNORMAL)
      
   End If

End Sub


Private Sub Combo1_Click()

  cmdSelect(1).Enabled = Len(fPath) > 0

End Sub


Private Sub SetCheck(hwnd As Long, lItemIndex As Long, bState As Boolean)

    Dim LV As LV_ITEM
    
    With LV
      .mask = LVIF_STATE
      .state = IIf(bState, &H2000, &H1000)
      .stateMask = LVIS_STATEIMAGEMASK
    End With
    
    Call SendMessage(hwnd, LVM_SETITEMSTATE, lItemIndex, LV)

End Sub


Private Sub cmdSetCheck_Click()

   Dim lvIndex As Long
   Dim lvCount As Long
   
   lvIndex = Val(Text1.Text)
   lvCount = ListView1.ListItems.Count - 1
   
   If lvIndex <= lvCount Then
      SetCheck ListView1.hwnd, lvIndex, True
   Else
      MsgBox "Select item 0 to " & lvCount & " only!"
   End If
   
End Sub


Private Sub cmdCheckInvert_Click()

   SetCheckInvertAll
   
End Sub


Private Sub cmdCheckAll_Click()

   SetCheckAllItems True

End Sub


Private Sub cmdUncheckAll_Click()

   SetCheckAllItems False
   
End Sub


Private Sub cmdOpenChecked_Click()

   Dim LV As LV_ITEM
   Dim state 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
         
      state = SendMessage(ListView1.hwnd, LVM_GETITEMSTATE, lvIndex, ByVal LVIS_STATEIMAGEMASK)
      
      If state And &H2000& Then
           
         With LV
            .cchTextMax = MAX_PATH
            .pszText = Space$(MAX_PATH)
         End With
                 
         If SendMessage(ListView1.hwnd, LVM_GETITEMTEXT, lvIndex, LV) 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


Private Sub cmdGetChecked_Click()

   Dim i As Integer
   Dim r As Long
   Dim b As String
   Dim LV As LV_ITEM
   
   b = "The following ListView items are checked (0-based):" & vbCrLf & vbCrLf
   
   For i = 0 To ListView1.ListItems.Count - 1
   
      r = SendMessage(ListView1.hwnd, LVM_GETITEMSTATE, i, ByVal LVIS_STATEIMAGEMASK)
      
      If r And &H2000& Then
      
         With LV
            .cchTextMax = MAX_PATH
            .pszText = Space$(MAX_PATH)
         End With
   
         Call SendMessage(ListView1.hwnd, LVM_GETITEMTEXT, i, LV)
      
         b = b & "item " & CStr(i) & "  ( " & _
                 Left$(LV.pszText, InStr(LV.pszText, Chr$(0)) - 1) & " )" _
                 & vbCrLf
      End If
 
   Next
   
   If Len(b) > 0 Then MsgBox b

End Sub


Private Sub Form_Load()

   chkCheckBox.Value = 1
   chkFullRowSelect.Value = 1
   fPath = "d:\"
   Text1.Text = 0
   cmdOpenSelected.Enabled = False

End Sub


Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)

   cmdOpenSelected.Caption = "Open " & _
                             GetFileDescription(fPath$ & ListView1.SelectedItem.Text)
   cmdOpenSelected.Enabled = ListView1.SelectedItem.Selected = True

End Sub


Private Sub SetCheckAllItems(bState As Boolean)

   Dim LV As LV_ITEM
   Dim lvCount As Long
   Dim lvIndex As Long
   Dim lvState As Long
   
  'because IIf is less efficient than a
  'traditional If..Then..Else statement, just call
  'once to save the state mask to a local variable
   lvState = IIf(bState, &H2000, &H1000)
   
  'listview has 0 to count -1 items
   lvCount = ListView1.ListItems.Count - 1
   
   Do
         
      With LV
         .mask = LVIF_STATE
         .state = lvState
         .stateMask = LVIS_STATEIMAGEMASK
      End With
      
      Call SendMessage(ListView1.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
      lvIndex = lvIndex + 1
   
   Loop Until lvIndex > lvCount
  
  'One could alternatively use "Loop Until r = False"
  'where r is the return value from SendMessage
  'as r is false when the call fails (no more to set).

End Sub


Private Sub SetCheckInvertAll()

   Dim LV As LV_ITEM
   Dim lvCount As Long
   Dim lvIndex As Long
   Dim r As Long
   
   lvCount = ListView1.ListItems.Count - 1
   
   Do
         
      r = SendMessage(ListView1.hwnd, LVM_GETITEMSTATE, lvIndex, ByVal LVIS_STATEIMAGEMASK)
      
      With LV
         .mask = LVIF_STATE
         .stateMask = LVIS_STATEIMAGEMASK
      
         If r And &H2000& Then
              'it is checked, so set the state
              'to 'unchecked'
               .state = &H1000
         Else: .state = &H2000
         End If
         
      End With
      
      Call SendMessage(ListView1.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
      lvIndex = lvIndex + 1
   
   Loop Until lvIndex > lvCount

End Sub

Comments

Run your project, enter a value into the textbox and press SetCheck. The 0-based list item will become checked. See the introduction at the top of this page for info on the other button's features.

PayPal Link