[AC-2007] Progress bar ajustable avec couleur paramétrable

[Triton972]

Bonjour,

J'utilise depuis peu les Progress bar mais les différents modèles que j'ai testés ne me convenaient pas. Soit il est intégré dans un formulaire, soit la couleur est imposée et difficilement modifiable, ... J'ai donc décidé de m'en fabriquer un simple (sans l'utilisation d'ActiveX) avec les options que je n'ai pas trouvées ailleurs :

- Pouvoir modifier facilement sa taille (longueur, hauteur) et son positionnement afin qu'il se comporte (pratiquement) comme un contrôle standard.
- Pouvoir modifier facilement sa couleur.
- Pouvoir l'intégrer et l'utiliser facilement dans un formulaire.

J'ai choisi d'utiliser un ensemble de 2 rectangles. Un rectangle extérieur qui sert de cadre fixe au 2° rectangle intérieur dont la longueur variera en fonction de sa valeur. Pour faire un ensemble cohérent, voilà comment j'ai procédé :

1 - Créer 2 rectangles avec l'outil "Rectangle"
2 - Les nommer de façon explicite (exemple : BoiteI et BoiteE).
3 - La boite Extérieure : Apparence 3D enfoncé, couleur fond (blanc, transparent ou autre)
4 - La boité Intérieur : Apparence Ciselé
(vous pouvez les paramétrer autrement mais je trouve que ça rend bien comme cela)
5 - Vous égalisez les dimensions des 2 boites, même hauteur et même largeur en utilisant les commandes classiques de mise en forme ("au plus large" et "au plus grand" par exemple)
6 - Vous superposez les 2 boites en utilisant également les commandes classiques d'alignement en prenant soin que la boite intérieure soit bien au premier plan.
7 - Vous groupez les 2 rectangles pour former un objet unique. On peut alors modifier à volonté ses dimensions et le déplacer librement sur le formulaire.

La partie graphique est terminée. Cet ensemble pourra être recopié à volonté dans d'autres formulaires ou dupliquer dans le même formulaire.
Attention de bien renommer les 2 rectangles pour pouvoir facilement les distinguer au niveau du code.

On va s'appuyer sur un module de classe pour donner des propriétés à notre objet et pouvoir les gérer plus facilement au niveau du formulaire.
Pour pouvoir générer le ProgressBar j'ai créé les propriétés suivantes :
- Valeur mini
- Valeur maxi
- Valeur actuelle
- Couleur de la barre
- Longueur maxi de la barre en twips
- Longueur actuelle de la barre
- Référence du rectangle intérieur
- Référence du rectangle extérieur
- Référence du formulaire accueillant la barre

Code complet du module de classe : clProgress

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Option Explicit
 
Private gPgBMin As Long         'Valeur Mini
Private gPgBMax As Long         'Valeur Maxi
Private gPgBValue As Long       'Valeur
Private gPgBColor As Long       'Couleur Fond
Private gPgBWidthMax As Long    'Longueur maxi en twips
Private gPgBWidth As Long       'Longueur actuelle de la barre
Private gPgBIRect As String     'Référence du rectangle intérieur (longueur variable)
Private gPgBERect As String     'Référence du rectangle extérieur (cadre fixe)
Private gPgBForm As String      'Référence du formulaire accueillant la barre
 
Property Get Width() As Long
Width = gPgBWidth
End Property
 
Property Let Width(lWidth As Long)
gPgBWidth = lWidth
End Property
 
Property Get WidthMax() As Long
WidthMax = gPgBWidthMax
End Property
 
Property Let WidthMax(lWidthMax As Long)
gPgBWidthMax = lWidthMax
End Property
 
Property Get Form() As String
Form = gPgBForm
End Property
 
Property Let Form(sForm As String)
gPgBForm = sForm
End Property
 
Property Get Min() As Long
Min = gPgBMin
End Property
 
Property Let Min(lMin As Long)
gPgBMin = lMin
End Property
 
Property Get Max() As Long
Max = gPgBMax
End Property
 
Property Let Max(lMax As Long)
gPgBMax = lMax
End Property
 
Property Get Color() As Long
Color = gPgBColor
End Property
 
Property Let Color(lColor As Long)
gPgBColor = lColor
Forms(Me.Form).Controls(Me.IRect).BackColor = Me.Color  'Lorsque la couleur est mise à jour dans l'objet on modifie la couleur du rectangle intérieur
End Property
 
Property Get IRect() As String
IRect = gPgBIRect
End Property
 
Property Let IRect(sRect As String)
    If Forms(Me.Form).Controls(sRect).ControlType = acRectangle Then        'On vérifie que l'objet affecté est bien un rectangle
        gPgBIRect = sRect                                                   'On affecte alors l'objet Rectangle Intérieur à l'objet ProgressBar
    Else
        err.Raise Number:=vbObjectError + 1, Description:="Objet affecté non valide"
    End If
End Property
 
Property Get ERect() As String
ERect = gPgBERect
End Property
 
Property Let ERect(sRect As String)
    If Forms(Me.Form).Controls(sRect).ControlType = acRectangle Then        'On vérifie que l'objet affecté est bien un rectangle
        gPgBERect = sRect                                                   'On affecte alors l'objet Rectangle Extérieur à l'objet ProgressBar
        Me.WidthMax = Forms(Me.Form).Controls(Me.ERect).Width               'On affecte la longueur maxi (celle du rectangle extérieur) à l'objet
    Else
        err.Raise Number:=vbObjectError + 1, Description:="Objet affecté non valide"
    End If
End Property
 
Property Get Value() As Long
Value = gPgBValue
End Property
 
Property Let Value(lValue As Long)
Dim intVal As Double
Dim doFact As Double
 
doFact = (Me.WidthMax) / (Me.Max - Me.Min)
intVal = doFact * (lValue - Me.Min)                 'Calcul en twips de la longueur du rectangle variable (intérieur)
gPgBValue = lValue
 
Me.Width = intVal                                   'Affectation de la longueur du rectangle intérieur à l'objet
Forms(Me.Form).Controls(Me.IRect).Width = Me.Width  'Modification de la longueur du rectangle intérieur du formulaire
Forms(Me.Form).Repaint
DoEvents
 
End Property

Le ProgressBar est initialisé dans le formulaire principal

Dans l'entête du code du formulaire

Code :

1
2
3
Option Compare Database
 
Dim lPgB, lPgB1 As clProgress

J'ai initialisé içi 2 objets
Ensuite au niveau de l'utilisation (c'est un exemple):

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Visu_Forms()
Dim cnt As DAO.Container
Dim Doc As DAO.Document
 
Set db = CurrentDb
 
' Visualisation de tous les formulaires
Set cnt = db.Containers("Forms")
 
Set lPgB = oPgB(Me.Form, Me.BoitI, Me.BoitE)
 
lPgB.Min = 0
lPgB.Max = cnt.Documents.Count
lPgB.Color = vbBlue
lPgB.Value = 0
    For Each Doc In cnt.Documents
        Debug.Print Doc.Name, Doc.Container
        lPgB.Value = lPgB.Value + 1
    Next Doc
Set cnt = Nothing
Set lPgB = Nothing
Set db = Nothing
End Sub

Revenons sur la ligne :

Code :

Set lPgB = oPgB(Me.Form, Me.BoitI, Me.BoitE)

C'est elle qui crée l'objet à l'aide d'une fonction inscrite dans un module :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function oPgB(frm As Form, oIRect As Rectangle, oERect As Rectangle) As clProgress
On Error GoTo Erreur
 
Set oPgB = New clProgress
 
With oPgB
    .Form = frm.Name
    .IRect = oIRect.Name
    .ERect = oERect.Name
End With
 
Exit Function
Erreur:
MsgBox err.Description & " Erreur lors de la création de l'objet", vbExclamation + vbOKOnly, "Erreur d'affectation"
Set oPgB = Nothing
End Function

Les paramètres de cette fonction sont :
- la référence du formulaire actuel
- les références des 2 boites (intérieure et extérieure)

La fonction créé et affecte localement une instance de l'objet clProgress et lui affecte les 3 propriétés essentielles :
- Le nom du formulaire appelant
- Le nom de la boite intérieure
- Le nom de la boite extérieure

La fonction renvoie la référence de l'objet créé qui est lui même affecté à la variable locale afin de pouvoir être exploité par le code du formulaire appelant.

En cas de passage d'un objet autre qu'un rectangle la fonction se met en erreur lors de la vérification des types des arguments d'entrée. En cas d'erreur dans le module de classe, l'erreur est gérée.

Voilà c'est pratiquement terminé. L'objectif est atteint :
- Les parties ardues du code sont dans le module de classe et dans le module, elles sont donc transparentes dans l'utilisation du formulaire
- Les appels des propriétés sont simples et pratiquement similaires à celles que l'on a avec un ActiveX.
- Les dimensions du ProgressBar sont facilement modifiables
- On peut facilement ajouter d'autres fonctionnalités (exemples :couleur du fond du rectangle extérieur, ajout de texte à l'intérieur du rectangle, ...)

Le code n'est pas vraiment optimisé mais je compte sur vous pour le rendre encore meilleur.
Cordialement,

[philben]

Bonjour,

Ta contribution serait plus "vendeuse" avec une base Access jointe en exemple, je n'ai pas testé ton code par flemme...

Je me souviens qu'Arkham46 avait aussi proposé une classe pour gérer une barre de progression.

@+

Philippe

[Triton972]

Bonjour,

Tu as raison avec un exemple c'est plus simple

Si nous parlons du même code (?), celui d'Arkham46 proposait un formulaire d'attente pour les longs traitements. Ce que j'essaie de faire c'est de manipuler des contrôles simples (des rectangles dans le code proposé) en "ProgressBar" pour pouvoir les intégrer directement dans un formulaire.
@+