Solved

UserControl: How to put a collection in PropertyBag

Posted on 2001-06-06
4
334 Views
Last Modified: 2007-12-19
Hi !

I am working on a UserControl that contains a ListView.
I am adding a property page and while the usual properties work fine, I don't know how to handle the number of Columnsheaders so that the number of columns is saved with the WriteProperty method.

It works fine for adding columns in the property page:

SelectedControls(0).ColumnHeaders.Add 2

But when I run the project, as this number is not saved, the number of columns is lost since it cannot read this number.

Thanks,

SCML
0
Comment
Question by:scml
  • 2
4 Comments
 
LVL 2

Expert Comment

by:Microsoft
Comment Utility
Private Const LVIS_STATEIMAGEMASK As Long = &HF000

Private 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

Const SWP_DRAWFRAME = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4

Private Const LVS_EX_FULLROWSELECT = &H20
Private Const LVS_EX_GRIDLINES = &H1
Private Const LVS_EX_CHECKBOXES As Long = &H4
Private Const LVS_EX_HEADERDRAGDROP = &H10
Private Const LVS_EX_TRACKSELECT = &H8
Private Const LVS_EX_ONECLICKACTIVATE = &H40
Private Const LVS_EX_TWOCLICKACTIVATE = &H80
Private Const LVS_EX_SUBITEMIMAGES = &H2

Private Const LVM_FIRST = &H1000
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55
Private Const LVM_GETHEADER = (LVM_FIRST + 31)

Public Const LVIF_STATE = &H8
Public Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Public Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)

Private Const HDS_BUTTONS = &H2
Private Const GWL_STYLE = (-16)

Private Const SWP_FLAGS = SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME

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

Private 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
                       
Private Declare Function GetWindowLong _
                        Lib "user32" _
                        Alias "GetWindowLongA" _
                        (ByVal hwnd As Long, _
                        ByVal nIndex As Long) _
                        As Long
                       
Private Declare Function SetWindowLong _
                        Lib "user32" _
                        Alias "SetWindowLongA" _
                        (ByVal hwnd As Long, _
                        ByVal nIndex As Long, _
                        ByVal dwNewLong As Long) _
                        As Long
                       
Private Declare Function SetWindowPos _
                        Lib "user32" _
                        (ByVal hwnd As Long, _
                        ByVal hWndInsertAfter As Long, _
                        ByVal x As Long, _
                        ByVal Y As Long, _
                        ByVal cx As Long, _
                        ByVal cy As Long, _
                        ByVal wFlags As Long) _
                        As Long
'=======================================================================

'=======================================================================
Public LengthPerCharacter As Long
'=======================================================================

'=======================================================================
' Description: Resizes all Columns in a ListView to fit the text in
'              the rows
'=======================================================================
Public Function EnhListView_ResizeColumns( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '_______________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_ResizeColumns
   
    '_______________________________________________________________________
    ' set function return to true
    EnhListView_ResizeColumns = True
   
    '_______________________________________________________________________
    ' if the user has not set LengthPerCharacter use 80
    If LengthPerCharacter = 0 Then LengthPerCharacter = "80"
   
    '_______________________________________________________________________
    ' if there are columns to go through...
    If lstListViewName.ListItems.Count > 0 Then
        ' setup variables
        Dim lngIndexCounter As Long
        Dim lngColumnCounter As Long
        ' move through each column
        For lngColumnCounter = 1 To lstListViewName.ColumnHeaders.Count
            ' move though each entry
            For lngIndexCounter = 1 To lstListViewName.ListItems.Count
                ' if it is not the first column
                If lngColumnCounter > 1 Then
                    ' size the column 85 twips per letter
                    If Len(lstListViewName.ListItems.Item(lngIndexCounter).SubItems(lngColumnCounter - 1)) * LengthPerCharacter > _
                    lstListViewName.ColumnHeaders.Item(lngColumnCounter).Width Then
                        lstListViewName.ColumnHeaders.Item(lngColumnCounter).Width = _
                        Len(lstListViewName.ListItems.Item(lngIndexCounter).SubItems(lngColumnCounter - 1)) * LengthPerCharacter
                    End If
                ' if it is the first column
                Else
                    ' size the column 85 twips per letter
                    If Len(lstListViewName.ListItems.Item(lngIndexCounter).Text) * LengthPerCharacter > _
                    lstListViewName.ColumnHeaders.Item(lngColumnCounter).Width Then
                        lstListViewName.ColumnHeaders.Item(lngColumnCounter).Width = _
                        Len(lstListViewName.ListItems.Item(lngIndexCounter).Text) * LengthPerCharacter
                    End If
                End If
            Next lngIndexCounter
        Next lngColumnCounter
    End If
   
    '_______________________________________________________________________
    ' exit before error handler
    Exit Function
   
'_______________________________________________________________________
' deal with errors
err_EnhListView_ResizeColumns:
   
    '_______________________________________________________________________
    ' set function return to false
    EnhListView_ResizeColumns = False
    '_______________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_ResizeColumns"
    End If
   
    '_______________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_ResizeColumns" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '_______________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Use on ColumnClick to sort by that Column
'              Toggles between Ascending and Descending Sorts
'=======================================================================
Public Function EnhListView_SortColumns( _
                lstListViewName As ListView, _
                usdColIndex, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '_______________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_SortColumns
   
    '_______________________________________________________________________
    ' set function return to true
    EnhListView_SortColumns = True
   
    '_______________________________________________________________________
    ' if there are columns to go through...
    If lstListViewName.ListItems.Count > 0 Then
        ' if the sort property is turned off turn it on
        If lstListViewName.Sorted = False Then lstListViewName.Sorted = True
        ' set the sortby column
        lstListViewName.SortKey = _
            lstListViewName.ColumnHeaders.Item(usdColIndex).Index - 1
        ' if it's sorted ascending
        If lstListViewName.SortOrder = lvwAscending Then
            ' sort it descending
            lstListViewName.SortOrder = lvwDescending
        ' if it's sorted descending
        Else
            ' sort it ascending
            lstListViewName.SortOrder = lvwAscending
        End If
    End If
   
    '_______________________________________________________________________
    ' exit before error handler
    Exit Function
   
'_______________________________________________________________________
' deal with errors
err_EnhListView_SortColumns:
   
    '_______________________________________________________________________
    ' set function return to false
    EnhListView_SortColumns = False
    '_______________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_SortColumns"
    End If
   
    '_______________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_SortColumns" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '_______________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Resizes all Columns in a ListView to the Text in the
'              Column Caption
'=======================================================================
Public Function EnhListView_ResizeColumnCaptions( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '_______________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_ResizeColumnCaptions
   
    '_______________________________________________________________________
    ' set function return to true
    EnhListView_ResizeColumnCaptions = True
   
    '_______________________________________________________________________
    ' if the user has not set LengthPerCharacter use 80
    If LengthPerCharacter = 0 Then LengthPerCharacter = "80"
   
    '_______________________________________________________________________
    ' if there are columns to go through...
    If lstListViewName.ListItems.Count > 0 Then
        ' setup variables
        Dim lngColumnCounter As Long
        ' move through each column
        For lngColumnCounter = 1 To lstListViewName.ColumnHeaders.Count
            ' make the size of the column equal to 85 twips per character
            lstListViewName.ColumnHeaders.Item(lngColumnCounter).Width = _
            Len(lstListViewName.ColumnHeaders.Item(lngColumnCounter).Text) * LengthPerCharacter
        Next lngColumnCounter
    End If
   
    '_______________________________________________________________________
    ' exit before error handler
    Exit Function
   
'_______________________________________________________________________
' deal with errors
err_EnhListView_ResizeColumnCaptions:
   
    '_______________________________________________________________________
    ' set function return to false
    EnhListView_ResizeColumnCaptions = False
    '_______________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_ResizeColumnCaptions"
    End If
   
    '_______________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_ResizeColumnCaptions" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '_______________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Resizes the ColumnHeaders in a ListView to the Width
'              of the ListView
'=======================================================================
Public Function EnhListView_ResizeColumnHeaders( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_ResizeColumnHeaders
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_ResizeColumnHeaders = True
   
    '________________________________________________________________________
    ' setup variables
    Dim lngColCounter As Long
    Dim lngListViewDiv As Long
   
    '________________________________________________________________________
    ' fill variables
    lngListViewDiv = lstListViewName.Width / lstListViewName.ColumnHeaders.Count - 300
   
    '________________________________________________________________________
    For lngColCounter = 1 To lstListViewName.ColumnHeaders.Count
        lstListViewName.ColumnHeaders(lngColCounter).Width = lngListViewDiv
    Next lngColCounter
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_ResizeColumnHeaders:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_ResizeColumnHeaders = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_ResizeColumnHeaders"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_ResizeColumnHeaders" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables Full Row Select in a ListView
'=======================================================================
Public Function EnhListView_Add_FullRowSelect( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_FullRowSelect
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_FullRowSelect = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_FULLROWSELECT
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_FullRowSelect:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_FullRowSelect = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_FullRowSelect"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_FullRowSelect" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables Full Row Select in a ListView
'=======================================================================
Public Function EnhListView_Rem_FullRowSelect( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_FullRowSelect
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_FullRowSelect = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' remove the selected style from the current styles
    rStyle = rStyle Xor LVS_EX_FULLROWSELECT
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_FullRowSelect:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_FullRowSelect = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_FullRowSelect"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_FullRowSelect" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables GridLines in a ListView
'=======================================================================
Public Function EnhListView_Add_GridLines( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_GridLines
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_GridLines = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_GRIDLINES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_GridLines:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_GridLines = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_GridLines"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_GridLines" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables GridLines in a ListView
'=======================================================================
Public Function EnhListView_Rem_GridLines( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_GridLines
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_GridLines = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' remove the selected style from the current styles
    rStyle = rStyle Xor LVS_EX_GRIDLINES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_GridLines:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_GridLines = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_GridLines"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_GridLines" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables CheckBoxes in a ListView
'=======================================================================
Public Function EnhListView_Add_CheckBoxes( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_CheckBoxes
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_CheckBoxes = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_CHECKBOXES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_CheckBoxes:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_CheckBoxes = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_CheckBoxes"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_CheckBoxes" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables CheckBoxes in a ListView
'=======================================================================
Public Function EnhListView_Rem_CheckBoxes( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_CheckBoxes
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_CheckBoxes = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Xor LVS_EX_CHECKBOXES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_CheckBoxes:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_CheckBoxes = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_CheckBoxes"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_CheckBoxes" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables Repositioning of ColumnHeaders in a ListView
'=======================================================================
Public Function EnhListView_Add_AllowRepositioning( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_AllowRepositioning
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_AllowRepositioning = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_HEADERDRAGDROP
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_AllowRepositioning:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_AllowRepositioning = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_AllowRepositioning"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_AllowRepositioning" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables Repositioning of ColumnHeaders in a ListView
'=======================================================================
Public Function EnhListView_Rem_AllowRepositioning( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_AllowRepositioning
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_AllowRepositioning = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Xor LVS_EX_HEADERDRAGDROP
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_AllowRepositioning:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_AllowRepositioning = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_AllowRepositioning"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_AllowRepositioning" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables TrackSelected in a ListView
'=======================================================================
Public Function EnhListView_Add_TrackSelected( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_TrackSelected
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_TrackSelected = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_TRACKSELECT
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_TrackSelected:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_TrackSelected = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_TrackSelected"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_TrackSelected" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables TrackSelected in a ListView
'=======================================================================
Public Function EnhListView_Rem_TrackSelected( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_TrackSelected
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_TrackSelected = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Xor LVS_EX_TRACKSELECT
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_TrackSelected:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_TrackSelected = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_TrackSelected"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_TrackSelected" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables One Click Activate in a ListView
'=======================================================================
Public Function EnhListView_Add_OneClickActivate( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_OneClickActivate
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_OneClickActivate = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_ONECLICKACTIVATE
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_OneClickActivate:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_OneClickActivate = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_OneClickActivate"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_OneClickActivate" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables One Click Activate in a ListView
'=======================================================================
Public Function EnhListView_Rem_OneClickActivate( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_OneClickActivate
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_OneClickActivate = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Xor LVS_EX_ONECLICKACTIVATE
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_OneClickActivate:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_OneClickActivate = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_OneClickActivate"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_OneClickActivate" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables Two Click Activate in a ListView
'=======================================================================
Public Function EnhListView_Add_TwoClickActivate( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_TwoClickActivate
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_TwoClickActivate = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_TWOCLICKACTIVATE
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_TwoClickActivate:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_TwoClickActivate = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_TwoClickActivate"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_TwoClickActivate" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables Full Row Select in a ListView
'=======================================================================
Public Function EnhListView_Rem_TwoClickActivate( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_TwoClickActivate
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_TwoClickActivate = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Xor LVS_EX_TWOCLICKACTIVATE
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_TwoClickActivate:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_TwoClickActivate = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_TwoClickActivate"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_TwoClickActivate" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Enables SubItem Images in a ListView
'=======================================================================
Public Function EnhListView_Add_SubitemImages( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Add_SubitemImages
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Add_SubitemImages = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' add the selected style to the current styles
    rStyle = rStyle Or LVS_EX_SUBITEMIMAGES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Add_SubitemImages:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Add_SubitemImages = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Add_SubitemImages"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Add_SubitemImages" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Disables SubItem Images in a ListView
'=======================================================================
Public Function EnhListView_Rem_SubitemImages( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Rem_SubitemImages
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Rem_SubitemImages = True
   
    '________________________________________________________________________
    ' setup variables
    Dim rStyle  As Long
    Dim r       As Long
   
    '________________________________________________________________________
    ' get the current styles
    rStyle = SendMessageLong(lstListViewName.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
   
    '________________________________________________________________________
    ' remove the selected style from the current styles
    rStyle = rStyle Xor LVS_EX_SUBITEMIMAGES
   
    '________________________________________________________________________
    ' update the listview styles
    SendMessageLong lstListViewName.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Rem_SubitemImages:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Rem_SubitemImages = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Rem_SubitemImages"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Rem_SubitemImages" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Checks all Items in the ListView
'=======================================================================
Public Function EnhLitView_CheckAllItems( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhLitView_CheckAllItems
   
    '________________________________________________________________________
    ' set function return to true
    EnhLitView_CheckAllItems = True
   
    '________________________________________________________________________
    ' setup variables
    Dim LV          As LVITEM
    Dim lvCount     As Long
    Dim lvIndex     As Long
    Dim lvState     As Long
    Dim r           As Long
   
    '________________________________________________________________________
    lvState = IIf(True, &H2000, &H1000)
    lvCount = lstListViewName.ListItems.Count - 1
    Do
        With LV
            .mask = LVIF_STATE
            .state = lvState
            .stateMask = LVIS_STATEIMAGEMASK
        End With
        r = SendMessageAny(lstListViewName.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
        lvIndex = lvIndex + 1
    Loop Until lvIndex > lvCount
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhLitView_CheckAllItems:
   
    '________________________________________________________________________
    ' set function return to false
    EnhLitView_CheckAllItems = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhLitView_CheckAllItems"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhLitView_CheckAllItems" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Unchecks all items in a ListView
'=======================================================================
Public Function EnhLitView_UnCheckAllItems( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhLitView_UnCheckAllItems
   
    '________________________________________________________________________
    ' set function return to true
    EnhLitView_UnCheckAllItems = True
   
    '________________________________________________________________________
    ' setup variables
    Dim LV          As LVITEM
    Dim lvCount     As Long
    Dim lvIndex     As Long
    Dim lvState     As Long
    Dim r           As Long
   
    '________________________________________________________________________
    lvState = IIf(True, &H2000, &H1000)
    lvCount = lstListViewName.ListItems.Count - 1
    Do
        With LV
            .mask = LVIF_STATE
            .state = lvState
            .stateMask = LVIS_STATEIMAGEMASK
        End With
        r = SendMessageAny(lstListViewName.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
        lvIndex = lvIndex + 1
    Loop Until lvIndex > lvCount
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhLitView_UnCheckAllItems:
   
    '________________________________________________________________________
    ' set function return to false
    EnhLitView_UnCheckAllItems = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhLitView_UnCheckAllItems"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhLitView_UnCheckAllItems" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================


'=======================================================================
' Description: Inverts all checked items in a ListView
'=======================================================================
Public Function EnhListView_InvertAllChecks( _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_InvertAllChecks
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_InvertAllChecks = True
   
    '________________________________________________________________________
    ' setup variables
    Dim LV          As LVITEM
    Dim r           As Long
    Dim lvCount     As Long
    Dim lvIndex     As Long
   
    '________________________________________________________________________
    lvCount = lstListViewName.ListItems.Count - 1
    Do
        r = SendMessageLong(lstListViewName.hwnd, LVM_GETITEMSTATE, lvIndex, LVIS_STATEIMAGEMASK)
        With LV
            .mask = LVIF_STATE
            .stateMask = LVIS_STATEIMAGEMASK
            If r And &H2000& Then
                .state = &H1000
            Else
                .state = &H2000
            End If
        End With
        r = SendMessageAny(lstListViewName.hwnd, LVM_SETITEMSTATE, lvIndex, LV)
        lvIndex = lvIndex + 1
    Loop Until lvIndex > lvCount
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_InvertAllChecks:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_InvertAllChecks = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_InvertAllChecks"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_InvertAllChecks" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================

'=======================================================================
' Description: Toggles FlatColumnHeaders in a ListView
'=======================================================================
Public Function EnhListView_Toggle_FlatColumnHeaders( _
                frmFormName As Form, _
                lstListViewName As ListView, _
                Optional bolShowErrors As Boolean) _
                As Boolean
   
    '________________________________________________________________________
    ' initiate error handler
    On Error GoTo err_EnhListView_Toggle_FlatColumnHeaders
   
    '________________________________________________________________________
    ' set function return to true
    EnhListView_Toggle_FlatColumnHeaders = True
   
    '________________________________________________________________________
    SetWindowLong SendMessageLong(lstListViewName.hwnd, _
                                 LVM_GETHEADER, _
                                 0, _
                                 ByVal 0&), _
                                 GWL_STYLE, _
                                 GetWindowLong(SendMessageLong(lstListViewName.hwnd, _
                                                               LVM_GETHEADER, _
                                                               0, _
                                                               ByVal _
                                                               0&), _
                                                               GWL_STYLE) _
                                                               Xor HDS_BUTTONS
    SetWindowPos lstListViewName.hwnd, _
                 frmFormName.hwnd, _
                 0, _
                 0, _
                 0, _
                 0, _
                 SWP_FLAGS
   
    '________________________________________________________________________
    ' exit before error handler
    Exit Function
   
'________________________________________________________________________
' deal with errors
err_EnhListView_Toggle_FlatColumnHeaders:
   
    '________________________________________________________________________
    ' set function return to false
    EnhListView_Toggle_FlatColumnHeaders = False
    '________________________________________________________________________
    ' if you want notification on an error
    If bolShowErrors = True Then
        MsgBox "Error" & Err.Number & vbTab & Err.Description, _
               vbOKOnly + vbInformation, _
               "Error in Function : EnhListView_Toggle_FlatColumnHeaders"
    End If
   
    '________________________________________________________________________
    ' initiate debug
    Debug.Print Now & vbTab & "Error in function: EnhListView_Toggle_FlatColumnHeaders" _
                & vbCrLf & _
                Err.Number & vbTab & Err.Description
    Debug.Assert False
   
    '________________________________________________________________________
    ' exit
    Exit Function
   
End Function
'=======================================================================
0
 

Author Comment

by:scml
Comment Utility
Thanks for this comment, which surely is useful for customizing the ListView, but what is the relation with property pages ?

SCML
0
 
LVL 4

Accepted Solution

by:
TigerZhao earned 200 total points
Comment Utility
Option Explicit

Private Const STR_PROP_COLUMN_HEADERS_COUNT = "ColumnHeadersCount"
Private Const STR_PROP_COLUMN_HEADERS_TEXT = "ColumnHeadersText"
Private Const STR_PROP_COLUMN_HEADERS_WIDTH = "ColumnHeadersWidth"

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Dim lngCount        As Long
    Dim astrWidth()     As String
    Dim astrText()      As String
    Dim I               As Long
   
    With lvw.ColumnHeaders
        .Clear
               
        lngCount = PropBag.ReadProperty(STR_PROP_COLUMN_HEADERS_COUNT, 0)
       
        If lngCount > 0 Then
            astrText = Split(PropBag.ReadProperty(STR_PROP_COLUMN_HEADERS_TEXT), vbTab)
            astrWidth = Split(PropBag.ReadProperty(STR_PROP_COLUMN_HEADERS_WIDTH), vbTab)
           
            For I = 1 To lngCount
                .Add , , astrText(I - 1), astrWidth(I - 1)
            Next
           
        End If
    End With
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Dim lngCount        As Long
    Dim astrWidth()     As String
    Dim astrText()      As String
    Dim I               As Long
   
    With lvw.ColumnHeaders
        lngCount = .Count
        PropBag.WriteProperty STR_PROP_COLUMN_HEADERS_COUNT, lngCount, 0
       
        If lngCount > 0 Then
            ReDim astrWidth(lngCount - 1)
            ReDim astrText(lngCount - 1)
           
            For I = 1 To lngCount
                astrWidth(I - 1) = .Item(I).Width
                astrText(I - 1) = .Item(I).Text
            Next
           
            PropBag.WriteProperty STR_PROP_COLUMN_HEADERS_TEXT, Join(astrText, vbTab)
            PropBag.WriteProperty STR_PROP_COLUMN_HEADERS_WIDTH, Join(astrWidth, vbTab)
        End If
    End With
End Sub
0
 

Author Comment

by:scml
Comment Utility
Excellent ! This was exactly what I was looking for.

Thanks a lot !

SCML
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now