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 ?...
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.