Dokumentation: Projekt Kundenverwaltung (2009 - ) Modul: Listboxen Filter

Details
Kategorie: Archivierte Beiträge
'Kundenverwaltung.odb Modul Listboxen
Option Explicit
Dim OriginalList()
Dim oDialogModel as Object


Sub MergeList(SourceListBox() as Object, SecondList() as String)
Dim i as Integer
Dim MaxIndex as Integer
    MaxIndex = Ubound(SecondList())
    OriginalList() = AddListToList(OriginalList(), SecondList())
    For i = 0 To MaxIndex
        SourceListbox = AddSingleItemToListbox(SourceListbox, SecondList(i))
    Next i
    Call FormSetMoveRights()    
End Sub


Sub RemoveListItems(SourceListbox as Object, TargetListbox as Object, RemoveList() as String)
Dim i as Integer
Dim s as Integer
Dim MaxIndex as Integer
Dim CopyList()
    MaxIndex = Ubound(RemoveList())
    For i = 0 To MaxIndex
        RemoveListboxItemByName(SourceListbox, RemoveList(i))
        RemoveListboxItemByName(TargetListbox, RemoveList(i))
    Next i
    CopyList() = OriginalList()
    s = 0
    MaxIndex = Ubound(CopyList())
    For i = 0 To MaxIndex
        If IndexInArray(CopyList(i),RemoveList())= -1 Then
            OriginalList(s) = CopyList(i)
            s = s + 1
        End If
    Next i
    ReDim Preserve OriginalList(s-1)
    Call FormSetMoveRights()    
End Sub


' Note Boolean Parameter
Sub InitializeListboxProcedures(oModel as Object, SourceListbox as Object, TargetListbox as Object)
Dim EmptyList()
    Set oDialogModel = oModel
    OriginalList()= SourceListbox.StringItemList()
    TargetListbox.StringItemList() = EmptyList()
End Sub


Sub CopyListboxItems(SourceListbox as Object, TargetListbox As Object)
Dim NullArray()
    TargetListbox.StringItemList() = OriginalList()
    SourceListbox.StringItemList() = NullArray()
End Sub


Sub FormMoveSelected()
    Call MoveSelectedListBox(oDialogModel.lstFields, oDialogModel.lstSelFields)
    Call FormSetMoveRights()
    oDialogModel.lstSelFields.Tag = True
End Sub


Sub FormMoveAll()
    Call CopyListboxItems(oDialogModel.lstFields, oDialogModel.lstSelFields)
    Call FormSetMoveRights()
    oDialogModel.lstSelFields.Tag = True
End Sub


Sub FormRemoveSelected()
    Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, False)
    Call FormSetMoveRights()
    oDialogModel.lstSelFields.Tag = True
End Sub


Sub FormRemoveAll()
    Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, True)
    Call FormSetMoveRights()
    oDialogModel.lstSelFields.Tag = 1
End Sub


Sub MoveSelectedListBox(SourceListbox as Object, TargetListbox as Object)
Dim MaxCurTarget as Integer
Dim MaxSourceSelected as Integer
Dim n as Integer
Dim m as Integer
Dim CurIndex
Dim iOldTargetSelect as Integer
Dim iOldSourceSelect as Integer
    MaxCurTarget = Ubound(TargetListbox.StringItemList())
    MaxSourceSelected = Ubound(SourceListbox.SelectedItems())    
    Dim TargetList(MaxCurTarget+MaxSourceSelected+1)
    If MaxSourceSelected > -1 Then
        iOldSourceSelect = SourceListbox.SelectedItems(0)
        If Ubound(TargetListbox.SelectedItems()) > -1 Then
            iOldTargetSelect = TargetListbox.SelectedItems(0)
        Else
            iOldTargetSelect = -1
        End If
        For n = 0 To MaxCurTarget
            TargetList(n) = TargetListbox.StringItemList(n)
        Next n
        For m = 0 To MaxSourceSelected
            CurIndex = SourceListbox.SelectedItems(m)
            TargetList(n) = SourceListbox.StringItemList(CurIndex)
            n = n + 1
        Next m
        TargetListBox.StringItemList() = TargetList()
        SourceListbox.StringItemList() = RemoveSelected (SourceListbox)
        SetNewSelection(SourceListbox, iOldSourceSelect)
        SetNewSelection(TargetListbox, iOldTargetSelect)
    End If
End Sub



Sub MoveOrderedSelectedListbox(lstSource as Object, lstTarget as Object, bMoveAll as Boolean)
Dim NullArray()
Dim MaxSelected as Integer
Dim MaxSourceIndex as Integer
Dim MaxOriginalIndex as Integer
Dim MaxNewIndex as Integer
Dim n as Integer
Dim m as Integer
Dim CurIndex as Integer
Dim SearchString as String
Dim SourceList() as String
Dim iOldTargetSelect as Integer
Dim iOldSourceSelect as Integer
    If bMoveAll Then
        lstSource.StringItemList() = OriginalList()
        lstTarget.StringItemList() = NullArray()
    Else
        MaxOriginalIndex = Ubound(OriginalList())
        MaxSelected = Ubound(lstTarget.SelectedItems())
        iOldTargetSelect = lstTarget.SelectedItems(0)
        If Ubound(lstSource.SelectedItems()) > -1 Then
            iOldSourceSelect = lstSource.SelectedItems(0)
        End If
        Dim SelList(MaxSelected)
        For n = 0 To MaxSelected
            CurIndex = lstTarget.SelectedItems(n)
            SelList(n) = lstTarget.StringItemList(CurIndex)
        Next n
        SourceList() = lstSource.StringItemList()
        MaxSourceIndex = Ubound(lstSource.StringItemList())
        MaxNewIndex = MaxSelected + MaxSourceIndex + 1
        Dim NewSourceList(MaxNewIndex)
        m = 0
        For n = 0 To MaxOriginalIndex
            SearchString = OriginalList(n)
            If IndexInArray(SearchString, SelList()) <> -1 Then
                NewSourceList(m) =  SearchString
                m = m + 1
            ElseIf IndexInArray(SearchString, SourceList()) <> -1 Then
                NewSourceList(m) =  SearchString
                m = m + 1
            End If
        Next n
        lstSource.StringItemList() = NewSourceList()
        lstTarget.StringItemList() = RemoveSelected(lstTarget)
    End If
    SetNewSelection(lstSource, iOldSourceSelect)
    SetNewSelection(lstTarget, iOldTargetSelect)

End Sub


Function RemoveSelected(oListbox as Object)
Dim MaxIndex as Integer
Dim MaxSelected as Integer
Dim n as Integer
Dim m as Integer
Dim CurIndex as Integer
Dim CurItem as String
Dim ResultArray()
    MaxIndex = Ubound(oListbox.StringItemList())
    MaxSelected = Ubound(oListbox.SelectedItems())
    Dim LocItemList(MaxIndex)
    LocItemList() = oListbox.StringItemList()
    If MaxSelected > -1 Then
        For n = 0 To MaxSelected
            CurIndex = oListbox.SelectedItems(n)
            LocItemList(CurIndex) = ""
        Next n
        If MaxIndex > 0 Then
            ReDim ResultArray(MaxIndex - MaxSelected - 1)
            m = 0
            For n = 0 To MaxIndex
                CurItem = LocItemList(n)
                If CurItem <> "" Then
                    ResultArray(m) = CurItem
                    m = m + 1
                End If
            Next n    
        End If
        RemoveSelected = ResultArray()    
    Else
        RemoveSelected = oListbox.StringItemList()    
    End If
End Function


Sub SetNewSelection(oListBox as Object, iLastSelection as Integer)
Dim MaxIndex as Integer
Dim SelIndex as Integer
Dim SelList(0) as Integer
    MaxIndex = Ubound(oListBox.StringItemList())
    If MaxIndex > -1  AND iLastSelection > -1 Then
        If iLastSelection > MaxIndex Then
            Selindex = MaxIndex
        Else
            SelIndex = iLastSelection
        End If
        Sellist(0) = SelIndex
        oListBox.SelectedItems() = SelList()
    End If
End Sub


Sub ToggleListboxControls(oDialogModel as Object, bDoEnable as Boolean)
    With oDialogModel
        .lblFields.Enabled = bDoEnable
        .lblSelFields.Enabled = bDoEnable
'        .lstTables.Enabled = bDoEnable
        .lstFields.Enabled = bDoEnable
        .lstSelFields.Enabled = bDoEnable
        .cmdRemoveAll.Enabled = bDoEnable
        .cmdRemoveSelected.Enabled = bDoEnable
        .cmdMoveAll.Enabled = bDoEnable
        .cmdMoveSelected.Enabled = bDoEnable
    End With
    If bDoEnable Then
        FormSetMoveRights()
    End If
End Sub    


' Enable or disable the buttons used for moving the available
' fields between the two list boxes.
Sub FormSetMoveRights()
Dim bIsFieldSelected as Boolean
Dim bSelectSelected as Boolean
Dim FieldCount as Integer
Dim SelectCount as Integer
    bIsFieldSelected = Ubound(oDialogModel.lstFields.SelectedItems()) <> -1
    FieldCount = Ubound(oDialogModel.lstFields.StringItemList()) + 1
    bSelectSelected = Ubound(oDialogModel.lstSelFields.SelectedItems()) > -1
    SelectCount = Ubound(oDialogModel.lstSelFields.StringItemList()) + 1
    oDialogModel.cmdRemoveAll.Enabled = SelectCount>=1
    oDialogModel.cmdRemoveSelected.Enabled = bSelectSelected
    oDialogModel.cmdMoveAll.Enabled = FieldCount >=1
    oDialogModel.cmdMoveSelected.Enabled = bIsFieldSelected
    oDialogModel.cmdGoOn.Enabled = SelectCount>=1
    ' This flag is set to '1' when the lstSelFields has been modified
End Sub


Function AddSingleItemToListbox(ByVal oListbox as Object, ListItem as String, Optional iSelIndex) as Object
Dim MaxIndex as Integer
Dim i as Integer

    MaxIndex = Ubound(oListbox.StringItemList())
Dim LocList(MaxIndex + 1)
' Todo: This goes faster with the Redim LocList(MaxIndex + 1) Preserve function
    For i = 0 To MaxIndex
        LocList(i) = oListbox.StringItemList(i)
    Next i
    LocList(MaxIndex + 1) = ListItem
    oListbox.StringItemList() = LocList()
    If Not IsMissing(iSelIndex) Then
        SelectListboxItem(oListbox, iSelIndex)
    End If
    AddSingleItemToListbox() = oListbox
End Function


Sub    EmptyListbox(oListbox as Object)
Dim NullList() as String
    oListbox.StringItemList() = NullList()
End Sub


Sub    SelectListboxItem(oListbox as Object, iSelIndex as Integer)
Dim LocSelList(0) as Integer
    If iSelIndex <> -1 Then
        LocSelList(0) = iSelIndex
        oListbox.SelectedItems() = LocSelList()
    End If
End Sub


Function GetSelectedListboxItems(oListbox as Object)
Dim SelList(Ubound(oListBox.SelectedItems())) as String
Dim i as Integer
Dim CurIndex as Integer
    For i = 0 To Ubound(oListbox.SelectedItems())
        CurIndex = oListbox.SelectedItems(i)
        SelList(i) = oListbox.StringItemList(CurIndex)
    Next i
    GetSelectedListboxItems() = SelList()
End Function


' Note: When using this Sub it must be ensured that the
' 'RemoveItem' appears only once in the Listbox
Sub RemoveListboxItemByName(oListbox as Object, RemoveItem as String)
Dim OldList() as String
Dim NullList() as String
Dim i as Integer
Dim a as Integer
Dim MaxIndex as Integer
    OldList = oListbox.StringItemList()
    MaxIndex = Ubound(OldList())
    If IndexInArray(RemoveItem, OldList()) <> -1 Then
        If MaxIndex > 0 Then
            a = 0
            Dim NewList(MaxIndex -1)
            For i = 0 To MaxIndex
                If RemoveItem <> OldList(i) Then
                    NewList(a) = OldList(i)
                    a = a + 1
                End If
            Next i
            oListbox.StringItemList() = NewList()
        Else
            oListBox.StringItemList() = NullList()
        End If
    End If
End Sub


Function GetItemPos(oListBox as Object, sItem as String)
Dim ItemList()
Dim MaxIndex as Integer
Dim i as Integer
    ItemList() = oListBox.StringItemList()
    MaxIndex = Ubound(ItemList())    
    For i = 0 To MaxIndex
        If sItem = ItemList(i) Then
            GetItemPos() = i
            Exit Function
        End If
    Next i
    GetItemPos() = -1
End Function
Zugriffe: 323