Soyez le premier à donner votre avis sur cette source.
Snippet vu 6 413 fois - Téléchargée 19 fois
Public Class Form_Histogramme_Array ' ===== CDC : Afficher un Histogramme % (ou plusieurs dans la même Form) ' indépendant des Données, paramétrable en position / dimensions / marges / couleurs etc. ' utilisant seulement des Controles PictureBox et Labels ' ===== VERSION 1 = Histogramme(s) % via un Array Private P As PictureBox Private L As Label Private arrColor() As Color = {Color.Tomato, Color.DarkSeaGreen, Color.CornflowerBlue, _ Color.Orchid, Color.OliveDrab, Color.SlateBlue, Color.Goldenrod} Private arrayNavets() As Integer = {16, 85, 0, 76, 18, 100, 53} Private arrayCornichons() As Integer = {6, 25, 36, 87, 8, 25, 35} Private arrayPersil() As Integer = {76, 5, 63, 57, 2, 95, 50} Private arrayNom() As String = {"Dijon", "Nantes", "Nice", "Paris", "Lyon", "Cherbourg", "Pau"} Private maFont As New Font("Verdana", 9) Private maFontBold As New Font("Verdana", 8, FontStyle.Bold) ' ===== On veut afficher plusieurs Histogrammes % (ici des arrays, cf. version avec Table de RecordSet) : Private Sub Form1_Load(ByVal s As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim marge As Integer = 20 Dim cpt_Right As Integer = _ Histo_PourCent("% Navets / Récolte Locale 1902", arrayNavets, arrayNom, marge, 40, 300, 30, 10) cpt_Right = _ Histo_PourCent("% Radis / Récolte Locale 1902", arrayCornichons, arrayNom, marge, cpt_Right + marge, 300, 20) cpt_Right = _ Histo_PourCent("% Persil / Récolte Locale 1902", arrayPersil, arrayNom, marge, cpt_Right + marge, 200, 30) ' etc Width = cpt_Right + marge End Sub ' ===== Histogramme à Barres Verticales pour 100 : Private Function Histo_PourCent(ByVal _titre As String, ByVal _valeurs() As Integer, ByVal _legende() As String, _ 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 = _valeurs.Length : If nbBarres < 0 Then Return 0 If nbBarres > _legende.Length Then Return 0 Dim ctl_Largeur As Integer = (nbBarres * _largeurBarre) + ((nbBarres - 1) * _interval) Dim cpt_Left As Integer = IIf(_left < 10, 10, _left) ' compteur Dim ctl_Bas As Integer = IIf(_top < 10, 10, _top) + IIf(_hauteur < 20, 20, _hauteur) Dim ctl_Top As Integer = 0 Dim cpt_Hauteur As Integer = 0 ' compteur Dim lbl_Hauteur As Integer = maFont.Size / maFont.FontFamily.GetCellAscent(0) * maFont.FontFamily.GetEmHeight(0) * 1.8 Dim lbl_Largeur As Integer = 0 ' ----- Barres : Dim maBColor, maFColor As Color For i As Integer = 0 To nbBarres - 1 If _valeurs(i) > 100 Then _valeurs(i) = 100 If _valeurs(i) < 0 Then _valeurs(i) = 0 cpt_Hauteur = _hauteur / 100 * _valeurs(i) ctl_Top = _top + _hauteur - cpt_Hauteur If _valeurs(i) <= 2 Then ctl_Top -= 1 ' on triche juste ce qu'il faut, c'est pour capter le ToolTip ! cpt_Hauteur += 1 End If P = New PictureBox With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, _ .Height = cpt_Hauteur, .BackColor = arrColor(i)} ttip.SetToolTip(P, " " & _legende(i) & " " & _valeurs(i) & " % ") Controls.Add(P) ' ----- Valeurs : If _valeurs(i) > 50 Then ctl_Top = P.Top maBColor = arrColor(i) maFColor = Color.Wheat ElseIf _valeurs(i) < 5 Then ctl_Top = P.Top - 20 maBColor = Color.Tan maFColor = Color.Black Else ctl_Top = P.Top - 15 maBColor = Color.Tan maFColor = Color.Black End If L = New Label With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, .BackColor = maBColor, _ .ForeColor = maFColor, .Text = _valeurs(i), .TextAlign = ContentAlignment.TopCenter, _ .FlatStyle = FlatStyle.System, .Font = maFontBold, .Height = 12} Controls.Add(L) L.BringToFront() cpt_Left += _largeurBarre + _interval Next ' ----- Barre des 50% : P = New PictureBox With {.Top = _top + (_hauteur / 2), .Left = _left, .Width = ctl_Largeur, _ .Height = 1, .BackColor = Color.DarkMagenta} Controls.Add(P) ' ----- Titre sous le graphe : L = New Label With {.Text = _titre, .Font = maFont, .Left = _left, .Top = _top + _hauteur + 5, _ .TextAlign = ContentAlignment.MiddleLeft, .FlatStyle = FlatStyle.System, .AutoSize = True} Controls.Add(L) ' ----- Légende (nuancier + étiquettes ) : cpt_Left += 5 - _interval ' marge de 5 pixels entre le graph et les carrés et entre les carrés et les étiquettes For i As Integer = nbBarres - 1 To 0 Step -1 P = New PictureBox With {.Top = ctl_Bas - 10, .Left = cpt_Left, .Width = 10, .Height = 10, .BackColor = arrColor(i)} L = New Label With {.Top = ctl_Bas - 12, .Left = cpt_Left + 10, .Text = _legende(i), .AutoSize = True} If L.Width > lbl_Largeur Then lbl_Largeur = L.Width ctl_Bas -= lbl_Hauteur - 4 ttip.SetToolTip(P, " " & _valeurs(i) & " % ") ttip.SetToolTip(L, " " & _valeurs(i) & " % ") ' et la valeur si on ne peut pas la capter (=0) dans le graphe Controls.Add(P) Controls.Add(L) Next ' ----- Cadre Fond : P = New PictureBox With {.Top = _top, .Left = _left, .Width = ctl_Largeur, .Height = _hauteur, _ .BackColor = Color.Tan} Controls.Add(P) P.SendToBack() ' Return = la position right de l'histogramme = marge + barres + maxi étiquette légende Return cpt_Left + lbl_Largeur End Function End Class
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.