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 / Exemple :
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.
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.