Soyez le premier à donner votre avis sur cette source.
Vue 13 783 fois - Téléchargée 1 703 fois
'**************************************************************************************** '*** *** '*** 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
5 juil. 2010 à 15:25
Dans ce cas, il me resterait à intégrer l'impression qui devrait en tenir compte.
également, tenir en compte la "navigation" à l'aide des flêches du clavier.
Les cellules "fusionnées" n'étant pas réellemnt des cellules du DATAGrid, le défilement passe derrière le label qui masque les dites cellules.
Peut-être en ajoutant des objets dans le champs "Tag" des cellules on pourrait activer en mode édition le label...
A tester...
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.