Alarme/reveil

Télécharger le projet
Commenter

Description

Ce petit programme est une sorte d'alarme ou de réveil qui se déclenchera à l'heure souhaitée et émettra un son pour que vous ne soyez plus en retard.

Placer 2 TextBox Txthlim et Txthactu, 1 Bouton et 2 Timer.
Copier le code suivant dans le form.
Téléchargez le son d'alarme à cette adresse (il est inclu dans le ZIP) http://perso.wanadoo.fr/steffiaume/telechargement/alarme.wav .

Source / Exemple : 


Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_LOOP = &H8

Private Sub Command1_Click()
If Command1.Caption = "Lancer" Then
Txthactu.ForeColor = vbBlack
Txthlim.ForeColor = vbBlack
Command1.Caption = "Désactiver"
On Error GoTo erreur
Txthlim.Text = CDate(Txthlim.Text)
Timer2.Enabled = True
Exit Sub
erreur:
MsgBox "Erreur dans le format d'heure. Veuillez saisir une heure valide.", vbCritical, "Erreur..."
Command1.Caption = "Lancer"
Timer2.Enabled = False
Else
Command1.Caption = "Lancer"
Timer2.Enabled = False
End If
End Sub

Private Sub Alert()
sndPlaySound App.Path & "\alarme.wav", SND_ASYNC ' SND_LOOP Or
Txthactu.ForeColor = vbRed
Txthlim.ForeColor = vbRed
Form1.WindowState = 0
MsgBox "Alerte ! ! !", vbCritical, "Alerte"
Command1.Caption = "Lancer"
End Sub

Private Sub Form_Load()
With Form1
    .Width = 3030
    .Height = 1950
    .BorderStyle = 1
    .Caption = "Alarme"
End With
With Command1
    .Width = 1095
    .Height = 375
    .Top = 1080
    .Left = 840
    .Caption = "Lancer"
End With
With Timer1
    .Interval = 1000
End With
With Timer2
    .Interval = 1000
    .Enabled = False
End With
With Txthactu
    .Width = 1215
    .Height = 405
    .Top = 120
    .Left = 1440
    .Text = ""
    .Font.Size = "14"
    .Enabled = False
End With
With Txthlim
    .Width = 1695
    .Height = 405
    .Top = 600
    .Left = 1200
    .Text = "HH:MM:SS"
    .MaxLength = 8
    .Font.Size = "14"
End With

End Sub

Private Sub Timer2_Timer()
If Command1.Caption = "Désactiver" Then
    Dim Hactu As Date, Hlim As Date
    Hactu = Time
    Hlim = Txthlim.Text
    If Hactu > Txthlim.Text Then Alert
End If
End Sub

Private Sub Timer1_Timer()
Txthactu.Text = Time
End Sub

Private Sub Txthlim_Click()
With Txthlim
    .Width = 1215
    .Height = 405
    .Left = 1440
    .Text = ""
End With
End Sub

Conclusion :


N'oubliez pas de visiter mes sites : http://perso.wanadoo.fr/steffiaume/ et http://troccd.ifrance.com/
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.

Du même auteur (Steffiaume)