MSHFLEXGRID : GRILLE DE DONNÉES UTILISABLE DANS VB6

MSHFlexGrid : grille de données sous VB6
--> ici la MSHFlexGrid a été nommée Grille ( tout simplement )

1) Fonction à utiliser pour la mise à jour de la grille

    ' Cette fonction permet de traiter les données plus facilement
    Function faIndex(row As Integer, col As Integer) As Long
        faIndex = row * Grille.Cols + col
    End Function

2) Gestion de l’apparence d’une Grille de 21 lignes et 5 colonnes :

    ' Largeur de la Grille
    Grille.Width = 4120
    '’ Largeur des colonnes de la Grille ( ici la Grille comporte 5 colonnes )
    Grille.ColWidth(0) = 500
    Grille.ColWidth(1) = 1400
    Grille.ColWidth(2) = 1400
    Grille.ColWidth(3) = 500
    Grille.ColWidth(4) = 0
    ' Numéros de lignes de la Grille ( ici la Grille comporte 21 lignes )
    For X = 1 To 20
        Grille.row = X
        Grille.col = 0
        Grille.CellAlignment = flexAlignRightTop
        Grille.TextArray(faIndex(Grille.row, Grille.col)) = X
    Next X
    ' Indique les titres de la Grille
    Grille.row = 0
    Grille.col = 0
    Grille.CellAlignment = flexAlignCenterTop
    Grille.TextArray(faIndex(Grille.row, Grille.col)) = "Ligne"
    Grille.row = 0
    Grille.col = 1
    Grille.CellAlignment = flexAlignCenterTop
    Grille.TextArray(faIndex(Grille.row, Grille.col)) = "Champs table"
    Grille.row = 0
    Grille.col = 2
    Grille.CellAlignment = flexAlignCenterTop
    Grille.TextArray(faIndex(Grille.row, Grille.col)) = "Variables"
    Grille.row = 0
    Grille.col = 3
    Grille.CellAlignment = flexAlignCenterTop
    Grille.TextArray(faIndex(Grille.row, Grille.col)) = "N-S"

    ' Apparence de départ de la grille
    Grille.Enabled = False ' ou True si on veut qu’elle soit active à l'ouverture
    ' Voir QbColor pour les codes de couleur
    Grille.BackColorBkg = QBColor(8)    ' 8 = Couleur grise
    Grille.BackColorFixed = QBColor(8)  ' 8 = Couleur grise
    Grille.BackColorSel = QBColor(8)    ' 8 = Couleur grise

    ' Supprime la sélection par colonne ou par ligne
    Grille.AllowBigSelection = False

3) Mise à jour des données dans la grille ( à placer sur l'évènement KeyPress ) :

    Private Sub Grille_KeyPress(KeyAscii As Integer)
        Dim C As Integer, R As Integer
        ' Désactive le clignotement du contrôle
        Grille.Redraw = False
        ' Repère la cellule active
        R = Grille.RowSel
        C = Grille.ColSel
        ' Valide la saisie au clavier
        If KeyAscii = 27 Then
           Grille.TextArray(faIndex(R, C)) = ""
       ElseIf Grille.TextArray(faIndex(R, C)) <> "" And KeyAscii = 8 Then
           Grille.TextArray(faIndex(R, C)) = Mid(Grille.TextArray(faIndex(R, C)), 1, Len(Grille.TextArray(faIndex(R, C))) - 1)
       ElseIf Grille.TextArray(faIndex(R, C)) <> "" And KeyAscii = 13 Then
           Grille.TextArray(faIndex(R, C)) = Grille.TextArray(faIndex(R, C)) & Chr(10) & Chr(KeyAscii)
       Else
           Grille.TextArray(faIndex(R, C)) = Grille.TextArray(faIndex(R, C)) & Chr(KeyAscii)
       End If
       ' Replace le clignotement du contrôle
       Grille.Redraw = True
   End Sub

   ' Une autre méthode... :

      Dim strTexte
      strTexte = MSFlexGrid1.Text
      If KeyAscii = 8 Then 
          'Touche d’effacement
          If Len(strTexte) > 0 Then MSFlexGrid1.Text = Left(strTexte, Len(strTexte) - 1) 
      ElseIf KeyAscii <> 13 Then
          MSFlexGrid1.Text = strTexte & Chr(KeyAscii)
      End If

4) Repérer la cellule active dans la grille :

    Private Sub Grille_EnterCell()
        Dim iRow, iCol As Integer
        ' Coordonnées de la cellule active
        iRow = Grille.row
        iCol = Grille.col
        ' Réinitialise les cellules ( fond blanc )
        For X = 1 To 20
            For Y = 1 To 4
                Grille.row = X
                Grille.col = Y
                Grille.CellBackColor = QBColor(15) ' Couleur blanche
            Next Y
        Next X
        ' Repérage de la cellule active ( fond jaune )
        Grille.row = iRow
        Grille.col = iCol
        Grille.FocusRect = flexFocusHeavy ' Double trait autour de le cellule active
        'Grille.FocusRect = flexFocusLight ' Simple trait autour de le cellule active
        Grille.CellBackColor = QBColor(14) ' Couleur jaune
    End Sub

    ' Réinitialise les cellules de la grille lorsqu'on passe à un autre contrôle
    Private Sub Grille_LostFocus()
        ' Réinitialise les cellules ( fond blanc )
        For X = 1 To 20
            For Y = 1 To 4
                Grille.row = X
                Grille.col = Y
                Grille.CellBackColor = QBColor(15) ' Couleur blanche
            Next Y
        Next X
    End Sub

5) N'autoriser la sélection que d'une seule ligne dans une MSFlexgrid :

    Private Sub MSFlexGrid1_SelChange()
        MSFlexGrid1.RowSel = MSFlexGrid1.Row
    End Sub

6) Modifier la largeur des colonnes d'une MSFlexgrid en fonction de la longueur du texte :

Copiez ce code dans un module standard :

    Private Type Size
        cx As Long
        cy As Long
    End Type

    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
        (ByVal hdc As Long, ByVal lpsz As String, _
        ByVal cbString As Long, lpSize As Size) As Long

    Public Sub ResizeColumns(hdc As Long, flexgrid As MSFlexGrid)
        Dim idxRow As Long, idxCol As Long, lngMax As Long
        Dim texte As String, taille As Size
        With flexgrid
            ' Parcoure les colonnes
            For idxCol = 0 To .Cols - 1
                lngMax = 0
                ' Parcoure les lignes
                For idxRow = 0 To .Rows - 1
                    texte = .TextMatrix(idxRow, idxCol)
                    ' Met la taille du texte de la cellule en pixels dans taille
                    GetTextExtentPoint32 hdc, texte, Len(texte), taille
                    ' lngMax est la longueur du texte le plus long dans cette colonne
                    If taille.cx > lngMax Then lngMax = taille.cx
                Next
                ' Met lngMax en twips en ajoutant 10 pixels pour les marges
                If lngMax > 0 Then lngMax = (lngMax + 10) * Screen.TwipsPerPixelX
                ' Applique la largeur de colonne si besoin
                If lngMax > .ColWidth(idxCol) Then .ColWidth(idxCol) = lngMax
            Next
        End With
    End Sub

Voici comment appeler la procédure ResizeColumns :

    vb ResizeColumns Me.hdc, MSFlexGrid1

La procédure attend un contexte de périphérique en premier paramètre. Le contexte de périphérique est renvoyé par la propriété hdc. Si la form et la MSFlexGrid ont la même police, vous pouvez passer le contexte de périphérique de la form. Sinon vous pouvez ajouter un PictureBox invisible qui aura la même police que celle de la MSFlexgrid et passer sa propriété hdc en premier paramètre. 

7) Exporter le contenu d'une msflexgrid dans un fichier : 

Cette fonction exporte le contenu de la msflexgrid passée en paramètre dans le fichier strFileName. 
Les colonnes sont séparées par le caractère passé dans le troisième paramètre.

    Public Function ExportGridToFile(Mygrid As MSFlexGrid, Byval strFileName as string, _
        Optional ByVal strSep As String = vbTab) As Boolean
        Dim intFreeFile As Integer               ' Numéro du fichier
        Dim intCol As Integer, intRow As Integer ' Indices de ligne et colonne de W
        Dim ligne As String                      ' La ligne à écrire dans le fichier
        ' Gestion des éventuelles erreurs
        On Error GoTo ExportGridToFile_ERR
        ' Prend le prochain numéro de fichier
        intFreeFile = FreeFile
        ' Ouvre le fichier en bloquant son accès aux autres applications
        Open strFileName For Output Access Write Lock Read Write As #intFreeFile
        With Mygrid
            ' Pour chaque ligne
            For intRow = .FixedRows To .Rows - 1
                ligne = ""
                ' Pour chaque colonne
                For intCol = .FixedCols To .Cols - 1
                    ' Ajoute la valeur de la cellule
                    ligne = ligne & .TextMatrix(intRow, intCol) & strSep
                Next intCol
                ' Enlève le séparateur final
                If strSep <> "" Then ligne = Left(ligne, Len(ligne) - 1)
                Print #intFreeFile, ligne
            Next intRow
        End With
        ' Valide le bon fonctionnement de la fonction
        ExportGridToFile = True

        ExportGridToFile_FIN:
            Close #intFreeFile + 1
            Exit Function

        ExportGridToFile_ERR:
            ExportGridToFile = False
            Resume ExportGridToFile_FIN
    End Function
 
8) Constantes pour CellAlignment ( propriété de MSHFlexGrid ) :

Constante          Valeur      Description
-------------------------------------------------------------------------------- 
flexAlignLeftTop      0   Le contenu de la cellule est aligné à gauche, en haut. 

flexAlignLeftCenter   1   Le contenu de la cellule est aligné à gauche, au centre. 
                          Il s’agit de la valeur par défaut pour les chaînes. 

flexAlignLeftBottom   2   Le contenu de la cellule est aligné à gauche, en bas. 

flexAlignCenterTop    3   Le contenu de la cellule est centré, en haut. 

flexAlignCenterCenter 4   Le contenu de la cellule est centré, au centre. 

flexAlignCenterBottom 5   Le contenu de la cellule est centré, en bas. 

flexAlignRightTop     6   Le contenu de la cellule est aligné à droite, en haut. 

flexAlignRightCenter  7   Le contenu de la cellule est aligné à droite, au centre. 
                          Il s’agit de la valeur par défaut pour les chiffres. 

flexAlignRightBottom  8   Le contenu de la cellule est aligné à droite, en bas. 

flexAlignGeneral      9   Le contenu de la cellule est aligné de manière courante. 
                          Il s’agit de « à gauche, au centre » pour les chaînes et « à droite, 
                          au centre » pour les chiffres.