Une horloge à aiguille dans un contrôle frame ou picture

Télécharger le projet
Commenter

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