Jauge horizontale progressive avec signets

Télécharger le projet
Commenter

Description

Salut tout l'monde... particulièrement PCPT... j'ai retapé le code, je l'ai beaucoup amélioré, il prend maintenant en charge les minimums... NÉGATIFS! et tout est complètement fonctionnel... bien entendu, il s'agit encore une fois d'une source non complétée... il n'y a donc pas encore de gestion d'erreur ni de fonction très évoluées... Le code est encore un peu nébuleux et brouilon mais la logique est toute commentée... la prochaine étape: le plus de fonctions et d'options possible... et dépôt au propre du contrôle final... d'ici là, voici la dernière version de ma super jauge graduelle... Merci PCPT pour tes conseils... Bonne contuité et bonne prog à tous.

Source / Exemple : 


Const NbColors As Integer = 16
Dim TabColors(NbColors - 1) As OLE_COLOR
Private Max As Long
Private Min As Long
Private nNv As Long
Private nns(20) As Long
Private sFx As String

Public Sub loadSig(sigID As Integer, Optional ByVal Couleur As OLE_COLOR = 0)
If Couleur = 0 Then Couleur = TabColors(Int(NbColors * Rnd))
Load sig1(sigID)
Load sig2(sigID)
Load tmrSig(sigID)
Load lblSig(sigID)
sig1(sigID).Visible = True
sig2(sigID).Visible = True
lblSig(sigID).Visible = True
sig1(sigID).BorderColor = Couleur
sig2(sigID).BorderColor = Couleur
lblSig(sigID).ForeColor = Couleur
End Sub

Public Sub unloadSig(sigID As Integer)
Unload sig1(sigID)
Unload sig2(sigID)
Unload tmrSig(sigID)
Unload lblSig(sigID)
End Sub

Public Sub setLmt(nMin As Long, nMax As Long, suffixe As String)
Min = nMin
Max = nMax
sFx = suffixe
setSig 0, 0
setSig 2, nMax
setSig 1, nMin
setJau nNv
End Sub

Public Sub setSig(sigID As Integer, Niveau As Long)
nns(sigID) = Niveau
tmrSig(sigID).Enabled = True
End Sub

Public Sub setJau(Niveau As Long)
tmrJau.Enabled = True
nNv = Niveau
End Sub

Private Sub tmrJau_Timer()
Dim Pt As Long
Dim Lc As Integer
Dim Pa As Integer
Dim Np As Integer
Dim Ec As Integer

Lc = con.Width                                                               'Maximum pratique  (aire de jeu, correspond à la longueur du contrôle)
Pa = niv.Width                                                                'Niveau pratique actuel (longueur actuelle, avant calculs, de la barre)
Np = Lc * (nNv - Min) / (Max - Min)                                        'Niveau final pratique (longueur finale de la barre après la série de calculs)
Pt = ((Max - Min) / Lc * Pa) + Min                                        'Niveau théorique actuel (position actuelle entre le minimum et le maximum théorique)

If Np < 25 Then Np = 25                                                   'éviter de créer une erreur en faisant disparaitre la barre
If Np < Pa Then Ec = (Pa - Np) / (Lc / 100) Else: Ec = (Np - Pa) / (Lc / 100) 'écart pratique positif sur 100 (entre la position actuelle de la barre et la position souhaitée)

If Np < Pa Then                                                               'Mouvement négatif (si la nouvelle position de la barre est à gauche de la position actuelle de celle-ci)

    If Ec < 1 Then Pa = Pa - 1 Else: Pa = Pa - Ec               'Décrémentation graduelle du niveau pratique en y soustrayant l'écart l'écart pratique

ElseIf Np > Pa Then                                                         'Mouvement positif (si la nouvelle position de la barre est à droite de la position actuelle de celle-ci)

    If Ec < 1 Then Pa = Pa + 1 Else: Pa = Pa + Ec              'Incrémentation graduelle du niveau pratique en y additioNivant l'écart l'écart pratique

ElseIf Pa = Np Then tmrJau.Enabled = False                      'Arrêt du mouvement, (lorsque le niveau final pratique correspond à la position pratique actuelle de la barre)
    
End If

niv.Width = Pa                                                                 'Attribution de la longueur de la barre
lbllvl(0).Caption = Pt & sFx                                              'Écriture du niveau théorique sur la barre
lbllvl(1).Caption = Pt & sFx                                               'Même chose, mais sur la barre morte
End Sub

Private Sub tmrSig_Timer(Index As Integer)
Dim Nn As Long
Dim Pt As Long
Dim Lc As Integer
Dim Pa As Integer
Dim Np As Integer
Dim Ec As Integer

Nn = Int(nns(Index))                                                                 'Niveau final théorique (position finale souhaitée entre le minimum et le maximum théorique)
Lc = con.Width                                                               'Maximum pratique  (aire de jeu, correspond à la longueur du contrôle)
Pa = sig1(Index).X1                                                          'Niveau pratique actuel (position actuelle, avant calculs, du signet)
Np = Lc * (Nn - Min) / (Max - Min) + con.Left      'Niveau final pratique (Position finale du signet après la série de calculs)
Pt = ((Max - Min) / Lc * (Pa - con.Left)) + Min   'Niveau théorique actuel (position actuelle entre le minimum et le maximum théorique)

If Np < Pa Then Ec = (Pa - Np) / (Lc / 100) Else: Ec = (Np - Pa) / (Lc / 100) 'écart pratique positif sur 100 (entre la position actuelle du signet et la position souhaitée)

If Np < Pa Then                                                               'Mouvement négatif (si la nouvelle position du signet est à gauche de la position actuelle de celui-ci)

    If Ec < 1 Then Pa = Pa - 1 Else: Pa = Pa - Ec               'Décrémentation graduelle du niveau pratique en y soustrayant l'écart pratique

ElseIf Np > Pa Then                                                         'Mouvement positif (si la nouvelle position du signet est à droite de la position actuelle de celui-ci)

    If Ec < 1 Then Pa = Pa + 1 Else: Pa = Pa + Ec              'Incrémentation graduelle du niveau pratique en y additionnant l'écart pratique

ElseIf Pa = Np Then tmrSig(Index).Enabled = False                      'Arrêt du mouvement (lorsque le niveau final pratique correspond à la position pratique actuelle du signet)
    
End If

'sig1(Index).Left = Pa                                                                  'Attribution de la position du signet
sig1(Index).X1 = Pa
sig1(Index).Y1 = con.Top - 15
sig1(Index).X2 = Pa - 105
sig1(Index).Y2 = con.Top - 120
sig2(Index).X1 = Pa
sig2(Index).Y1 = con.Top - 15
sig2(Index).X2 = Pa + 105
sig2(Index).Y2 = con.Top - 120
lblSig(Index).Left = Pa - (lblSig(Index).Width / 2)     'Attribution de la position de l'étiquette du signet
lblSig(Index).Top = con.Top + con.Height
lblSig(Index).Caption = Pt & sFx                                               'Écriture du niveau théorique sur l'étiquette du signet
sig1(Index).ZOrder 0                                                         'Premier plan
sig2(Index).ZOrder 0                                                         'Premier plan
lblSig(Index).ZOrder 0                                                      'Premier Plan
End Sub

Private Sub UserControl_Initialize()
'init tableau couleur aléatoires
TabColors(0) = &HFFFFFF 'blanc
TabColors(1) = &HC0C0C0 'gris
                'pâles
TabColors(2) = &HC0C0FF 'rose
TabColors(3) = &HC0E0FF 'saumon
TabColors(4) = &HC0FFFF 'jaune
TabColors(5) = &HC0FFC0 'vert
TabColors(6) = &HFFFFC0 'bleu
TabColors(7) = &HFFC0C0 'violet
TabColors(8) = &HFFC0FF 'mauve
                'vifs
TabColors(9) = &HFF&    'rouge
TabColors(10) = &H80FF& 'orange
TabColors(11) = &HFFFF& 'jaune
TabColors(12) = &HFF00& 'vert
TabColors(13) = &HFFFF00 'bleu clair
TabColors(14) = &HFF0000 'bleu foncé
TabColors(15) = &HFF00FF 'magenta

Randomize 'Time pour aléatoire

Max = 100
Min = -40
sFx = "°C"
loadSig 1, TabColors(14)
loadSig 2, TabColors(9)
setSig 0, 0
setSig 1, -40
setSig 2, 100
setJau -12
End Sub

Private Sub UserControl_Resize()
con.Width = UserControl.Width - lblSig(0).Width
con.Left = lblSig(0).Width / 2
con.Height = UserControl.Height - 240 - lblSig(0).Height
con.Top = 240
lblSig(0).Top = 240 + con.Height
setSig 0, 0
setSig 2, Max
setSig 1, Min
setJau nNv
End Sub

Conclusion :


Voici la version fonctionnelle "contrôle" ainsi que l'interface de test du code... il n'y a pas de gestion d'erreur, encore, alors soyez prudent lors de vos manoeuvres... MERCI beaucoup à PCPT pour ses astuces... Ma source vaut maintenant la mention initié... hein PCPT ;) Bonne continuité et bonne prog à tous!
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.

Du même auteur (cs_yannickt)