Histogramme - suite - graphique de barres verticales pour une série de valeurs absolues

Commenter

Contenu du snippet

3e version : En utilisant seulement des PictBox et des Labels, on veut afficher l'Histogramme d'une série de valeurs absolues (depuis une datatable)

Source / Exemple : 


Public Class Form_Histogramme_absolu

    ' ===== CDC : Afficher un Histogramme Absolu (ou plusieurs dans la même Form) 
    '             considérant une valeur Max et une Echelle de valeurs
    '             utilisant seulement des Controles PictureBox et Labels 
    ' ===== VERSION 3 = Histogramme via une DataTable (ou plusieurs)

    Private P As PictureBox
    Private L As Label
    ' la dernière color est destinée au fond du graphique a défaut, il sera White.
    Private arrColor() As Color = {Color.Tomato, Color.DarkSeaGreen, Color.CornflowerBlue, _
                                   Color.Orchid, Color.OliveDrab, Color.SlateBlue, Color.Goldenrod, Color.Tan}
    ' ces 2 arrays juste pour remplir la dataTable :
    Private array1902() As Integer = {106, 25, 500, 287, 8, 325, 35}
    Private array1903() As Integer = {61, 5, 35, 241, 0, 165, 15}
    Private arrayNom() As String = {"Dijon", "Nantes", "Nice", "Paris", "Lyon", "Cherbourg", "Pau"}
    Private maTable1902 As New DataTable, matable1903 As New DataTable

    ' ===== On veut afficher 2 Histogrammes en Valeurs absolues :
    Private Sub Form1_Load(ByVal s As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Charger_Table(maTable1902, array1902, arrayNom)
        Charger_Table(matable1903, array1903, arrayNom)
        Dim marge As Integer = _
        Histo_Absolu("Consommation Cornichons 1902", maTable1902, "tonnes", 500, 75, arrColor, 40, 40, 400, 40)
        marge = Histo_Absolu("Consommation Cornichons 1903", matable1903, "tonnes", 300, 100, arrColor, 40, marge, 400, 40)
        Width = marge
        Height = 550
    End Sub

    ' ===== Histogramme à Barres Verticales avec des Valeurs Absolues :
    Private Function Histo_Absolu(ByVal _titre As String, ByVal _table As DataTable, ByVal _unite As String, _
                                  ByVal _max As Integer, ByVal _echelle As Integer, ByVal _colors As Array, _
                                  ByVal _top As Integer, ByVal _left As Integer, ByVal _hauteur As Integer, _
                                  ByVal _largeurBarre As Integer, Optional ByVal _interval As Integer = 0) _
                                  As Integer

        Dim nbBarres As Integer = _table.Rows.Count
        If nbBarres = 0 Then MsgBox(_titre & vbCr & "La série est vide", 16, "Erreur") : Return _left
        If _echelle > _max Then
            MsgBox(_titre & vbCr & "L'Echelle est incohérente : " & _echelle, 16, "Erreur") : Return _left
        End If
        Dim maFontTexte As New Font("Verdana", 9)
        Dim maFontVal As New Font("Verdana", 8, FontStyle.Bold)
        Dim maFontEchelle As New Font("Verdana", 7)
        Dim graph_Largeur As Integer = (nbBarres * _largeurBarre) + ((nbBarres - 1) * _interval)
        Dim cpt_Left As Integer = IIf(_left < 10, 20, _left)
        Dim cpt_Bas As Integer = IIf(_top < 10, 10, _top) + IIf(_hauteur < 20, 20, _hauteur)
        Dim lbl_Hauteur As Integer = maFontVal.GetHeight
        Dim maVal, ctl_Top, cpt_Hauteur, margeGauche, margeDroite As Integer
        Dim monTxt As String

        ' Les éléments de Gauche à Droite = échelle, graphique, étiquettes :

        ' ----- 1) l'Echelle et ses niveaux :
        If _echelle Then
            ' ouaip, Max peut ne pas être un multiple de Echelle (division entière) :
            Dim nbEchelons As Integer = _max \ _echelle                 ' nb d'échelons 
            Dim interEchelon As Integer = _echelle * _hauteur / _max    ' gap entre 2 échelons
            margeGauche = _max.ToString.Length * 10
            For i As Integer = 0 To nbEchelons
                ctl_Top = _top + _hauteur - (interEchelon * i) - (lbl_Hauteur / 2)
                ' le Label dans la marge Gauche :
                L = New Label With {.Top = ctl_Top - (lbl_Hauteur / 2), .Left = _left, .Width = margeGauche, _
                                    .Text = (_echelle * i).ToString, .Font = maFontEchelle, _
                                    .TextAlign = ContentAlignment.MiddleRight, .BackColor = BackColor}
                Controls.Add(L)
                ' les lignes de niveaux :
                ctl_Top = _top + _hauteur - (interEchelon * i) - 1
                P = New PictureBox With {.Top = ctl_Top, .Left = _left + margeGauche, .Width = graph_Largeur, _
                                         .Height = 1, .BackColor = Color.Wheat}
                Controls.Add(P)
            Next
        End If

        ' ----- 2) la Série de Barres :
        Dim maBColor, maFColor, maGColor As Color ' couleurs de Barre, Font, Graphe
        If _colors.Length > nbBarres Then
            maGColor = _colors(nbBarres)
        Else
            maGColor = Color.White
        End If
        cpt_Left = _left + margeGauche
        With _table
            For i As Integer = 0 To nbBarres - 1
                monTxt = .Rows(i).Item(0) : If monTxt.Length < 1 Then monTxt = "n/c"
                maVal = .Rows(i).Item(1)
                If maVal > _max Then
                    MsgBox(_titre & vbCr & "La valeur Max/Valeur est incohérente : " & _max & " / " & maVal, 16, "Erreur")
                    Return _left
                End If
                cpt_Hauteur = _hauteur / _max * .Rows(i).Item(1)
                ctl_Top = _top + _hauteur - cpt_Hauteur
                P = New PictureBox With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, _
                                         .Height = cpt_Hauteur, .BackColor = _colors(i), .Cursor = Cursors.Hand}

                ' ----- 3) les Valeurs au sommet de la barre sauf barre < hauteur de la police :
                If maVal < maFontVal.GetHeight Then
                    ctl_Top = P.Top - maFontVal.GetHeight
                    maFColor = Color.Black ' ou colors(i)  
                    maBColor = maGColor
                Else
                    ctl_Top = P.Top
                    maFColor = Color.White ' ou maGColor
                    maBColor = _colors(i)
                End If
                L = New Label With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, .BackColor = maBColor, _
                                    .ForeColor = maFColor, .Text = maVal.ToString, .TextAlign = ContentAlignment.TopCenter, _
                                    .FlatStyle = FlatStyle.System, .Font = maFontVal, .Height = lbl_Hauteur, _
                                    .Cursor = Cursors.Hand}
                Controls.Add(P) : Controls.Add(L)
                L.BringToFront()
                monTxt = String.Format(" {0} {1} {2} ", monTxt, maVal, _unite)
                ttip.SetToolTip(P, monTxt)
                ttip.SetToolTip(L, monTxt)
                cpt_Left += _largeurBarre + _interval
            Next

            ' ----- 4) le Titre sous le graphe :
            L = New Label With {.Text = _titre, .Font = maFontTexte, .Left = _left + margeGauche, .Top = _top + _hauteur + 5, _
                                .TextAlign = ContentAlignment.MiddleLeft, .FlatStyle = FlatStyle.System, .AutoSize = True}
            Controls.Add(L)

            ' ----- 5) la Légende (nuancier + étiquettes )  :
            lbl_Hauteur = maFontEchelle.GetHeight * 1.5
            cpt_Left += 5 - _interval
            For i As Integer = nbBarres - 1 To 0 Step -1
                monTxt = .Rows(i).Item(0) : maVal = .Rows(i).Item(1)
                P = New PictureBox With {.Top = cpt_Bas - 10, .Left = cpt_Left, .Width = 10, .Height = 10, _
                                         .BackColor = _colors(i), .Cursor = Cursors.Hand}
                L = New Label With {.Top = cpt_Bas - 12, .Left = cpt_Left + 10, .Text = monTxt, .AutoSize = True, _
                                         .Cursor = Cursors.Hand}
                If L.Width > margeDroite Then margeDroite = L.Width
                cpt_Bas -= lbl_Hauteur - 4
                monTxt = String.Format(" {0} {1} {2} ", monTxt, maVal, _unite)
                ttip.SetToolTip(P, monTxt) : ttip.SetToolTip(L, monTxt)
                Controls.Add(P) : Controls.Add(L)
            Next
        End With

        ' ----- 6) le Cadre du graphique :
        P = New PictureBox With {.Top = _top, .Left = _left + margeGauche, .Width = graph_Largeur, _
                                 .BackColor = maGColor, .Height = _hauteur}
        Controls.Add(P)
        P.SendToBack()

        Return _left + margeGauche + graph_Largeur + margeDroite
    End Function

    ' ===== Charger les tables (idem from RecordSet) :
    Private Function Charger_Table(ByVal _table As DataTable, ByVal _Val As Array, ByVal _Leg As Array) As Boolean
        Dim R As DataRow  ' on suppose ici que les arrays son cohérents en taille !
        With _table
            .Columns.Add() : .Columns.Add()
            For i As Integer = 0 To UBound(_Val)
                R = .NewRow
                R(0) = _Leg(i) : R(1) = _Val(i)
                .Rows.Add(R)
            Next
        End With
        Return _table.Rows.Count
    End Function
    ' ===== TCHCONST jan 2011 =====
End Class

Conclusion :


Pas + de mystère que précédemment, juste un peu plus de moulinettes arithmétiques. Merci pour les commentaires, une prochaine version en UserControl ?...

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 (tchconst)