Accueil > > > UNE HORLOGE À AIGUILLE DANS UN CONTRÔLE FRAME OU PICTURE
UNE HORLOGE À AIGUILLE DANS UN CONTRÔLE FRAME OU PICTURE
Information sur la source
Description
Petite horloge sans prétention, mais qui à le mérite de pouvoir être placée dans un contrôle Frame ou Picture, dans une feuille MDI ou Fille. Le code est structuré et documenté.
Source
- Option Explicit
- 'couleur des aiguilles
- Private mnHourHand As Integer
- Private mnMinuteHand As Integer
- Private mnSecondHand As Integer
- '--- variable
- Private mnHnum As Integer
- Private mnMnum As Integer
- Private mnSnum As Integer
- Private mfHlen As Single
- Private mfMlen As Single
- Private mfSlen As Single
- Public gnHourHandColor As Integer
- Public gnMinuteHandColor As Integer
- Public gnSecondHandColor As Integer
- '--- variable
- Private Const Pi = 3.14159265358979
- Private Const TwoPi = Pi + Pi
- Private Const HalfPi = Pi / 2
-
- Private Sub cmdSetTime_Click()
- Dim sPrompt As String
- Dim sTitle As String
- Dim sDefault As String
- Dim sStartTime As String
- Dim sTim As String
- Dim sMsg As String
- 'Demander la nouvelle heure à l'utilisateur
- sPrompt = "Entrez l'heure en format 00:00:00"
- sTitle = "Horloge"
- sDefault = Time$
- sStartTime = sDefault
- sTim = InputBox$(sPrompt, sTitle, sDefault)
- 'Tester si l'utilisateur a cliqué sur Annuler ou sur OK sans changement
- If sTim = "" Or sTim = sStartTime Then
- Exit Sub
- End If
- 'Mettre à la nouvelle heure
- On Error GoTo ErrorTrap
- Time$ = sTim
- Exit Sub
-
- ErrorTrap:
- 'Récupération de l'erreur
- sMsg = "L'heure que vous avez entrée n'est pas valide. " + sTim
- MsgBox sMsg, 48, "Horloge"
- Resume Next
- End Sub
-
- Private Sub tmrClock_Timer()
- Dim dHang As Double
- Dim dMang As Double
- Dim dSang As Double
- Dim dHx As Double
- Dim dHy As Double
- Dim dMx As Double
- Dim dMy As Double
- Dim dSx As Double
- Dim dSy As Double
- 'Garder trace de la seconde en cours
- Static LastSecond
- 'Tester pour voir si c'est une nouvelle seconde
- If Second(Now) = LastSecond Then
- Exit Sub
- Else
- LastSecond = Second(Now)
- End If
- 'Mettre à jour les variables de l'heure
- mnHnum = Hour(Now)
- mnMnum = Minute(Now)
- mnSnum = Second(Now)
- 'Calculer les angles des aiguilles
- dHang = TwoPi * (mnHnum + mnMnum / 60) / 12 - HalfPi
- dMang = TwoPi * (mnMnum + mnSnum / 60) / 60 - HalfPi
- dSang = TwoPi * mnSnum / 60 - HalfPi
- 'Calculer les extrémités de chaque aiguille
- dHx = mfHlen * Cos(dHang)
- dHy = mfHlen * Sin(dHang)
- dMx = mfMlen * Cos(dMang)
- dMy = mfMlen * Sin(dMang)
- dSx = mfSlen * Cos(dSang)
- dSy = mfSlen * Sin(dSang)
- 'Restaurer l'image de fond
- picBackGround.Cls
- 'Restaurer les couleurs et formes
- picBackGround.Line (0, 0)-(dMx, dMy), QBColor(gnMinuteHandColor)
- picBackGround.Line (0, 0)-(dHx, dHy), QBColor(gnHourHandColor)
- picBackGround.Line (0, 0)-(dSx, dSy), QBColor(gnSecondHandColor)
- End Sub
-
- Private Sub Form_Load()
- picBackGround.Scale (-2, -2)-(2, 2)
- picBackGround.DrawWidth = 2
- 'Définir la longueur des aiguilles
- mfHlen = 0.8
- mfMlen = 1.4
- mfSlen = 1.6
- 'définition de la couleur des auguilles
- gnHourHandColor = (mnHourHand + 4)
- gnMinuteHandColor = (mnMinuteHand + 4)
- gnSecondHandColor = (mnSecondHand + 8)
- 'Affiche la date du jour dans le contrôle lbldate
- Dim D As String
- D = Date
- lbldate.Caption = D
- End Sub
Option Explicit
'couleur des aiguilles
Private mnHourHand As Integer
Private mnMinuteHand As Integer
Private mnSecondHand As Integer
'--- variable
Private mnHnum As Integer
Private mnMnum As Integer
Private mnSnum As Integer
Private mfHlen As Single
Private mfMlen As Single
Private mfSlen As Single
Public gnHourHandColor As Integer
Public gnMinuteHandColor As Integer
Public gnSecondHandColor As Integer
'--- variable
Private Const Pi = 3.14159265358979
Private Const TwoPi = Pi + Pi
Private Const HalfPi = Pi / 2
Private Sub cmdSetTime_Click()
Dim sPrompt As String
Dim sTitle As String
Dim sDefault As String
Dim sStartTime As String
Dim sTim As String
Dim sMsg As String
'Demander la nouvelle heure à l'utilisateur
sPrompt = "Entrez l'heure en format 00:00:00"
sTitle = "Horloge"
sDefault = Time$
sStartTime = sDefault
sTim = InputBox$(sPrompt, sTitle, sDefault)
'Tester si l'utilisateur a cliqué sur Annuler ou sur OK sans changement
If sTim = "" Or sTim = sStartTime Then
Exit Sub
End If
'Mettre à la nouvelle heure
On Error GoTo ErrorTrap
Time$ = sTim
Exit Sub
ErrorTrap:
'Récupération de l'erreur
sMsg = "L'heure que vous avez entrée n'est pas valide. " + sTim
MsgBox sMsg, 48, "Horloge"
Resume Next
End Sub
Private Sub tmrClock_Timer()
Dim dHang As Double
Dim dMang As Double
Dim dSang As Double
Dim dHx As Double
Dim dHy As Double
Dim dMx As Double
Dim dMy As Double
Dim dSx As Double
Dim dSy As Double
'Garder trace de la seconde en cours
Static LastSecond
'Tester pour voir si c'est une nouvelle seconde
If Second(Now) = LastSecond Then
Exit Sub
Else
LastSecond = Second(Now)
End If
'Mettre à jour les variables de l'heure
mnHnum = Hour(Now)
mnMnum = Minute(Now)
mnSnum = Second(Now)
'Calculer les angles des aiguilles
dHang = TwoPi * (mnHnum + mnMnum / 60) / 12 - HalfPi
dMang = TwoPi * (mnMnum + mnSnum / 60) / 60 - HalfPi
dSang = TwoPi * mnSnum / 60 - HalfPi
'Calculer les extrémités de chaque aiguille
dHx = mfHlen * Cos(dHang)
dHy = mfHlen * Sin(dHang)
dMx = mfMlen * Cos(dMang)
dMy = mfMlen * Sin(dMang)
dSx = mfSlen * Cos(dSang)
dSy = mfSlen * Sin(dSang)
'Restaurer l'image de fond
picBackGround.Cls
'Restaurer les couleurs et formes
picBackGround.Line (0, 0)-(dMx, dMy), QBColor(gnMinuteHandColor)
picBackGround.Line (0, 0)-(dHx, dHy), QBColor(gnHourHandColor)
picBackGround.Line (0, 0)-(dSx, dSy), QBColor(gnSecondHandColor)
End Sub
Private Sub Form_Load()
picBackGround.Scale (-2, -2)-(2, 2)
picBackGround.DrawWidth = 2
'Définir la longueur des aiguilles
mfHlen = 0.8
mfMlen = 1.4
mfSlen = 1.6
'définition de la couleur des auguilles
gnHourHandColor = (mnHourHand + 4)
gnMinuteHandColor = (mnMinuteHand + 4)
gnSecondHandColor = (mnSecondHand + 8)
'Affiche la date du jour dans le contrôle lbldate
Dim D As String
D = Date
lbldate.Caption = D
End Sub
Conclusion
Cette horloge à aiguille, peut être placé facilement dans une application.
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Changer l'heure de l'horloge windows avec un vbscript [ par maxcode ]
Bonjour à tous ,Comme le sujet l'indique je voudrais changer l'heure de l'horloge windows ou du systeme avec un vbscript.J'ai longtemps chercher sur I
horloge [ par mouky66 ]
salutje voudrai changer l'heure et la date de mon pc en passant par un programme.on ma indiquerdate = "ta/date/2005"time = "heure/minute/00"le truc c
Afficher la fenêtre heure système [ par faucheuse ]
Bonjour amis programmeurs et programmeuzes,Je me demandais si il était possible d'afficher la fenêtre de l'heure système (avec l'horloge et tout et to
Une horloge dans un formulaire VB excel ? [ par Pdm59 ]
Bonjour à tousJe ne suis pas complétement désespéré, ni au bord du suicide, mais j'ai quand meme un sérieux problem
programmation en VB6: horloge graphique ki affich l'heure système [ par ltstam ]
salut la communauté.j'ai besoin du code d'une horloge réalisée avec vb6.il faut kel soit graphique(faite à partir de circle et line).si possible il fa
il manque l'heure sur mon horloge sur mon site [ par mani_nico ]
bonjour, je ne suis + très jeune ;-( mais faisant des créations sur le web je me suis fait un Site L'aide de votre site m'a aidée bcp à le faire, m
il manque l'heure sur mon horloge sur mon site [ par mani_nico ]
bonjour, je ne suis + très jeune ;-( mais faisant des créations sur le web je me suis fait un Site L'aide de votre site m'a aidée bcp à le faire, m
l'heure sur mon horloge n'apparait pas ? [ par mani_nico ]
bonjour, je ne suis + très jeune ;-( mais faisant des créations sur le web je me suis fait un Site L'aide de votre site m'a aidée
Mon horloge sur mon site n'affiche pas l'heure ? [ par mani_nico ]
bonjour, je ne suis + très jeune ;-( mais faisant des créations sur le web je me suis fait un Site L'aide de votre site m'a aidée
VBA => Convertir format heure en numeric et vis versa [ par narkott ]
Bonjour, Je suis en train de dévellopé une application et j'ai un problème qui se pose. L'utilisateur doit pouvoir saisir dans un userf
|
Derniers Blogs
[SHAREPOINT] NOUVELLE PRéSENTATION POUR LA DOCUMENTATION SHAREPOINT SUR TECHNET.[SHAREPOINT] NOUVELLE PRéSENTATION POUR LA DOCUMENTATION SHAREPOINT SUR TECHNET. par Patrick Guimonet
Vous l'avez peut-être déjà remarqué ? La documentation SharePoint a subit un cure de "relooking" et prend un style inspiré de Metro, donc plus sobre, plus pur, plus clair ! C'est sur fond blanc et ca ressemble à ça : Globaleme...
Cliquez pour lire la suite de l'article par Patrick Guimonet ASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHEASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHE par fathi
Tout le monde est unanime pour dire que la programmation multi-thread et asynchrone est en train de devenir un sujet incontournable. Beaucoup de choses sont arrivées avec le framework 4 pour le code parallèle (TPL, PLinq,.) et bientôt, on va avoir l...
Cliquez pour lire la suite de l'article par fathi PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS !PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS ! par Etienne Margraff
J'ai récemment eu un problème pour obtenir l'intelliTrace sur un site web dans IIS. Il n'y avait pas de message d'erreur, rien dans le journal d'évènement Windows, et après 3 appels à une voyante, 2 visites chez un marabou, j'ai failli me résign...
Cliquez pour lire la suite de l'article par Etienne Margraff OFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONSOFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONS par junarnoalg
De nombreuses entreprises font le choix de SharePoint Online, service fourni au travers de l'offre de Microsoft Office 365. S'il est vrai que ce choix apporte un grand nombre d'avantages; rapidité de mise en œuvre, disponibilité, large couvertu...
Cliquez pour lire la suite de l'article par junarnoalg PRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGEPRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGE par richardc
http://www.c2idotnet.com/articles/presentation-des-api-rest-de-windows-azure-lister-les-comptes-de-storage
Désolé pour "toto", mais c2i existait avant blogs.developpeur.org et c'est mon site "officiel" ;-) ...
Cliquez pour lire la suite de l'article par richardc
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate 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
|