Accueil > > > JAUGE HORIZONTALE PROGRESSIVE AVEC SIGNETS
JAUGE HORIZONTALE PROGRESSIVE AVEC SIGNETS
Information sur la source
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
- 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
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!
Historique
- 21 septembre 2005 09:05:54 :
- Quelques petites erreurs se sont glissées dans le code... je l'ai mis à jour
- 21 septembre 2005 18:27:50 :
- Conseil d'un autre utilisateur...
- 22 septembre 2005 09:46:59 :
- Révision de la source
- 22 septembre 2005 23:11:51 :
- Début de mise en contrôle...
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
MSCOMCTL.OCX [ par zekmek ]
Depuis que j'ai rajouté une progressbar dans mon form j'ai ce message qui se lance a l'execution... MSCOMCTL.OCX; en effet pour inclure ma progressbar
Ocx et propriété [ par Cartman ]
Je cherche à utiliser la propriété ItemData d'un listebox que g créé dans un UserControlvoila ce que g fait dans mon Let et je c pas quoi mettre comme
Une Form dans un ActiveX (OCX) [ par Lolux ]
Bonjour, Je suis en train de créer un ActiveX qui contient :Une FormUn ModuleUn UsercontrolMa form et une sorte de fenêtre d'option qui doit permettre
OCX - USERCONTROL - ENTREES/SORTIES [ par salazar ]
J'ai créé indépendemment 2 usercontrols. Le 1er a 2 variables d'entrées/sortie et le 2ème en a également 2.A partir des 2 codes sources, j'ai généré 2
Diffusion usercontrol ocx [ par RMamat ]
Bonjour Je cherche a savoir comment faire pour diffuser une librairie ocx.Voici mon probleme: j'ai fais un usercontrol. Ce usercontrol est comporte u
SOS URGENT comment obtenir de nouveau ocx pour les progressbar [ par Sytchev3 ]
Comment puis je trouver d'autres ocx pour les progressbar afin de changer les carré ou la progression en continuMerci de ma répondre
Très urgent compiler mon usercontrol.... [ par lex1111 ]
Salut, j'aimerais compiler le usercontrole que j'ai trouvé sur vbfrance et que j'ai modifié un peu...J'aimerais le passer de ".ctl" a ".ocx" pour le j
ActiveX Usercontrol [ par thierry00191 ]
Bonjour à tous,Je suis nouveau à la programmation sur vb6 et plus particulièrement sur les activeX. Voici mon soucis:Je dois programmer
Quelle difference entre Me et Usercontrol a l'interieur d'un OCX ? [ par jimmypage64 ]
Bonjour, Quand je suis dans le code de mon controle OCX j'ai l'impression que Me et Usercontrol ne sont pas le même object. Par exemple Me.hdc ne co
fermeture d'un ocx [ par pointdalattitude ]
Bonjour,Je voulai savoir si c'était possible de fermer mon control activex avec un bouton de commande.J'ai essayer en placant un CommandButton su
|
Derniers Blogs
SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|