Startseite / Tipps / VB 5/6-Tipp 0583: Checkboxen im Flexgrid realisieren

VB 5/6-Tipp 0583: Checkboxen im Flexgrid realisieren

 von Peter K. Sauer

'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 Projekt1.vbp -------------
' Die Komponente 'Microsoft FlexGrid Control 6.0 (MSFLXGRD.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Flexible Tabelle "MSFlexGrid1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"

Option Explicit

Private Sub Form_Load()

   Dim i As Long
   Dim j As Long

      With MSFlexGrid1
         .Rows = 20
         .Cols = 5
         .FocusRect = flexFocusNone
      
         For i = 1 To .Rows - 1
            .TextMatrix(i, 0) = Format(i, "000")
            For j = 1 To .Cols - 1
               .TextMatrix(i, j) = "Spalte " & i & "." & j
            Next
         Next
      End With
      
      'eine Checkhaken erstellen
      FlexCheckCreate Picture1, MSFlexGrid1.BackColorFixed
      'Picturebox unvisible
      Picture1.Visible = False
End Sub


Private Sub Form_Unload(Cancel As Integer)


   Dim i As Long
   
      'Demo der Funktion FlexRowIsChecked
      With MSFlexGrid1
         For i = .FixedRows To .Rows - 1
            Debug.Print "Row " & Format(i, "000") & ": ";
            Debug.Print FlexRowIsChecked(MSFlexGrid1, i, 0)
         Next
      End With
End Sub

Private Sub MSFlexGrid1_DblClick()

      'Checkhaken setzen oder entfernen
      FlexCheckMark Picture1, MSFlexGrid1, 0
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Public Sub FlexCheckCreate(PicBoxH As PictureBox, PicBoxHBackColor As Long)
'einen Checkhaken zeichnen
   
   Dim x As Single
   Dim y As Single
   
      PicBoxH.AutoRedraw = True
      PicBoxH.BackColor = PicBoxHBackColor
      PicBoxH.BorderStyle = 0
      PicBoxH.Width = 240
      PicBoxH.Height = 240
      
      y = 180
      For x = 90 To 120 Step 15
         PicBoxH.Line (x, y)-(x - 60, y - 105), vbBlack
      Next
      For x = 90 To 120 Step 15
         PicBoxH.Line (x, y)-(x + 60, y - 150), vbBlack
      Next
End Sub

Public Sub FlexCheckMark(PicBoxH As PictureBox, Flex As MSFlexGrid, ColumnNumber As Long)
'einen CheckHaken setzen oder löschen

   Dim Col As Long
   Dim ColSel As Long
   
      With Flex
         .Redraw = False
         Col = .Col
         ColSel = .ColSel
         .Col = ColumnNumber
         If .CellPicture.Handle = 0 Then
            'nicht gesetzt, setzen
            Set .CellPicture = PicBoxH.Image
         Else
            'gesetzt, löschen
            Set .CellPicture = LoadPicture("")
         End If
         .Col = Col
         .ColSel = ColSel
         .Redraw = True
      End With
End Sub

Public Function FlexRowIsChecked(Flex As MSFlexGrid, Row As Long, Col As Long) As Boolean
'prüft bei Row/Col, ob ein Picture/Check gesetzt ist

   Dim xRow As Long
   Dim xCol As Long
   
      With Flex
         .Redraw = False
         'Save Koordinaten
         xRow = .Row
         xCol = .Col
        
         .Row = Row
         .Col = Col
         If .CellPicture.Handle <> 0 Then
            FlexRowIsChecked = True
         End If
         
         'Resave Koordinaten
         .Row = xRow
         .Col = xCol
         .Redraw = True
      End With
End Function

'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Option Explicit

'setzt oder entfernt einen Checkhaken in ein Flex Cell
Public Property Let FlexCellChecked(Flex As MSFlexGrid, Row As Long, _
                                    Col As Long, vData As Boolean)

   Dim SaveRow As Long, SaveCol As Long

      With Flex
         'neuzeichnen unterbinden
         .Redraw = False
         'aktuelle Position sichern
         SaveRow = .Row
         SaveCol = .Col

         .Row = Row
         .Col = .Col
         
         If vData Then
            'True
            .Text = "a"
         Else
            'False
            .Text = vbNullString
         End If

         'zurücksichern
         .Row = SaveRow
         .Col = SaveCol
         'neuzeichnen
         .Redraw = True
      End With
End Property

'liefert True/False ob eine Cell Checked ist
Public Property Get FlexCellChecked(Flex As MSFlexGrid, Row As Long, _
                                    Col As Long) As Boolean

   Dim SaveRow As Long, SaveCol As Long

      With Flex
         .Redraw = False
         SaveRow = .Row
         SaveCol = .Col

         .Row = Row
         .Col = .Col
         
         'Value ermitteln
         FlexCellChecked = (.Text = "a")

         .Row = SaveRow
         .Col = SaveCol
         .Redraw = True
      End With
End Property

Private Sub Command1_Click()

   Dim i As Long
   
      With MSFlexGrid1
         For i = .FixedRows To .Rows - 1
            .Row = i
            Debug.Print "Row " & i & " Checked: " & FlexCellChecked(MSFlexGrid1, i, 1)
         Next
      End With
End Sub

Private Sub Form_Load()

   Dim i As Long

      With MSFlexGrid1
         .Rows = 20
         .Cols = 5
         
         .Col = 1
         .ColAlignment(1) = flexAlignCenterCenter
         .ColWidth(1) = 450
         For i = 0 To .Rows - 1
            .Row = i
            .CellFontName = "Marlett"
            .CellFontSize = 12
            If i = 0 Then
               .Text = "a"
            End If
         Next
      End With
End Sub

Private Sub MSFlexGrid1_Click()

      With MSFlexGrid1
         If .Col = 1 Then
            FlexCellChecked(MSFlexGrid1, .Row, .Col) = _
            Not FlexCellChecked(MSFlexGrid1, .Row, .Col)
         End If
      End With
End Sub

Option Explicit

Private Sub Command1_Click()

   Dim i As Long
   
      With MSFlexGrid1
         .Col = 1
         For i = .FixedRows To .Rows - 1
            .Row = i
            Debug.Print "Row " & i & " Checked: " & FlexChecked(MSFlexGrid1)
         Next
      End With
End Sub

Private Sub Form_Load()

   Dim i As Long

      With MSFlexGrid1
         .Rows = 20
         .Cols = 5
         
         .Col = 1
         .ColAlignment(1) = flexAlignCenterCenter
         .ColWidth(1) = 450
         For i = 0 To .Rows - 1
            .Row = i
            .CellFontName = "Marlett"
            .CellFontSize = 12
            If i = 0 Then
               .Text = "a"
            End If
         Next
      End With
End Sub

Private Sub MSFlexGrid1_Click()

      With MSFlexGrid1
         If .Col = 1 Then
            If .Text = vbNullString Then
               .Text = "a"
            Else
               .Text = vbNullString
            End If
         End If
      End With
End Sub

'prüft ob aktive Cell Checked ist
Public Function FlexChecked(Flex As MSFlexGrid) As Boolean

      FlexChecked = (Flex.Text = "a")
End Function