Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'*****************************************************'
'Class: clsGetSelLBItem (clsGetSelLBItem.cls)
'Author:
'Date: 11/21/2002 Revised:
'Language: Visual Basic 6.0, Enterprise Edition
'
'Description:
'Class module wrapper around a procedure and
'function for detecting all selected items in a
'ListBox using an API call.
'
'The FindSelectedListBoxItems procedure creates an
'array with the indexes of all selected items in
'the ListBox.
'
'The GetSelectedListBoxItems function returns the
'array built by FindSelectedListBoxItems.
'
'The logic found here is based on an article titled
'"A faster way to detect selected items in a ListBox"
'and written by Kim Pedersen (dated 04/08/2000).
'According to the article, looping thru all items in
'the ListBox and checking the Selected property is
'not efficient when dealing with many items. The
'ListBox class provides an LB_GETSELITEMS API message
'that fills an array with the indexes of all selected
'items, which is faster. The complete article can be
'found at:
'[URL unfurl="true"]http://www.vbcodemagician.dk/tips/wincontrol_listboxgetsel.htm[/URL]
'
' SPECIAL NOTE:
' The selected items index array always gets
' redimensioned to 0 at the start of processing.
' This helps to prevent any errors in the calling
' program. The drawback, however, is the array
' contains an "index" of zero, which corresponds
' to the first item in the ListBox. Therefore,
' it is possible for the calling program to think
' that item was selected. If the calling program
' checks the error codes (or IsArrayEmpty) this
' situation will be avoided.
'
'Usage: (basic processing steps)
'1. Define an object for clsGetSelLBItem.
'2. Call FindSelectedListBoxItems using a ListBox control.
'3. Check for any errors (ErrorCode) and/or selected
' item count (SelectedCount) as a result of the find
' processing.
'4. Define a work array to hold the selected items index
' array built by FindSelectedListBoxItems.
'5. Retrieve the selected items index array.
'6. Check for any errors (ErrorCode) and/or an empty
' array (IsArrayEmpty = "Y") as a result of the
' retrieval processing.
'7. Process the selected item array using it's indexes
' to reference only the selected items in the ListBox
' that was originally passed to FindSelectedListBoxItems.
'8. Destroy the object.
'
' Syntax: (sample only)
'
'' Define object for detecting all selected items.
'Dim objSelItems As clsGetSelLBItem
'Set objSelItems = New clsGetSelLBItem
''
'' Build array with the indexes of all selected items.
'Call objSelItems.FindSelectedListBoxItems(lstListBox)
''
'' Check for any errors here...
'txtError.Text = objSelItems.ErrorCode & " " & _
' objSelItems.ErrorType & " " & _
' objSelItems.ErrorDesc
''
'' Retrieve the selected item index array.
'Dim lngSelectedArray() As Long
'Dim objItem As Variant
'lngSelectedArray = objSelItems.GetSelectedListBoxItems
''
'' Check for any errors here...
''If objSelItems.IsArrayEmpty = "Y" - nothing to process
'txtSelError.Text = objSelItems.ErrorCode & " " & _
' objSelItems.ErrorType & " " & _
' objSelItems.ErrorDesc
''
'' Process the selected item index array.
'For Each objItem In lngSelectedArray
'' selected item logic here...e.g. load a 2nd
'' ListBox with only selected items from the 1st
' lstSecondLB.AddItem lstFirstLB.List(CInt(objItem))
'Next
''
'Set objSelItems = Nothing 'free memory
'
'-----------------------------------------------------'
' R e v i s i o n H i s t o r y
'SDR / Ticket Date Analyst
'Description
'-----------------------------------------------------'
'
'
'
'*****************************************************'
Option Explicit
' Declarations required for detecting all selected
' items in a ListBox.
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 LB_GETSELITEMS = &H191
Private malngSelItems() As Long
Private mlngSelectedCount As Long
' Define error variables.
Public Enum enuGetSelLBItemErrors
gslbiNoErrorsFound = 0
gslbiInvalidControl = vbObjectError + 2200
gslbiNoSelectedItems = vbObjectError + 2210
gslbiEmptyListBox = vbObjectError + 2220
gslbiArrayEmpty = vbObjectError + 2230
End Enum
Private Const FATAL_ERROR As String = "E"
Private Const WARNING_ERROR As String = "W"
Private Const INVALID_CONTROL As String = "Control passed is not a ListBox."
Private Const NO_SELECTED_ITEMS As String = "No items selected in ListBox."
Private Const EMPTY_LISTBOX As String = "ListBox is empty."
Private Const ARRAY_EMPTY As String = "Selected item index array is empty."
Private mstrErrorCode As enuGetSelLBItemErrors
Private mstrErrorType As String
Private mstrErrorDesc As String
Private mstrIsArrayEmpty As String
'*****************************************************'
'DESCRIPTION:
' Read the number of selected items.
'*****************************************************'
Public Property Get SelectedCount() As Long
SelectedCount = mlngSelectedCount
End Property
'*****************************************************'
'DESCRIPTION:
' Read the switch indicating whether or not the array
' of selected indexes is empty. A value of "Y" means
' the array IS empty, "N" means it is NOT empty.
'*****************************************************'
Public Property Get IsArrayEmpty() As String
IsArrayEmpty = mstrIsArrayEmpty
End Property
'*****************************************************'
'DESCRIPTION:
' Read the Error Code.
'*****************************************************'
Public Property Get ErrorCode() As enuGetSelLBItemErrors
ErrorCode = mstrErrorCode
End Property
'*****************************************************'
'DESCRIPTION:
' Read the Error Type (E = error, W = warning only).
'*****************************************************'
Public Property Get ErrorType() As String
ErrorType = mstrErrorType
End Property
'*****************************************************'
'DESCRIPTION:
' Read the Error Description.
'*****************************************************'
Public Property Get ErrorDesc() As String
ErrorDesc = mstrErrorDesc
End Property
'*****************************************************'
'Procedure: FindSelectedListBoxItems()
'Author:
'Date: 11/21/2002 Revised:
'Language: Visual Basic 6.0, Enterprise Edition
'Purpose: Find all selected ListBox items via an
' API call and write their indexes to an
' array for further processing.
'Inputs: ListBox control.
'Output: Array of selected item indexes.
'
'Description:
'There are several edit checks performed prior to
'searching for selected items (see the comments
'below for a description of these edits). If there
'is an error during the edits, an error code, type
'and description are generated. These are placed
'into the following error properties:
' Error Code = number identifying the error
' Error Type = type of error, i.e. E=error, W=warning
' Error Desc = description of the error.
'The calling routine can then respond to this error,
'if necessary.
'
'Syntax:
' Call objSelItems.FindSelectedListBoxItems(ListBox)
' Note: See comments at top of Class Module for more
' details.
'*****************************************************'
Public Sub FindSelectedListBoxItems( _
ByVal lstListBox As Control)
On Error GoTo FindSelLBItemError
' Clear all results.
mstrErrorCode = gslbiNoErrorsFound
mstrErrorType = ""
mstrErrorDesc = ""
mstrIsArrayEmpty = "Y" 'selected index array empty
mlngSelectedCount = 0
ReDim malngSelItems(0) 'prevents an error in the
'calling program if any of
'the edits fail
' Make sure the control passed is a ListBox.
If Not TypeOf lstListBox Is Listbox Then
mstrErrorCode = gslbiInvalidControl
mstrErrorType = FATAL_ERROR
mstrErrorDesc = INVALID_CONTROL
Exit Sub
End If
' Make sure the ListBox is not empty.
If lstListBox.ListCount <= 0 Then
mstrErrorCode = gslbiEmptyListBox
mstrErrorType = WARNING_ERROR
mstrErrorDesc = EMPTY_LISTBOX
Exit Sub
End If
' Make sure an item(s) was selected.
If lstListBox.SelCount <= 0 Then
mstrErrorCode = gslbiNoSelectedItems
mstrErrorType = WARNING_ERROR
mstrErrorDesc = NO_SELECTED_ITEMS
Exit Sub
End If
' All edits passed, start loading array with indexes
' of all selected ListBox items via API call.
' The LB_GETSELITEMS is passed to the ListBox
' using SendMessage. To work LB_GETSELITEMS
' requires two additional parameters: A pointer
' to the array that will hold all indexes of
' selected items (lParam) and a parameter holding
' the number of selected items.
' First get the number of selected items.
mlngSelectedCount = lstListBox.SelCount
' Redimension the Array so that it can hold index
' values of all selected items.
ReDim malngSelItems(mlngSelectedCount - 1)
' Now fill the array with the index values of all
' selected items. The pointer to the array is the
' first array element.
SendMessage lstListBox.hwnd, LB_GETSELITEMS, _
ByVal mlngSelectedCount, malngSelItems(0)
mstrIsArrayEmpty = "N" 'selected index array loaded
FindSelLBItemExit:
Exit Sub
FindSelLBItemError:
' Unknown error condition.
mstrErrorCode = Err.Number
mstrErrorType = FATAL_ERROR
mstrErrorDesc = Err.Description
Resume FindSelLBItemExit
End Sub
'*****************************************************'
'Function: GetSelectedListBoxItems()
'Author:
'Date: 11/21/2002 Revised:
'Language: Visual Basic 6.0, Enterprise Edition
'Purpose: Return an array containing the indexes of
' all selected ListBox items, which were
' previously loaded by FindSelectedListBoxItems.
'Inputs: None.
'Output: None.
'
'Description:
'There are several edit checks performed prior to
'returning the array (see the comments below for a
'description of these edits). If there is an error
'during the edits, an error code, type and description
'are generated. These are placed into the following
'error properties:
' Error Code = number identifying the error
' Error Type = type of error, i.e. E=error, W=warning
' Error Desc = description of the error.
'The calling routine can then respond to this error,
'if necessary.
'
'Syntax:
' varArray = objFind.GetSelectedListBoxItems
' Note: See comments at top of Class Module for more
' details.
'*****************************************************'
Public Function GetSelectedListBoxItems() As Variant
On Error GoTo GetSelLBItemError
' Clear error info.
mstrErrorCode = gslbiNoErrorsFound
mstrErrorType = ""
mstrErrorDesc = ""
' Make sure the selected item indexes array
' has been previously loaded.
If mstrIsArrayEmpty = "Y" Then
mstrErrorCode = gslbiArrayEmpty
mstrErrorType = FATAL_ERROR
mstrErrorDesc = ARRAY_EMPTY
ReDim malngSelItems(0) 'prevents an error in
'the calling program
End If
GetSelectedListBoxItems = malngSelItems
GetSelLBItemExit:
Exit Function
GetSelLBItemError:
' Unknown error condition.
mstrErrorCode = Err.Number
mstrErrorType = FATAL_ERROR
mstrErrorDesc = Err.Description
Resume GetSelLBItemExit
End Function