Jauge horizontale progressive avec signets

Soyez le premier à donner votre avis sur cette source.

Vue 8 328 fois - Téléchargée 657 fois

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!

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1172
Date d'inscription
jeudi 24 mai 2007
Statut
Membre
Dernière intervention
28 septembre 2013
1
testé sous .Net :
Couleur des Sig ne marche pas, le redimensionnement du control non plus (le fait de passer par un bitmap peut être ?), une erreur lors de la pause sur la form, mais apres il roule.
Code Ex :
Dim i As Integer = 0

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'limite min, max et légende
AxUserControl11.setLmt(0, 100, "°C")
'position des Signets
AxUserControl11.setSig(0, 10)
AxUserControl11.setSig(1, 50)
AxUserControl11.setSig(2, 90)
AxUserControl11.loadSig(3, 2) ' reste toujours noir qq soit la valeur ou rouge si aucune valeur de tapé.

Timer1.Enabled = True
End Sub

Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
'incrémente la jauge
If i < 100 Then i = i + 2
AxUserControl11.setJau(i)
' fait bouger le signet 4
If i < 50 Then
AxUserControl11.setSig(3, 2 * i)
Else
AxUserControl11.setSig(3, i / 2)
End If

End Sub
Pour ce qui est de l'utilité, cela peu permettre d'afficher plusieurs valeur (grace au signet) sur un seul bargraph. Ex °C,Hygro,Pression. Dommage qu'il soit si vérouillé niveau paramétres (pas possible de l'avoir vertical par exemple)
@++
Messages postés
64
Date d'inscription
lundi 25 août 2003
Statut
Membre
Dernière intervention
22 novembre 2011

Bon... mon cher PCPT, j'ai ajouté ta fonction, et j'ai commencé à l'intégrer dans un controle qui est somme toutes assez fonctionnel, et j'irais même jusqu'à dire, prêt à l'emploi, mais bon, il demeure que rien n'est parfait et il y a encore de nombreuses choses à finaliser... Merci encore
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
49
re,
je viens de m'apercevoir d'un petite bétise :
pour l'exemple, il y a 16 couleurs, donc logiquement :

' *- déclaration -*
Const NbColors As Integer = 16
Dim TabColors(NbColors-1) As OLE_COLOR

' *- loadSig -*
(...)...= TabColors(Int((NbColors-1) * Rnd))

et bien sûr, le principe de mettre un "Optionnal", c'est d'appeler :
' *- command3 (appel Load Signet) -*
loadSig txtsig 'pas besoin de préciser "0"
'(...)


tout restait correct, mais bon^^

@+
PCPT
Messages postés
64
Date d'inscription
lundi 25 août 2003
Statut
Membre
Dernière intervention
22 novembre 2011

Hoooo.... franchement t'as de la suite dans les idées, mon cher PCPT... je vais faire les modifications... merci beaucoup pour tes recommendations... j'avais pas pensé à écrire directement sur images! t'es fort! Merci encore...
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
49
salut,
prise en compte des valeurs négatives, très bien.

j'ai regardé le code d'un peu plus près, voici une petite amélioration possible.
principe : aléatoire sur les couleurs des signets supplémentaires
pratique :


' *- déclaration -*
Const NbColors As Integer = 15
Dim TabColors(NbColors) As OLE_COLOR

' *- form Load -*
'(...)
'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
'(...)

'(et Load 1 et 2 sont devenus "loadSig 1, TabColors(14) 'vbBlue"
"loadSig 2, TabColors(9) 'vbRed")



' *- loadSig -*
Public Sub loadSig(sigID As Integer, Optional ByVal Couleur As OLE_COLOR = 0)
'(...)
If Couleur 0 Then Couleur TabColors(Int(NbColors * Rnd))
'(puis tes 2 Load normaux)


' *- command3 (appel Load Signet) -*
loadSig txtsig, 0
setSig txtsig, txtns




encore du boulot, mais c'est vraiment pas mal ;)

modification possibles en ocx:
*éventuellement écrire le texte (pas en label) + pouvoir le placer (right left center) + Font
*choisir couleur de fond (même si j'aime le noir ;))
*pouvoir étirer ou rétrécir, au moins en longueur
*menu contextuel sur le contrôle, mais tout dépend de l'utilité...
*signets personnalisés


toujours pas noté ;)
bon boulot, bonne continuation
++
PCPT
Afficher les 11 commentaires

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.