Die Community zu .NET und Classic VB.

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

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

 von Martin Kotowicz

Schwierigkeitsgrad:

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