DESSINE UN CAMEMBERT DANS UN PICTURE

' 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 zip