Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0451: Mehrspaltige ListBox per Flexgrid

 von 

Beschreibung 

Hier wurde mal aus dem Flexgrid eine mehrspaltige "ListBox" gebastelt, jeweils mit Einfachauswahl und Mehrfachauswahl. Jedoch immer mit der Möglichkeit, Zeilen innerhalb des Flexgrids zu verschieben, was mit der gedrückten linken Maustaste geht.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [5,43 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente 'Microsoft FlexGrid Control 6.0 (MSFLXGRD.OCX)' wird benötigt.

'--- Anfang Formular "frmBeispielFlexGrid" alias frmBeispielFlexGrid.frm  ---
' Steuerelement: Schaltfläche "cmdRechts"
' Steuerelement: Schaltfläche "cmdLinks"
' Steuerelement: Flexible Tabelle "flgArtikel1"
' Steuerelement: Flexible Tabelle "flgArtikel2"
Option Explicit

' **********************
' *                    *
' * mehrspaltige Liste *
' *   mit msflexgrid   *
' *                    *
' *     by: cat        *
' **********************
' In dem Beispiel werden zwei msflexgrids zu mehrspaltigen Listen
' umfunktioniert. In der linken "msflexliste" steht eine Mehrfach- und in
' der rechten eine Einfachauswahl zur Verfügung. in beiden listen lassen
' sich die Einträge mit der gedrückten linken Maustaste nach oben und unten
' verschieben. Das ganze soll zeigen, wozu msflexgrid fähig ist und
' außerdem braucht man öfters eine mehrspaltige listbox.

Private lngQuelleRow As Long            ' speichert die gedrückte zeile
Private intSelektiertQuelle As Integer   ' merkt sich ob die ewegte zeile

' selektiert war
Private blnMakroEintragBewegt As Boolean  ' merkt sich ob eine zeile

' verschoben wurde
Private Const MSFG_Normal = 0           ' zeile ist nicht selektiert
Private Const MSFG_Selected = 1         ' zeile ist selektiert

Private Sub cmdLinks_Click()

    ' der selektierte eintrag im rechten flexgrid wird in den linken
    ' 'verschoben'
    Dim lngIndex As Long  ' zeilenindex
    
    lngIndex = 1 ' laufe von der ersten (lngIndex = 0 ist überschrift) ...
    
    Do Until lngIndex = Me.flgArtikel2.Rows  ' ...bis zu letzten zeile des
    
        ' flexgrid
        ' wenn zeile selektiert...
        If Me.flgArtikel2.RowData(lngIndex) = MSFG_Selected Then
        
            Me.flgArtikel2.Row = lngIndex  ' muss der datensatz im flexgrid
            
            ' markiert werden
            Me.flgArtikel2.Col = 0
            Me.flgArtikel2.RowSel = lngIndex
            Me.flgArtikel2.ColSel = Me.flgArtikel2.Cols - 1
            Me.flgArtikel1.AddItem Me.flgArtikel2.Clip  ' in die linke
            
            ' liste hinzufügen
            ' aus der rechten entfernen
            If Me.flgArtikel2.Rows = 2 Then
            
                Me.flgArtikel2.Rows = 1
                
            Else
            
                Me.flgArtikel2.RemoveItem (lngIndex)
                
            End If
            
            Exit Do ' suche kann abgebrochen werden da nur einzelauswahl
            
            ' vorhanden
        Else ' wenn zeile nicht selektiert
        
            lngIndex = lngIndex + 1 ' dann zeilenindex auf die nächste
            
            ' zeile...
        End If
        
    Loop    ' ... und suche fortsetzen
    
    Call SetzeBreite ' passt die darstellung der flexgrids der zeilenanzahl an
    
End Sub

Private Sub cmdRechts_Click()

    ' die selektierten einträge im linken flexgrid werden in den rechten
    ' 'verschoben'
    ' abarbeitung analog zu cmdlinks_click ohne do-schleifen - abbruch da
    ' mehrfach auswahl
    Dim lngIndex As Long
    
    lngIndex = 1
    
    Do Until lngIndex = Me.flgArtikel1.Rows
    
        If Me.flgArtikel1.RowData(lngIndex) = MSFG_Selected Then
        
            Me.flgArtikel1.Row = lngIndex
            Me.flgArtikel1.Col = 0
            Me.flgArtikel1.RowSel = lngIndex
            Me.flgArtikel1.ColSel = Me.flgArtikel1.Cols - 1
            Me.flgArtikel2.AddItem Me.flgArtikel1.Clip
            
            If Me.flgArtikel1.Rows = 2 Then
            
                Me.flgArtikel1.Rows = 1
                
            Else
            
                Me.flgArtikel1.RemoveItem (lngIndex)
                
            End If
            
            ' wegen mehrfachauswahl wird hier nicht abgebrochen
        Else
        
            lngIndex = lngIndex + 1
            
        End If
        
    Loop
    
    Call SetzeBreite
    
End Sub

Private Sub FillData()

    ' füllt die flexgrids mit daten
    Me.flgArtikel1.TextMatrix(0, 0) = "Index"
    Me.flgArtikel1.TextMatrix(0, 1) = "Artikel"
    Me.flgArtikel1.TextMatrix(0, 2) = "Preis"
    Me.flgArtikel2.TextMatrix(0, 0) = "Index"
    Me.flgArtikel2.TextMatrix(0, 1) = "Artikel"
    Me.flgArtikel2.TextMatrix(0, 2) = "Preis"
    Me.flgArtikel1.AddItem "1" & vbTab & "Stuhl" & vbTab & "25,00 €"
    Me.flgArtikel1.AddItem "2" & vbTab & "Tisch" & vbTab & "50,31 €"
    Me.flgArtikel1.AddItem "3" & vbTab & "Lampe" & vbTab & "17,80 €"
    Me.flgArtikel1.AddItem "4" & vbTab & "Tür" & vbTab & "105,00 €"
    Me.flgArtikel1.AddItem "5" & vbTab & "Fenster" & vbTab & "33,33 €"
    Me.flgArtikel1.AddItem "6" & vbTab & "Bleistift" & vbTab & "1,00 €"
    Me.flgArtikel1.AddItem "7" & vbTab & "CD" & vbTab & "25,25 €"
    Me.flgArtikel1.AddItem "8" & vbTab & "Messer" & vbTab & "3,25 €"
    Me.flgArtikel1.AddItem "9" & vbTab & "Gabel" & vbTab & "2,55 €"
    Me.flgArtikel1.AddItem "10" & vbTab & "Buch" & vbTab & "11,30 €"
    Me.flgArtikel1.AddItem "11" & vbTab & "Bett" & vbTab & "250,99 €"
    Me.flgArtikel1.AddItem "12" & vbTab & "Zeitung" & vbTab & "2,56 €"
    Me.flgArtikel1.AddItem "13" & vbTab & "Jacke" & vbTab & "100,00 €"
    Me.flgArtikel1.AddItem "14" & vbTab & "Schuhe" & vbTab & "55,00 €"
    Me.flgArtikel1.AddItem "15" & vbTab & "Hose" & vbTab & "25,99 €"
    
End Sub

Private Sub flgArtikel1_MouseDown(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    ' merke die zeile die angecklickt wurde
    lngQuelleRow = Me.flgArtikel1.MouseRow
    
    Select Case Button
    
    Case vbRightButton ' wenn rechte maustaste gedrückt wurde ...
    
        ' ... und wenn nicht ausserhalb einer gültigen zeile...
        If lngQuelleRow = Me.flgArtikel1.Rows Or lngQuelleRow = 0 Then Exit _
            Sub
            
        ' ...gebe zeileninhalt in einer msg-box aus
        MsgBox ("Index: " & Me.flgArtikel1.TextMatrix(lngQuelleRow, 0) & _
            vbCrLf & "Artikel: " & Me.flgArtikel1.TextMatrix(lngQuelleRow, _
            1) & vbCrLf & "Preis: " & Me.flgArtikel1.TextMatrix( _
            lngQuelleRow, 2))
            
    End Select
    
End Sub

Private Sub flgArtikel1_MouseMove(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    Dim strQuelle As String ' speichert den inhalt der verschobenen zeile
    Dim intIndex As Integer ' column-index wird beim farblichen markieren
    
    ' der zeile benötigt
    Dim lngZielRow As Long ' speichert die zeile in die gewählte zeile
    
    ' verschoben werden soll
    Select Case Button
    
    Case vbLeftButton ' nur bei linker taste verschieben
    
        If lngQuelleRow = 0 Then Exit Sub  ' überschrift darf nicht
        
        ' verschoben werden
        lngZielRow = Me.flgArtikel1.MouseRow  ' merkt sich die aktuelle
        
        ' zeile auf die die maus
        ' zeigt
        ' wenn maus nicht verschoben wurde (mind. eine zeile) dann tue nichts
        If lngZielRow = lngQuelleRow Or lngZielRow = 0 Then Exit Sub
        
        blnMakroEintragBewegt = True ' falls doch dann merke das die maus
        
        ' bewegt wurde
        ' zeile wird im flexgrid markiert
        Me.flgArtikel1.Col = 0
        Me.flgArtikel1.Row = lngQuelleRow
        Me.flgArtikel1.ColSel = Me.flgArtikel1.Cols - 1
        Me.flgArtikel1.RowSel = lngQuelleRow
        
        ' merkt sich ob die zeile selektiert wurde
        intSelektiertQuelle = Me.flgArtikel1.RowData(lngQuelleRow)
        strQuelle = Me.flgArtikel1.Clip     ' entnehme zeileninhalt
        Me.flgArtikel1.RemoveItem (lngQuelleRow)    ' entferne zeile aus
        
        ' der liste (aus dem
        ' flexgrid)
        If lngQuelleRow = lngZielRow Then   ' prüfe ob in die letzte zeile
        
            ' verschoben werden soll
            ' wenn ja dann füge eine zeile am ende ein
            Call Me.flgArtikel1.AddItem(strQuelle, lngZielRow + 1)
            
        Else
        
            ' falls nicht dann in die entsprechende zeile
            Call Me.flgArtikel1.AddItem(strQuelle, lngZielRow)
            
        End If
        
        lngQuelleRow = lngZielRow ' die zeile merken falls weiter verschieben
        
        ' falls vom verschieben markiert dann markiere wieder
        Me.flgArtikel1.RowData(lngQuelleRow) = intSelektiertQuelle
        Me.flgArtikel1.Row = lngQuelleRow
        
        ' Die bewegte Zeile wird farblich markiert
        For intIndex = 0 To Me.flgArtikel1.Cols - 1
        
            Me.flgArtikel1.Col = intIndex
            Me.flgArtikel1.CellBackColor = vbYellow
            
        Next
        
    End Select
    
End Sub

Private Sub flgArtikel1_MouseUp(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    Dim lngRow As Long, intData As Integer, intIndex As Integer
    
    Select Case Button
    
    Case vbLeftButton ' wenn die linke maustaste gedrück war...
    
        If blnMakroEintragBewegt = True Then ' ...und eine zeile verschoben
        
            ' wurde
            Me.flgArtikel1.Row = lngQuelleRow
            
            Select Case Me.flgArtikel1.RowData(lngQuelleRow) ' prüfe ob
            
                ' zeile
                ' markiert
            Case MSFG_Selected ' wenn ja
            
                ' Die Darstellung der Zeile wird erhalten
                For intIndex = 0 To Me.flgArtikel1.Cols - 1
                
                    Me.flgArtikel1.Col = intIndex
                    Me.flgArtikel1.CellForeColor = vbWhite
                    Me.flgArtikel1.CellBackColor = vbBlue
                    
                Next
                
            Case MSFG_Normal ' wenn nein
            
                ' Die Darstellung der Zeile wird erhalten
                For intIndex = 0 To Me.flgArtikel1.Cols - 1
                
                    Me.flgArtikel1.Col = intIndex
                    Me.flgArtikel1.CellForeColor = vbBlack
                    Me.flgArtikel1.CellBackColor = vbWhite
                    
                Next
                
            End Select
            
            blnMakroEintragBewegt = False
            
            Exit Sub
            
        End If
        
        ' falls zeile nicht bewegt wurde
        lngRow = Me.flgArtikel1.Row
        
        If lngRow = Me.flgArtikel1.Rows Then Exit Sub ' und die zeile
        
        ' gültig ist
        intData = Me.flgArtikel1.RowData(lngRow)
        
        Select Case intData
        
        Case MSFG_Normal    ' markiere eine nicht markierte zeile
            Me.flgArtikel1.RowSel = lngRow
            
            ' Die Markierung der Zeile wird farblich dargestellt
            For intIndex = 0 To Me.flgArtikel1.Cols - 1
            
                Me.flgArtikel1.Col = intIndex
                Me.flgArtikel1.CellForeColor = vbWhite
                Me.flgArtikel1.CellBackColor = vbBlue
                
            Next
            
            Me.flgArtikel1.RowData(lngRow) = MSFG_Selected
            
        Case MSFG_Selected  ' oder entferne die markierung einer markierten
        
            ' zeile
            Me.flgArtikel1.RowSel = lngRow
            
            ' Die farbliche Markierung der Zeile wird aufgehoben
            For intIndex = 0 To Me.flgArtikel1.Cols - 1
            
                Me.flgArtikel1.Col = intIndex
                Me.flgArtikel1.CellForeColor = vbBlack
                Me.flgArtikel1.CellBackColor = vbWhite
                
            Next
            
            Me.flgArtikel1.RowData(lngRow) = MSFG_Normal
            
        End Select
        
    Case vbRightButton
    
    End Select
    
    lngQuelleRow = 0
    
End Sub

Private Sub flgArtikel2_MouseDown(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    ' analog flgartikel1_mousedown
    lngQuelleRow = Me.flgArtikel2.MouseRow
    
    Select Case Button
    
    Case vbRightButton
    
        If lngQuelleRow = Me.flgArtikel2.Rows Or lngQuelleRow = 0 Then Exit _
            Sub
            
        MsgBox ("Index: " & Me.flgArtikel2.TextMatrix(lngQuelleRow, 0) & _
            vbCrLf & "Artikel: " & Me.flgArtikel2.TextMatrix(lngQuelleRow, _
            1) & vbCrLf & "Preis: " & Me.flgArtikel2.TextMatrix( _
            lngQuelleRow, 2))
            
    End Select
    
End Sub

Private Sub flgArtikel2_MouseMove(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    ' analog flgartikel1_mousemove
    Dim strQuelle As String
    Dim intIndex As Integer
    Dim lngZielRow As Long
    
    Select Case Button
    
    Case vbLeftButton
    
        ' If lngQuelleRow = 0 Then Call flgArtikel2_MouseDown(vbLeftButton,
        ' 0, 0, 0)
        If lngQuelleRow = 0 Then Exit Sub
        
        lngZielRow = Me.flgArtikel2.MouseRow
        
        If lngZielRow = lngQuelleRow Or lngZielRow = 0 Then Exit Sub
        
        blnMakroEintragBewegt = True
        Me.flgArtikel2.Col = 0
        Me.flgArtikel2.Row = lngQuelleRow
        Me.flgArtikel2.ColSel = Me.flgArtikel2.Cols - 1
        Me.flgArtikel2.RowSel = lngQuelleRow
        intSelektiertQuelle = Me.flgArtikel2.RowData(lngQuelleRow)
        strQuelle = Me.flgArtikel2.Clip
        Me.flgArtikel2.RemoveItem (lngQuelleRow)
        
        If lngQuelleRow = lngZielRow Then
        
            Call Me.flgArtikel2.AddItem(strQuelle, lngZielRow + 1)
            
        Else
        
            Call Me.flgArtikel2.AddItem(strQuelle, lngZielRow)
            
        End If
        
        lngQuelleRow = lngZielRow
        Me.flgArtikel2.RowData(lngQuelleRow) = intSelektiertQuelle
        Me.flgArtikel2.Row = lngQuelleRow
        
        ' Die bewegte Zeile wird farblich markiert
        For intIndex = 0 To Me.flgArtikel2.Cols - 1
        
            Me.flgArtikel2.Col = intIndex
            Me.flgArtikel2.CellBackColor = vbYellow
            
        Next
        
    End Select
    
End Sub

Private Sub flgArtikel2_MouseUp(Button As Integer, Shift As Integer, x As _
    Single, y As Single)
    
    Dim lngRow As Long, intData As Integer, intIndex As Integer, lngIndex As _
        Integer
        
    If lngQuelleRow = 0 Then Exit Sub
    
    Select Case Button
    
    Case vbLeftButton
    
        If blnMakroEintragBewegt = True Then        ' ** analog
        
            ' flgartikel1_mouseup
            ' **
            Select Case Me.flgArtikel2.RowData(lngQuelleRow)
            
            Case MSFG_Selected
            
                ' Die Darstellung der Zeile wird erhalten
                For intIndex = 0 To Me.flgArtikel2.Cols - 1
                
                    Me.flgArtikel2.Col = intIndex
                    Me.flgArtikel2.CellForeColor = vbWhite
                    Me.flgArtikel2.CellBackColor = vbBlue
                    
                Next
                
            Case MSFG_Normal
            
                ' Die Darstellung der Zeile wird erhalten
                For intIndex = 0 To Me.flgArtikel2.Cols - 1
                
                    Me.flgArtikel2.Col = intIndex
                    Me.flgArtikel2.CellForeColor = vbBlack
                    Me.flgArtikel2.CellBackColor = vbWhite
                    
                Next
                
            End Select
            
            blnMakroEintragBewegt = False
            
            Exit Sub
            
        End If
        
        lngRow = lngQuelleRow
        
        If lngRow = Me.flgArtikel2.Rows Then Exit Sub       ' ****************
        
        ' **
        ' da nur einfachauswahl wird die selektion einer zeile nicht wieder
        ' aufgehoben
        Me.flgArtikel2.Row = lngRow
        
        ' Die Markierung der Zeile wird farblich dargestellt
        For intIndex = 0 To Me.flgArtikel2.Cols - 1
        
            Me.flgArtikel2.Col = intIndex
            Me.flgArtikel2.CellForeColor = vbWhite
            Me.flgArtikel2.CellBackColor = vbBlue
            
        Next
        
        Me.flgArtikel2.RowData(lngRow) = MSFG_Selected
        
        For lngIndex = 1 To Me.flgArtikel2.Rows - 1
        
            ' selektion aller anderen zeilen wird aufgehoben
            If Me.flgArtikel2.RowData(lngIndex) = MSFG_Selected And lngIndex _
                <> lngRow Then
                
                Me.flgArtikel2.Row = lngIndex
                
                ' Die farbliche Markierung der Zeile wird aufgehoben
                For intIndex = 0 To Me.flgArtikel2.Cols - 1
                
                    Me.flgArtikel2.Col = intIndex
                    Me.flgArtikel2.CellForeColor = vbBlack
                    Me.flgArtikel2.CellBackColor = vbWhite
                    
                Next
                
                Me.flgArtikel2.RowData(lngIndex) = MSFG_Normal
                
            End If
            
        Next
        
    Case vbRightButton
    
    End Select
    
    lngQuelleRow = 0
    
End Sub

Private Sub Form_Load()

    Call FillData       ' fülle das flgartikel1 mit daten
    Call SetzeBreite    ' passe die darstellung an
    
End Sub

Private Sub SetzeBreite()

    ' passt die darstellung der beiden flexgrids ihrer zeilenanzahl an
    ' falls mehr zeilen vorhanden als dargestellt werden können
    If Me.flgArtikel1.RowHeight(0) * Me.flgArtikel1.Rows > _
        Me.flgArtikel1.Height - 30 Then
        
        ' werden die zeilen schmaller damit scrollbar keine dten verdeckt
        Me.flgArtikel1.ColWidth(0) = (Me.flgArtikel1.Width - 325) / 3
        Me.flgArtikel1.ColWidth(1) = (Me.flgArtikel1.Width - 325) / 3
        Me.flgArtikel1.ColWidth(2) = (Me.flgArtikel1.Width - 325) / 3
        
    Else
    
        ' zeilen werden normal dargestellt
        Me.flgArtikel1.ColWidth(0) = (Me.flgArtikel1.Width - 100) / 3
        Me.flgArtikel1.ColWidth(1) = (Me.flgArtikel1.Width - 100) / 3
        Me.flgArtikel1.ColWidth(2) = (Me.flgArtikel1.Width - 100) / 3
        
    End If
    
    ' analog flgArtikel1
    If Me.flgArtikel2.RowHeight(0) * Me.flgArtikel2.Rows > _
        Me.flgArtikel2.Height - 30 Then
        
        Me.flgArtikel2.ColWidth(0) = (Me.flgArtikel2.Width - 325) / 3
        Me.flgArtikel2.ColWidth(1) = (Me.flgArtikel2.Width - 325) / 3
        Me.flgArtikel2.ColWidth(2) = (Me.flgArtikel2.Width - 325) / 3
        
    Else
    
        Me.flgArtikel2.ColWidth(0) = (Me.flgArtikel2.Width - 100) / 3
        Me.flgArtikel2.ColWidth(1) = (Me.flgArtikel2.Width - 100) / 3
        Me.flgArtikel2.ColWidth(2) = (Me.flgArtikel2.Width - 100) / 3
        
    End If
    
End Sub


'--- Ende Formular "frmBeispielFlexGrid" alias frmBeispielFlexGrid.frm  ---
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.