Placer une montre avec aiguille dans un programme
lolocdm
Messages postés
2
Date d'inscription
samedi 26 septembre 2009
Statut
Membre
Dernière intervention
18 octobre 2009
-
30 sept. 2009 à 20:19
c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 - 2 oct. 2009 à 12:58
c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 - 2 oct. 2009 à 12:58
A voir également:
- Placer une montre avec aiguille dans un programme
- Applications et programme d'interface - Conseils pratiques -Graphisme
- Un programme tente d'envoyer un courrier en votre nom - Forum Visual Basic 6
- Placer boule billard - Forum Visual Basic 6
- Écrire un programme qui calcule la moyenne des notes - Forum C
- Programme python jeu mario ✓ - Forum Python
4 réponses
cs_Nurgle
Messages postés
1642
Date d'inscription
samedi 6 novembre 2004
Statut
Membre
Dernière intervention
28 avril 2011
4
1 oct. 2009 à 01:24
1 oct. 2009 à 01:24
Salut,
Tel que c'est demandé, je ne vois aucun rapport avec ASP.NET !
Sujet déplacé de aspfr vers vbfrance section VBA.
Cordialement,
Nurgle
Tel que c'est demandé, je ne vois aucun rapport avec ASP.NET !
Sujet déplacé de aspfr vers vbfrance section VBA.
Cordialement,
Nurgle
c148270
Messages postés
303
Date d'inscription
mercredi 12 janvier 2005
Statut
Membre
Dernière intervention
3 octobre 2013
1
1 oct. 2009 à 08:44
1 oct. 2009 à 08:44
Bonjour
Voici un exemple pour .avi et .wav
-----------------------------------------------
Function Debtestconnect()
retval = fPlayStuff("d:\lsd\clock.avi")
End Function
Function Fintestconnect()
retval = fStopStuff("d:\lsd\clock.avi")
End Function
Function Erreur()
retval = fPlayStuff("C:\winnt\\media\notify.wav")
End Function
Function Interdit()
retval = fPlayStuff("C:\winnt\\media\ringin.wav")
End Function
Option Compare Database
'****************** Code Start *********************'
Public Const pcsSYNC = 0 ' on désire attendre jusqu'à ce que ce soit terminé
Public Const pcsASYNC = 1 ' on ne désire pas attendre la fin pour poursuivre l'exécution du code
Public Const pcsNODEFAULT = 2 ' ne joue aucun son si le son n'existe pas
Public Const pcsLOOP = 8 ' joue en boucle infinie (jusqu'à la prochaine demande d'exécution)
Public Const pcsNOSTOP = 16 ' ne pas interrompre un son qui a commencé
'Sound APIs
Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'AVI APIs
Private Declare Function apimciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function apimciGetErrorString Lib "Winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, _
ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Function fPlayStuff(ByVal strFilename As String, _
Optional intPlayMode As Integer) As Long
'DOIT utiliser un fichier AVEC son extension
'Supporte les types: Wav, AVI, MID
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "wav":
If Not IsMissing(intPlayMode) Then
lngRet = apiPlaySound(strFilename, intPlayMode)
Else
MsgBox "Must specify play mode."
Exit Function
End If
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
End Select
fPlayStuff = lngRet
End Function
Function fStopStuff(ByVal strFilename As String)
'Arrête le multimedia playback
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "Wav":
lngRet = apiPlaySound(0, pcsASYNC)
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("stop " & strFilename, strTemp, 255, 0)
End Select
fStopStuff = lngRet
End Function
Private Function fGetFileExt(ByVal strFullPath As String) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Trouve le dernier \
If Mid$(strFullPath, intPos, 1) = "." Then
fGetFileExt = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function
Function fGetError(ByVal lngErrNum As Long) As String
' Traduire l'erreur numérique en texte
Dim lngx As Long
Dim strErr As String
strErr = String$(256, 0)
lngx = apimciGetErrorString(lngErrNum, strErr, 255)
strErr = Left$(strErr, Len(strErr) - 1)
fGetError = strErr
End Function
Function Attention()
retval = fPlayStuff("C:\winnt\\media\ringout.wav")
End Function
Je ne me souviens pas si clock.avi est en standard(voir dans le répertoire windows) si non bonne recherche sur internet
Bonne journée
Voici un exemple pour .avi et .wav
-----------------------------------------------
Function Debtestconnect()
retval = fPlayStuff("d:\lsd\clock.avi")
End Function
Function Fintestconnect()
retval = fStopStuff("d:\lsd\clock.avi")
End Function
Function Erreur()
retval = fPlayStuff("C:\winnt\\media\notify.wav")
End Function
Function Interdit()
retval = fPlayStuff("C:\winnt\\media\ringin.wav")
End Function
Option Compare Database
'****************** Code Start *********************'
Public Const pcsSYNC = 0 ' on désire attendre jusqu'à ce que ce soit terminé
Public Const pcsASYNC = 1 ' on ne désire pas attendre la fin pour poursuivre l'exécution du code
Public Const pcsNODEFAULT = 2 ' ne joue aucun son si le son n'existe pas
Public Const pcsLOOP = 8 ' joue en boucle infinie (jusqu'à la prochaine demande d'exécution)
Public Const pcsNOSTOP = 16 ' ne pas interrompre un son qui a commencé
'Sound APIs
Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'AVI APIs
Private Declare Function apimciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function apimciGetErrorString Lib "Winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, _
ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Function fPlayStuff(ByVal strFilename As String, _
Optional intPlayMode As Integer) As Long
'DOIT utiliser un fichier AVEC son extension
'Supporte les types: Wav, AVI, MID
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "wav":
If Not IsMissing(intPlayMode) Then
lngRet = apiPlaySound(strFilename, intPlayMode)
Else
MsgBox "Must specify play mode."
Exit Function
End If
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
End Select
fPlayStuff = lngRet
End Function
Function fStopStuff(ByVal strFilename As String)
'Arrête le multimedia playback
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "Wav":
lngRet = apiPlaySound(0, pcsASYNC)
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("stop " & strFilename, strTemp, 255, 0)
End Select
fStopStuff = lngRet
End Function
Private Function fGetFileExt(ByVal strFullPath As String) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Trouve le dernier \
If Mid$(strFullPath, intPos, 1) = "." Then
fGetFileExt = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function
Function fGetError(ByVal lngErrNum As Long) As String
' Traduire l'erreur numérique en texte
Dim lngx As Long
Dim strErr As String
strErr = String$(256, 0)
lngx = apimciGetErrorString(lngErrNum, strErr, 255)
strErr = Left$(strErr, Len(strErr) - 1)
fGetError = strErr
End Function
Function Attention()
retval = fPlayStuff("C:\winnt\\media\ringout.wav")
End Function
Je ne me souviens pas si clock.avi est en standard(voir dans le répertoire windows) si non bonne recherche sur internet
Bonne journée
cs_Ayr
Messages postés
221
Date d'inscription
mercredi 9 avril 2003
Statut
Membre
Dernière intervention
13 décembre 2009
2
1 oct. 2009 à 10:44
1 oct. 2009 à 10:44
Bonjour,
Tu veux une montre factice qui ferait office de sablier le temps qu'un quelconque travail soit effectué où une vrai montre indiquant l'heure actuelle ?
Dans ce deuxième cas, je ne suis pas sur qu'une formule puisse faire ça...
Peux-tu donner cette formule ?
Tu veux une montre factice qui ferait office de sablier le temps qu'un quelconque travail soit effectué où une vrai montre indiquant l'heure actuelle ?
Dans ce deuxième cas, je ne suis pas sur qu'une formule puisse faire ça...
Peux-tu donner cette formule ?
c148270
Messages postés
303
Date d'inscription
mercredi 12 janvier 2005
Statut
Membre
Dernière intervention
3 octobre 2013
1
2 oct. 2009 à 12:58
2 oct. 2009 à 12:58
Bonjour
Clock avi est un chronomètre factice.
Il suffit de lancer la fonction fPlayStuff au debut du travail et fStopStuff en fin
Pour la vrai montre je ne sais pas
Bonne journée
Clock avi est un chronomètre factice.
Il suffit de lancer la fonction fPlayStuff au debut du travail et fStopStuff en fin
Pour la vrai montre je ne sais pas
Bonne journée
