|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 LECTEUR VIDEO (MULTIMEDIA) SANS OCX NI WMP - COMPLET
 Information sur la source
 Description
Il y a déja 30 lecteurs multimédia sur vbfrance. Celui-ci se veux très simple et n'utilise pas d'ocx. Néanmoins il intègre toutes les fonctionnalités d'un windows media player : lecture / pause / stop / slideshow / mute / toujours visible / parcours de la vidéo / zoom & stretch / capture / vitesse de lecture / volume interne (L'interface est simple pour vous éviter de lire des lignes de codes inutile) il utilise mciSendStringA() pour gérer les fichiers multimédia (rien de neuf...) En outre il récupère quelques infos sur la vidéo en cours tel que le code FOURCC du codec utilisé ainsi que la résolution (fichiers avi, mpg, asf et wmv).
 Source
- 'chargez le zip
- '
- 'mode d'emploi :
- 'Cliquez sur "Changer de dossier"
- 'Choississez un dossier contenant une ou plusieurs vidéo
- 'Double-cliquez sur le nom du fichier que vous voulez lire
- '
- 'Lorsqu'il aura fini de lire le fichier, le programme sautera automatiquement au fichier suivant (en gros, c'est un slideshow de vidéo)
- '
- 'appuyer sur F10 lorsque la filelistbox a le focus pour afficher tout les fichiers multimédia du dossier ouvert.
-
- '*******************
- ' FRAGMENT DE CODE
- '*******************
- 'API nécessaire :
-
- Private Declare Function mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
- 'récupère le nom 8.3 msdos (sans espaces)
- Private Declare Function GetShortPathNameA Lib "kernel32" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
-
- 'Déclaration générale nécessaire :
- Private AliasToUse As String
-
- Private VidHeight As Long
- Private VidWidth As Long
-
- Private Duree As Long
- Private Position As Long
-
-
- '=======================================
- 'ouvrir un fichier :
- Sub OuvrirMM(NomFichierLong As String)
- Dim BufferNom As String * 255
- Dim BufferLen As Long
- BufferLen = GetShortPathNameA(NomFichierLong, BufferNom, 255)
- NomFichierCourt$ = Left$(BufferNom, BufferLen)
-
- CmdStr = "open MPEGVideo!" & NomFichierCourt & " alias " & AliasToUse & " parent " & Picture1.hWnd & " Style " & CStr(&H40000000)
-
- mciSendStringA CmdStr, 0&, 0&, 0&
- End Sub
-
-
- '=======================================
- 'récuperer la durée :
- Sub RetDureeMM()
- Call mciSendStringA("set " & AliasToUse & " time format milliseconds", 0, 0, 0)
- Dim TDur As String * 128
- Call mciSendStringA("status " & AliasToUse & " length", TDur, 128, 0)
- Duree = Val(TDur)
- End Sub
-
-
- '=======================================
- 'commence la lecture depuis le début :
- Sub JoueMM()
- mciSendStringA "play " & AliasToUse & " from 0", 0, 0, 0
- End Sub
-
- '=======================================
- 'commence la lecture depuis une position :
- Sub ReJoueMM(NouvellePos As Long)
- mciSendStringA "play " & AliasToUse & " from " & NouvellePos, 0, 0, 0
- End Sub
-
- '=======================================
- 'stopper la lecture :
- Sub StopMM()
- mciSendStringA "stop " & AliasToUse, 0, 0, 0
- End Sub
-
-
- '=======================================
- 'récupère la position de la lecture en cours :
- Sub RetPositionMM()
- Dim TPos As String * 32
- mciSendStringA "status " & AliasToUse & " position notify", TPos, 32, &H2)
- Position = Val(TPos)
- End Sub
-
- '=======================================
- '"se déplaçer" dans le fichier :
- Sub RePositionMM(NouvellePos As Long)
- mciSendStringA "seek " & AliasToUse & " to " & NouvellePos, 0, 0, 0
- End Sub
-
-
- '=======================================
- 'couper / remettre le son :
- Sub CoupeSonMM(Oui As Boolean)
- Select Case Oui
- Case True
- mciSendStringA "set " & AliasToUse & " audio all off", 0, 0, 0
- Case Fasle
- mciSendStringA "set " & AliasToUse & " audio all on", 0, 0, 0
- End Select
- End Sub
-
-
- '=======================================
- 'récuperer la hauteur et la largeur de la vidéo :
- Sub RetTailleMM()
- Dim MaxXY As String * 128
- Dim MaxXY2 As String
- Call mciSendStringA("where " & AliasToUse & " destination", MaxXY, 128, 0)
-
- MaxXY2 = Left(TDur, InStr(1, MaxXY, Chr$(0)) - 1)
- MaxXY2 = Trim(MaxXY2)
- If Len(MaxXY2) > 1 Then
- p1 = InStrRev(MaxXY2, " ")
- VidHeight = Val(Mid(MaxXY2, p1 + 1))
- p2 = InStrRev(MaxXY2, " ", p1 - 1)
- VidWidth = Val(Mid(MaxXY2, p2 + 1, p1 - p2 - 1))
- End If
- End Sub
-
- '=======================================
- 'redimensionner la fenêtre (zoom, stretch)
- Sub RedimensionneMM(NouvLarg As Long, NouvHaut As Long)
- st$ = NouvLarg & " " & NouvHaut
- mciSendStringA "put " & AliasToUse & " window at 0 0 " & st$, 0, 0, 0
- mciSendStringA "put " & AliasToUse & " destination at 0 0 " & st$, 0, 0, 0
- End Sub
-
- '=======================================
- 'regler la vitesse de lecture (1000 = vitesse 1x, 500 = 0.5x)
- Sub VitesseMM(NouveauFacteur As Long)
- mciSendStringA "set " & AliasToUse & " speed " & NouveauFacteur, 0, 0, 0
- End Sub
-
- '=======================================
- 'regler le volume interne (et non de windows)
- '(1000 = nominal, 500 = 2 fois moins fort)
- Sub VolumeMM(NouveauFacteur As Long)
- mciSendStringA "setaudio " & AliasToUse & " volume to " & NouveauFacteur, 0, 0, 0
- End Sub
-
'chargez le zip
'
'mode d'emploi :
'Cliquez sur "Changer de dossier"
'Choississez un dossier contenant une ou plusieurs vidéo
'Double-cliquez sur le nom du fichier que vous voulez lire
'
'Lorsqu'il aura fini de lire le fichier, le programme sautera automatiquement au fichier suivant (en gros, c'est un slideshow de vidéo)
'
'appuyer sur F10 lorsque la filelistbox a le focus pour afficher tout les fichiers multimédia du dossier ouvert.
'*******************
' FRAGMENT DE CODE
'*******************
'API nécessaire :
Private Declare Function mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'récupère le nom 8.3 msdos (sans espaces)
Private Declare Function GetShortPathNameA Lib "kernel32" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'Déclaration générale nécessaire :
Private AliasToUse As String
Private VidHeight As Long
Private VidWidth As Long
Private Duree As Long
Private Position As Long
'=======================================
'ouvrir un fichier :
Sub OuvrirMM(NomFichierLong As String)
Dim BufferNom As String * 255
Dim BufferLen As Long
BufferLen = GetShortPathNameA(NomFichierLong, BufferNom, 255)
NomFichierCourt$ = Left$(BufferNom, BufferLen)
CmdStr = "open MPEGVideo!" & NomFichierCourt & " alias " & AliasToUse & " parent " & Picture1.hWnd & " Style " & CStr(&H40000000)
mciSendStringA CmdStr, 0&, 0&, 0&
End Sub
'=======================================
'récuperer la durée :
Sub RetDureeMM()
Call mciSendStringA("set " & AliasToUse & " time format milliseconds", 0, 0, 0)
Dim TDur As String * 128
Call mciSendStringA("status " & AliasToUse & " length", TDur, 128, 0)
Duree = Val(TDur)
End Sub
'=======================================
'commence la lecture depuis le début :
Sub JoueMM()
mciSendStringA "play " & AliasToUse & " from 0", 0, 0, 0
End Sub
'=======================================
'commence la lecture depuis une position :
Sub ReJoueMM(NouvellePos As Long)
mciSendStringA "play " & AliasToUse & " from " & NouvellePos, 0, 0, 0
End Sub
'=======================================
'stopper la lecture :
Sub StopMM()
mciSendStringA "stop " & AliasToUse, 0, 0, 0
End Sub
'=======================================
'récupère la position de la lecture en cours :
Sub RetPositionMM()
Dim TPos As String * 32
mciSendStringA "status " & AliasToUse & " position notify", TPos, 32, &H2)
Position = Val(TPos)
End Sub
'=======================================
'"se déplaçer" dans le fichier :
Sub RePositionMM(NouvellePos As Long)
mciSendStringA "seek " & AliasToUse & " to " & NouvellePos, 0, 0, 0
End Sub
'=======================================
'couper / remettre le son :
Sub CoupeSonMM(Oui As Boolean)
Select Case Oui
Case True
mciSendStringA "set " & AliasToUse & " audio all off", 0, 0, 0
Case Fasle
mciSendStringA "set " & AliasToUse & " audio all on", 0, 0, 0
End Select
End Sub
'=======================================
'récuperer la hauteur et la largeur de la vidéo :
Sub RetTailleMM()
Dim MaxXY As String * 128
Dim MaxXY2 As String
Call mciSendStringA("where " & AliasToUse & " destination", MaxXY, 128, 0)
MaxXY2 = Left(TDur, InStr(1, MaxXY, Chr$(0)) - 1)
MaxXY2 = Trim(MaxXY2)
If Len(MaxXY2) > 1 Then
p1 = InStrRev(MaxXY2, " ")
VidHeight = Val(Mid(MaxXY2, p1 + 1))
p2 = InStrRev(MaxXY2, " ", p1 - 1)
VidWidth = Val(Mid(MaxXY2, p2 + 1, p1 - p2 - 1))
End If
End Sub
'=======================================
'redimensionner la fenêtre (zoom, stretch)
Sub RedimensionneMM(NouvLarg As Long, NouvHaut As Long)
st$ = NouvLarg & " " & NouvHaut
mciSendStringA "put " & AliasToUse & " window at 0 0 " & st$, 0, 0, 0
mciSendStringA "put " & AliasToUse & " destination at 0 0 " & st$, 0, 0, 0
End Sub
'=======================================
'regler la vitesse de lecture (1000 = vitesse 1x, 500 = 0.5x)
Sub VitesseMM(NouveauFacteur As Long)
mciSendStringA "set " & AliasToUse & " speed " & NouveauFacteur, 0, 0, 0
End Sub
'=======================================
'regler le volume interne (et non de windows)
'(1000 = nominal, 500 = 2 fois moins fort)
Sub VolumeMM(NouveauFacteur As Long)
mciSendStringA "setaudio " & AliasToUse & " volume to " & NouveauFacteur, 0, 0, 0
End Sub
 Conclusion
MISE A JOUR : - réglage du volume interne et non windows wave - réglage de la vitesse de lecture. - capture une image de la vidéo (ça ne marche pas tout le temps, pourtant la théorie est bonne) - regarder le readme.txt dans le zip pour le détail des fonctionnalités. - autodétermination du vrai format du fichier - resize de la fenêtre vidéo! soit vous gardez les proportions, soit vous l'étirer sur toute la form. Attention, les fichiers types divx semble ne pas appréçier l'opération. - progressbar 100% débogué - une information détaillé sur le codec en cours - la progressbar change de couleur au fur et a mesure de la progression (a vous de décider la couleur initiale et finale!) - erreur division par zéro et autres lorsque le fichier vidéo est corrompu > fixé BOGUES : - aucun connu. La vidéo du screenshot n'est pas dans le zip ;)
 Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
 Télécharger le zip
 Sources du même auteur
 Sources de la même categorie
 Commentaires et avis
|
|