Fusion de cellules dans un datagridview

Télécharger le projet
Commenter

Description

Tout est dans la class du Form.
La structure IntercalaireCollection permet de fusionner les celles sur toute une ligne.
La structure MergedCellsCollection permet de fusionner les cellules sur n colonnes et n lignes.

Source / Exemple : 


'****************************************************************************************
'***                                                                                  ***  
'*** Fusion de cellules sur un DataGridView                                           ***
'*** par l'ajout de LABELS en surchargeant la fonction PAINT de la GridView           ***
'*** Il suffit de remplir les structures "intercal" et ou "cellulesFusionnees"        ***
'*** dans le form_load                                                                ***
'***                                                                                  ***  
'*** Pascal Mauran - Le 30/06/2010                                                    ***
'****************************************************************************************

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms

Public Class Form1
    Inherits Form

    Public CENTRE = 1
    Public GAUCHE = 2
    Public DROITE = 3

    Private cellulesFusionnees As MergedCellsCollection
    Private intercal As IntercalaireCollection

    '**********************************************************************************
    '***                       Structures des intercalaires                         ***
    '**********************************************************************************
    Private Structure Intercalaire

        Dim y As Integer
        Dim valeur As String

        Dim lblIntercalaire As Label

    End Structure

    Private Structure IntercalaireCollection

        Dim nbIntercalaire As Integer
        Dim pI() As Intercalaire

    End Structure

    '**********************************************************************************
    '***                  Structures de cellules fusionnées                         ***
    '**********************************************************************************
    Private Structure MergedCells

        Dim nbCells As Integer
        Dim x1 As Integer
        Dim x2 As Integer
        Dim y1 As Integer
        Dim y2 As Integer
        Dim valeur As String

        Dim lblMerge As Label

    End Structure

    Private Structure MergedCellsCollection

        Dim nbMergedCells As Integer
        Dim pMC() As MergedCells

    End Structure

    '**********************************************************************************
    '***                  Fonctions des cellules fusionnées                         ***
    '**********************************************************************************
    Public Sub AddMergedCell(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, ByVal valeur As String)

        With cellulesFusionnees
            .nbMergedCells = .nbMergedCells + 1

            ReDim Preserve .pMC(0 To .nbMergedCells)

            .pMC(.nbMergedCells).x1 = x1
            .pMC(.nbMergedCells).x2 = x2
            .pMC(.nbMergedCells).y1 = y1
            .pMC(.nbMergedCells).y2 = y2
            .pMC(.nbMergedCells).valeur = valeur

            .pMC(.nbMergedCells).lblMerge = New Label
            .pMC(.nbMergedCells).lblMerge.AutoSize = False
            .pMC(.nbMergedCells).lblMerge.Visible = True
            .pMC(.nbMergedCells).lblMerge.Enabled = True

            Me.Controls().Add(.pMC(.nbMergedCells).lblMerge)

        End With

    End Sub

    Public Sub SetMergedColorAndAlignement(ByVal numMergeCell As Integer, ByVal couleurFond As Color, ByVal couleurEncre As Color, Optional ByVal alignement As Integer = 1)

        cellulesFusionnees.pMC(numMergeCell).lblMerge.BackColor = couleurFond
        cellulesFusionnees.pMC(numMergeCell).lblMerge.ForeColor = couleurEncre

        If alignement = CENTRE Then
            cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleCenter
        ElseIf alignement = GAUCHE Then
            cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleLeft
        Else
            cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleRight
        End If

    End Sub

    Public Sub SetMergedPolice(ByVal numMergeCell As Integer, ByVal nom As String, Optional ByVal taille As Integer = 12, Optional ByVal gras As Boolean = True)
        Dim f As Font

        If gras = True Then
            f = New Font(nom, taille, FontStyle.Bold, GraphicsUnit.Point)
        Else
            f = New Font(nom, taille, FontStyle.Regular, GraphicsUnit.Point)
        End If
        cellulesFusionnees.pMC(numMergeCell).lblMerge.Font = f
    End Sub

    '**********************************************************************************
    '***                       Fonctions des intercalaires                          ***
    '**********************************************************************************
    Public Sub AddIntercalaire(ByVal y As Integer, ByVal valeur As String)

        With intercal
            .nbIntercalaire = .nbIntercalaire + 1

            ReDim Preserve .pI(0 To .nbIntercalaire)

            .pI(.nbIntercalaire).y = y
            .pI(.nbIntercalaire).valeur = valeur

            .pI(.nbIntercalaire).lblIntercalaire = New Label
            .pI(.nbIntercalaire).lblIntercalaire.AutoSize = False
            .pI(.nbIntercalaire).lblIntercalaire.Visible = True
            .pI(.nbIntercalaire).lblIntercalaire.Enabled = True
            Me.Controls().Add(.pI(.nbIntercalaire).lblIntercalaire)

        End With

    End Sub

    Public Sub SetIntercalaireColorAndAlignement(ByVal numIntercalaire As Integer, ByVal couleurFond As Color, ByVal couleurEncre As Color, Optional ByVal alignement As Integer = 1)

        intercal.pI(numIntercalaire).lblIntercalaire.BackColor = couleurFond
        intercal.pI(numIntercalaire).lblIntercalaire.ForeColor = couleurEncre

        If alignement = CENTRE Then
            intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleCenter
        ElseIf alignement = GAUCHE Then
            intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleLeft
        Else
            intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleRight
        End If

    End Sub

    Public Sub SetIntercalairePolice(ByVal numIntercalaire As Integer, ByVal nom As String, Optional ByVal taille As Integer = 12, Optional ByVal gras As Boolean = True)
        Dim f As Font

        If gras = True Then
            f = New Font(nom, taille, FontStyle.Bold, GraphicsUnit.Point)
        Else
            f = New Font(nom, taille, FontStyle.Regular, GraphicsUnit.Point)
        End If
        intercal.pI(numIntercalaire).lblIntercalaire.Font = f
    End Sub

    
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim stMerge As New DataGridViewCellStyle
        Dim stC1 As New DataGridViewCellStyle
        Dim stM As New DataGridViewCellStyle
        Dim fo As New Font("Arial", 10, FontStyle.Bold, GraphicsUnit.Point)
        Me.Visible = True

        cellulesFusionnees.nbMergedCells = -1

        AddMergedCell(2, 4, 5, 5, "Test")
        SetMergedColorAndAlignement(0, Color.Black, Color.BurlyWood, CENTRE)
        SetMergedPolice(0, "System", 12, True)

        AddMergedCell(3, 9, 5, 11, "TEST CELLULES FUSIONNÉES texttexttexttexttexttexttext")
        SetMergedColorAndAlignement(1, Color.Bisque, Color.Blue, GAUCHE)
        SetMergedPolice(0, "Arial", 14, False)

        intercal.nbIntercalaire = -1

        AddIntercalaire(0, "GENERALITES")
        SetIntercalairePolice(0, "Arial", 8, True)
        SetIntercalaireColorAndAlignement(0, Color.Red, Color.White)

        AddIntercalaire(7, "CONDITIONNEUSE")
        SetIntercalairePolice(1, "Arial", 16, True)
        SetIntercalaireColorAndAlignement(1, Color.Green, Color.White)

        Grd.SendToBack()

        Dim row1 As String() = {"A1", "Fermeture ligne"}
        Dim row2 As String() = {"A1", "Ferié"}
        Dim row3 As String() = {"A1", "Arrêt plannifié usine"}
        Dim row4 As String() = {"A1", "Réunion"}
        Dim row5 As String() = {"A1", "Preventif"}
        Dim row6 As String() = {"A31", "NEP Long"}
        Dim row7 As String() = {"G10", "Changement"}

        '*** Police ***
        stC1.BackColor = Color.Blue
        stC1.ForeColor = Color.White
        stC1.Font = New Font("Arial", 12, FontStyle.Bold, GraphicsUnit.Point)

        Grd.ColumnCount = 10

        Grd.Rows.Add("")
        Grd.Rows.Add(row1)
        Grd.Rows.Add(row2)
        Grd.Rows.Add(row3)
        Grd.Rows.Add(row4)
        Grd.Rows.Add(row5)
        Grd.Rows.Add(row6)
        Grd.Rows.Add(row7)
        Grd.RowCount = 20
        
        For i = 0 To Grd.Rows.Count - 1
            Grd.Rows(i).Cells(0).Style = stC1
            Grd.Rows(i).Cells(1).Style = stC1
        Next i

        '*** Police ***
        stM.BackColor = Color.Aquamarine
        stM.ForeColor = Color.Black
        stM.Font = New Font("Arial", 22, FontStyle.Bold, GraphicsUnit.Point)
        stM.Alignment = DataGridViewContentAlignment.MiddleCenter

        Grd.Columns(1).Frozen = True
        Grd.Columns(1).MinimumWidth = 50

        Grd.RowHeadersVisible = False
        Grd.ColumnHeadersVisible = True

        Grd.Columns(0).ReadOnly = True
        Grd.Columns(1).ReadOnly = True

        Grd.Columns(0).HeaderText = "Code arrêt"
        Grd.Columns(1).HeaderText = "Libellé arrêt"

        For i = 2 To Grd.Columns.Count - 1
            Grd.Columns(i).HeaderText = Str(i) & "h00"
            Grd.Columns(i).HeaderCell.Style = stM
        Next

        Grd.Columns(0).SortMode = DataGridViewColumnSortMode.NotSortable
        Grd.Columns(1).SortMode = DataGridViewColumnSortMode.NotSortable

        Me.Refresh()

    End Sub

    Private Sub Grd_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Grd.Paint
        Dim x, y As Integer
        Dim i As Integer
        Dim scrollBarSize As Integer
        Dim rec As System.Drawing.Rectangle
        Dim rec1 As System.Drawing.Rectangle
        Dim rec2 As System.Drawing.Rectangle
        Dim x1, x2, y1, y2, d As Integer

        scrollBarSize = 17

        '*********************************************
        '*** Traitement des lignes 'Intercalaires' ***
        '*********************************************
        For i = 0 To intercal.nbIntercalaire
            intercal.pI(i).lblIntercalaire.Visible = False
            If Grd.Rows(intercal.pI(i).y).Displayed = True Then
                intercal.pI(i).lblIntercalaire.Visible = True
                If Grd.Rows(intercal.pI(i).y).Visible = True Then
                    Grd.Rows(intercal.pI(i).y).Height = intercal.pI(i).lblIntercalaire.Font.Size + 10
                    rec = Grd.GetRowDisplayRectangle(intercal.pI(i).y, True)

                    intercal.pI(i).lblIntercalaire.Top = rec.Top + Grd.Top
                    intercal.pI(i).lblIntercalaire.Left = rec.Left + Grd.Left
                    intercal.pI(i).lblIntercalaire.Width = rec.Width
                    intercal.pI(i).lblIntercalaire.Height = rec.Height
                    intercal.pI(i).lblIntercalaire.Text = intercal.pI(i).valeur
                Else
                    intercal.pI(i).lblIntercalaire.Visible = False
                End If
            End If
        Next

        '******************************************
        '*** Traitement des cellules fusionnées ***
        '******************************************
        For i = 0 To cellulesFusionnees.nbMergedCells
            With cellulesFusionnees.pMC(i)
                .lblMerge.Visible = False
                '*** Recherche de la première et la dernière cellule visible ***
                For x = .x1 To .x2
                    If Grd.Columns(x).Displayed = True Then
                        x1 = x
                        x = .x2 + 1
                    End If
                Next
                For y = .y1 To .y2
                    If Grd.Rows(y).Displayed = True Then
                        y1 = y
                        y = .y2 + 1
                    End If
                Next
                For x = .x2 To .x1 Step -1
                    If Grd.Columns(x).Displayed = True Then
                        x2 = x
                        x = .x1 - 1
                    End If
                Next
                For y = .y2 To .y1 Step -1
                    If Grd.Rows(y).Displayed = True Then
                        y2 = y
                        y = .y1 - 1
                    End If
                Next

                '*** Définition de Abscisses, Ordonnées, Hauteur et Largeur du Label ***
                rec1 = Grd.GetCellDisplayRectangle(x1, y1, True)
                rec2 = Grd.GetCellDisplayRectangle(x2, y2, True)
                d = 0
                'Redimensionnement en cas de colonne à cheval sur le bord du GridControl
                If x2 < .x2 Then
                    d = Grd.Width - scrollBarSize - rec2.X
                End If
                rec = Grd.GetCellDisplayRectangle(x2 + 1, y2, True)

                'Redimensionnement en cas de ligne à cheval sur le bord du GridControl
                If rec1.Top + Grd.Top + rec2.Top - rec1.Top + rec1.Height > Grd.Top + Grd.Height - scrollBarSize Then
                    .lblMerge.Height = rec2.Top - rec1.Top + rec1.Height - scrollBarSize
                Else
                    .lblMerge.Height = rec2.Top - rec1.Top + rec2.Height
                End If

                'Application de nouveaux parametres au Label
                .lblMerge.Top = rec1.Top + Grd.Top
                .lblMerge.Left = rec1.Left + Grd.Left
                .lblMerge.Width = rec2.Left - rec1.Left + d
                .lblMerge.Text = cellulesFusionnees.pMC(i).valeur
                If x1 + x2 > 0 Then
                    .lblMerge.Visible = True
                End If
            End With

        Next i

    End Sub

End Class
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (pascamau)