Dessine un camembert dans un picture

Télécharger le projet
Commenter

Description

dessine un camembert dans un picture en fonction d'un tableau de parametre
chaque part du camenbert est un pourcentage du disque entier

Source / Exemple : 


' dans la feuille avec une picture qui recoit le camembert
Option Explicit

Sub rempli_et_affiche_camembert()
 Dim lc As Integer
 Dim maxcalc As Integer
'mon type camembert  qui contient
' un tableau des pourcentages de chaque par
' un tableau des couleurs de chaque part
' le nombre de part maximum
Dim cam As typ_camembert
 cam.nb_max = (Val(Text2.Text) - 1) Mod Max_camembert + 1
 maxcalc = 0
 For lc = 1 To cam.nb_max
  cam.T_p(lc) = Val(Text1(lc - 1).Text)
  maxcalc = maxcalc + cam.T_p(lc)
 Next lc
 cam.T_c(1) = vbRed
 cam.T_c(2) = vbYellow
 cam.T_c(3) = vbGreen
 cam.T_c(4) = vbBlue
 cam.T_c(5) = vbCyan
 cam.T_c(6) = vbMagenta
 cam.T_c(7) = vbWhite
 cam.T_c(8) = vbBlack
 
 Call affiche_camembert(Picture1, cam)
 Me.Label1.Caption = "global " & maxcalc & " %"
 If maxcalc > 100 Then Me.Label1.Caption = "erreur depassement 100% "
 End Sub

Private Sub Command1_Click()
Call rempli_et_affiche_camembert

End Sub

Private Sub Form_Load()
Call rempli_et_affiche_camembert
End Sub

' dans module camembert.bas
Option Explicit

Public Const Max_camembert = 8

Type typ_camembert
    T_p(1 To Max_camembert) As Integer    ' pourcentage de chaque part
    T_c(1 To Max_camembert) As Long ' couleur
    nb_max As Integer ' nombre max de part a afficher
End Type

Sub affiche_camembert(camembert As PictureBox, tab_p As typ_camembert)

Const conPI = 3.14159265359
    Dim lc As Integer
    Dim Pc(0 To Max_camembert) As Single
    
    ' calcule les angles attention sens anti horaire debut a 90°
    Pc(0) = -0.00001
    For lc = 1 To tab_p.nb_max
        Pc(lc) = tab_p.T_p(lc) Mod 100  ' pour ne pas depasser
        Pc(lc) = -(2 * conPI) * Pc(lc) / 100 + Pc(lc - 1) - Pc(0)
        If Pc(lc) > Pc(0) Then Pc(lc) = Pc(0)
        If Pc(lc) < -(2 * conPI) Then
            Pc(lc) = -(2 * conPI)
        End If
        'Form1.Label1(lc).Caption = Format(Pc(lc), "##,##0.00000")
    Next lc
    camembert.Cls
    camembert.AutoRedraw = True
    camembert.FillStyle = 0                     ' Fill pie slice.
    For lc = 1 To tab_p.nb_max
        camembert.FillColor = tab_p.T_c(lc) ' couleur remplissage
        If tab_p.T_p(lc) >= 1 Then camembert.Circle (camembert.ScaleWidth / 2, camembert.ScaleHeight / 2), (camembert.ScaleHeight * 0.45), tab_p.T_c(lc), Pc(lc - 1), Pc(lc)
    Next lc '  Draw pie slice within circle.
    
End Sub
Télécharger le projet

Codes Sources

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.