Soyez le premier à donner votre avis sur cette source.
Snippet vu 7 361 fois - Téléchargée 20 fois
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
8 avril 2011 à 18:05
5 avril 2011 à 19:58
cela t'aurais eviter d'avoir des milles et des cent de picturebox, de le label ect..
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.