Histogramme (bis) barres via datatable 100 % personnalisé

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 210 fois - Téléchargée 20 fois

Contenu du snippet

Version 2 : on veut un Histogramme paramétrable à partir d'un Recordset avec des contrôles facilement manipulables a contrario des Objets Drawings qui ne peuvent être Paint(evt) qu'1 fois dans 1 Form = 1 graph

Source / Exemple :


Imports DicoMesure.My.Resources
Public Class Form_Histogramme_DataTable

    ' ===== CDC bis : 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 2 = Histogramme % via une DataTable 

    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}
    ' ces 2 arrays juste pour remplir la dataTable qui est dès lors id à un RecordSet :
    Private arrayCornichons() As Integer = {6, 25, 36, 87, 8, 25, 35}
    Private arrayNom() As String = {"Dijon", "Nantes", "Nice", "Paris", "Lyon", "Cherbourg", "Pau"}
    Private maTableCornichon As New DataTable
    Private maFont As New Font("Verdana", 9)
    Private maFontBold As New Font("Verdana", 8, FontStyle.Bold)

    ' ===== On veut afficher un Histogrammes % depuis un RecordSet :
    Private Sub Form1_Load(ByVal s As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim R As DataRow
        With maTableCornichon
            .Columns.Add() : .Columns.Add()
            For i As Integer = 0 To 6
                R = .NewRow
                R(0) = arrayNom(i) : R(1) = arrayCornichons(i)
                .Rows.Add(R) ' idem table d'un RecordSet
            Next
        End With
        ' éditer l'Histogramme % :
        Histo_PourCent("Part des Cornichons (volume) / Récolte 1902", maTableCornichon, 40, 40, 200, 30, corns, 10)
    End Sub
    ' ===== Histogramme à Barres Verticales pour 100 :
    Private Function Histo_PourCent(ByVal _titre As String, ByVal _table As DataTable, _
                                  ByVal _top As Integer, ByVal _left As Integer, _
                                  ByVal _hauteur As Integer, ByVal _largeurBarre As Integer, _
                                  ByVal _rsImg As Image, Optional ByVal _interval As Integer = 0) _
                                  As Integer

        Dim nbBarres As Integer = _table.Rows.Count : If nbBarres = 0 Then Return False
        Dim maVal As Integer = 0, monTxt As String
        Dim ctl_Largeur As Integer = (nbBarres * _largeurBarre) + ((nbBarres - 1) * _interval)
        Dim cpt_Left As Integer = IIf(_left < 10, 10, _left)
        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
        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 As Color
        With _table
            For i As Integer = 0 To nbBarres - 1
                monTxt = .Rows(i).Item(0)
                maVal = .Rows(i).Item(1)
                cpt_Hauteur = _hauteur / 100 * .Rows(i).Item(1)
                ctl_Top = _top + _hauteur - cpt_Hauteur
                If maVal <= 2 Then ctl_Top -= 1 : cpt_Hauteur += 1
                P = New PictureBox With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, _
                                         .Height = cpt_Hauteur, .BackColor = arrColor(i)}
                ttip.SetToolTip(P, " " & monTxt & " " & maVal & " % ")
                Controls.Add(P)
                ' ----- Valeurs :
                If maVal > 50 Then
                    ctl_Top = P.Top
                    maBColor = arrColor(i)
                ElseIf maVal < 5 Then
                    ctl_Top = P.Top - 20
                    maBColor = Color.DarkGreen
                Else
                    ctl_Top = P.Top - 15
                    maBColor = Color.DarkGreen
                End If
                L = New Label With {.Left = cpt_Left, .Top = ctl_Top, .Width = _largeurBarre, .BackColor = maBColor, _
                                    .ForeColor = Color.Wheat, .Text = maVal, .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
            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 = 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 = monTxt, .AutoSize = True}
                If L.Width > lbl_Largeur Then lbl_Largeur = L.Width
                ctl_Bas -= lbl_Hauteur - 4
                ttip.SetToolTip(P, " " & maVal & " % ") : ttip.SetToolTip(L, " " & maVal & " % ")
                Controls.Add(P) : Controls.Add(L)
            Next
        End With
        ' ----- Cadre Fond (ok, l'image est un peu lourdingue) :
        P = New PictureBox With {.Top = _top, .Left = _left, .Width = ctl_Largeur, .BackColor = Color.Tan, .Height = _hauteur, .Image = _rsImg}
        Controls.Add(P)
        P.SendToBack()
        Return True
    End Function
End Class

Conclusion :


On notera l'utilisation des With pour la définition des New Controls {} : ils ne sont pas confondus avec le With englobant.
On ne fera jamais aussi bien qu'un MSChart avec tous ses reliefs, ok, mais le fait-maison a bien d'autres avantages de lisibilité (cf les tooltiptext).

A voir également

Ajouter un commentaire

Commentaire

Messages postés
162
Date d'inscription
jeudi 22 janvier 2004
Statut
Membre
Dernière intervention
20 juillet 2013

Hello,

C'est pas mal.

Par contre :

- Evite d'utiliser IIF (c'est très peu lisible). Ca n'est pas un concours du code le plus court mais le code le mieux écrit, le plus performant.

- Tu fais des divisions mais tu pourrais gagner en optimisation en travaillant avec des integer. Cela éviterait également d'évantuels problèmes de placement lorsque VB arrondi pour le placement de tes controles.

- Enfin, le plus important, c'est dommage de ne pas dessiner tout cela dans un controle ...

Voila, sinon c'est pas trop mal, peu commenté mais bon. Ah, et pendant qu'on y est, pense à la POO ;)

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.