Alarme/reveil

Soyez le premier à donner votre avis sur cette source.

Vue 11 300 fois - Téléchargée 860 fois

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/

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
37
Date d'inscription
mardi 17 février 2004
Statut
Membre
Dernière intervention
20 mai 2016
1
Hello !

Très sympa, mais tu auras un problème si tu veux faire sonner ton alarme le lendemain matin...

Je m'explique:

si il est, admetton 19:00:00 et que tu veux une alarme à 5h00 du mat, ton alarme va sonner immédiatement, car la condition 'Hactu > Txthlim.Text Then Alert' est remplie...

pour contourner ce petit problème (c'est un peu bricole, c'est clair ... et on a un problème si on fixe les seconde à plus de 57 ... mais bon...)

On error resume next
If Hactu > Txthlim.Text And Hactu < Mid$(Txthlim.Text, 1, 6) & Val(Mid$(Txthlim.Text, 7, 2)) + 2 Then Alert

mais quand-même ... 8/10
Messages postés
5
Date d'inscription
samedi 21 décembre 2002
Statut
Membre
Dernière intervention
28 décembre 2002

chahmi 9/10 merci
Trop fort tes sites internet !
hum faux avoué ya plus facile et en moj de ligne !

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.