Accueil > > > AVI&MPXB3 - LECTEUR DIVX ET VCD-SVCD UTILISANT LE CONTRÔLE MEDIAPLAYER
AVI&MPXB3 - LECTEUR DIVX ET VCD-SVCD UTILISANT LE CONTRÔLE MEDIAPLAYER
Information sur la source
Description
Ce code permet la lecture de fichiers video DivX et VCD-SVCD utilisant le contrôle Media Player. Il permet la lecture du film en mode plein écran également. La fenêtre a un design assez sympa.
J'ai un problème avec les icones : une fenêtre ayant pour propriété BorderStyle à n'affiche pas son icone dans la barre des tâches, et c'est le cas avec ma Form. Quelqu'un peut-il m'indiquer ce qu'il faut faire ? (n'oubliez pas de voter !)
Source
- 'Ce projet utilise un contrôle MediaPlayer pour lire les fichiers video.
- 'Il fonctionne avec la nouvelle version de Windows Media Player pour Win98,
- 'à savoir WMP7. Je n'ai pas testé avec les anciènnes versions.
-
- Option Explicit
- Dim fichier As String, i As Integer
- 'fichier = fichier à lire i = compteur de boucle
-
- 'APIs pour le déplacement de la fenêtre
- Private Declare Function ReleaseCapture Lib "user32" () As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
-
- 'API pour afficher la fenêtre au 1er plan, indispensable pour le mode plein écran
- Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, _
- ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
- ByVal cy As Long, ByVal wFlags As Long)
-
-
-
- 'Procédure qui intervertit l'état actuel de la fenêtre lorsque l'on clique sur celle-ci :
- 'passage du mode fenêtré au mode plein écran et inversement
- Private Sub Form_Click()
- If Me.WindowState = vbNormal Then
- Me.WindowState = vbMaximized
- Else
- Me.WindowState = vbNormal
- End If
- End Sub
-
- 'Procédure qui permet de déplacer la fenêtre en mode fenêtré (appel des APIs)
- Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- 'Si on est en mode plein écran, on sort sans rien exécuter
- If Me.WindowState = vbMaximized Then Exit Sub
- Call ReleaseCapture
- Call SendMessage(hwnd, &HA1, 2, 0&)
- End Sub
-
-
- 'Procédure exécutée lorsque, on mode plein écran, on bouge la sourie,
- 'afin de faire apparaître la barre d'outils en bas de l'écran
- Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
- 'Si l'affichage est fenêtrée, on sort sans rien exécuter
- If Me.WindowState = vbNormal Then Exit Sub
- If Y > Me.Height - 500 Then
- 'Si on descend le curseur tout en bas de l'écran, la barre d'outils est affichée
- tlbCommande.Visible = True
- Else
- 'Sinon, on a plus qu'à remonter le curseur pour cacher la barre d'outils
- tlbCommande.Visible = False
- End If
- End Sub
-
-
- 'Procédure exécutés lors du passage du mode fenêtré en mode plein écran et inversement
- 'Visuellement, il ne se passe rien dans les autres cas (mode réduit, par exemple) !
- 'mais en interne, l'API SetWindowPos est appelé dans tous les cas
- Private Sub Form_Resize()
- 'Si le nouvel état (donc actuel) de la fenêtre est le mode fenêtré
- If Me.WindowState = vbNormal Then
- 'La fenêtre reprend son image de fond qui est le même que celui du PictureBox picFenetre
- Me.Picture = picFenetre.Picture
-
- 'Le contrôle MediaPlayer mplVideo reprend ses dimensiosn d'origine
- mplVideo.Top = 440
- mplVideo.Left = 330
- mplVideo.Height = 5000
- mplVideo.Width = 7000
-
- 'On "réactive" chacun des 3 "boutons" du groupe lblMenu (Réduire, Agrandir, Fermer),
- 'ainsi que le titre de la fenêtre (Index 0), en les rendant visibles
- For i = 0 To 3
- lblMenu(i).Visible = True
- Next
-
- 'On "réactive" chacun des 6 "boutons" du groupe lblCommande
- '(Play, Pause, Stop, Reverse, Forward, Open) en les rendant visibles
- For i = 0 To 5
- lblCommande(i).Visible = True
- Next
-
- 'On cache également la barre d'outils qui s'affiche en bas de l'écran en
- 'mode plein écran, au cas où l'on viendrait justement du mode plein écran
- tlbCommande.Visible = False
-
- 'Si le nouvel état (donc actuel) de la fenêtre est le mode plein écran
- ElseIf Me.WindowState = vbMaximized Then
- 'On éfface l'image de fond de la feuille pour laisser place à une couleur de fond noir
- 'déjà définie dans la fenêtre des propriétés de la feuille (BackColor = WindowFrame)
- Me.Picture = LoadPicture()
-
- 'On élargit les dimensions du contrôle MediaPlayer pour qu'il prenne tout l'écran
- mplVideo.Top = 700
- mplVideo.Left = 0
- mplVideo.Height = Me.Height - 1400
- mplVideo.Width = Me.Width
-
- 'On "désactive" chacun des 3 "boutons" du groupe lblMenu (Réduire, Agrandir, Fermer),
- 'ainsi que le titre de la fenêtre (Index 0), en les rendant invisibles
- For i = 0 To 3
- lblMenu(i).Visible = False
- Next
-
- 'On "désactive" chacun des 6 "boutons" du groupe lblCommande
- '(Play, Pause, Stop, Reverse, Forward, Open) en les rendant invisibles
- For i = 0 To 5
- lblCommande(i).Visible = False
- Next
- End If
- Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)
- End Sub
-
-
- 'Avant de quitter complètement le programme, on arrête un éventuel fichier en lecture
- Private Sub Form_Unload(Cancel As Integer)
- mplVideo.Stop
- End
- End Sub
-
-
- 'Procédure exécutée lorsque l'on clique sur les "boutons" de réduction,
- 'd'agrandissement ou de fermeture situés dans le coin supérieur droit de la fenêtre
- Private Sub lblMenu_Click(Index As Integer)
- Select Case Index
- Case 1 'Réduire dans la barre des tâches
- Me.WindowState = vbMinimized
- Case 2 'Agrandir en mode plein écran
- Me.WindowState = vbMaximized
- Case 3 'Fermer le programme
- Unload Me
- End Select
- End Sub
-
-
- Private Sub lblCommande_Click(Index As Integer)
- 'Pause et Stop provoquent parfois des erreurs !?!
- On Error Resume Next
- Select Case Index
- Case 0 'Play
- 'Si aucun fichier à lire n'a été sélectionné, on prévient l'utilisateur puis on sort
- If fichier = "" Then
- MsgBox "Aucun fichier sélectionné !" & vbCrLf & "Ouvrez d'abords un fichier", _
- vbOKOnly + vbExclamation, App.EXEName & " : avertissement !"
- Exit Sub
- End If
- mplVideo.Play
- Case 1 'Pause
- mplVideo.Pause
- Case 2 'Stop
- mplVideo.Stop
- mplVideo.FileName = fichier
- Case 3 'Reverse
- mplVideo.FastReverse
- Case 4 'Forward
- mplVideo.FastForward
- Case 5 'Open
- dlgOuvrir.ShowOpen
- fichier = dlgOuvrir.FileName
- 'Si aucun fichier sélectionné, on sort sans rien effectuer
- If fichier = "" Then Exit Sub
- mplVideo.FileName = fichier
- 'On affiche le contrôle MediaPlayer seulement si un fichier est sélectionné
- mplVideo.Visible = True
- End Select
- End Sub
-
-
- 'Procédure exécutée lorsque l'on clique sur un bouton de la barre d'outils qui apparaît
- 'en bas en mode plein écran lorsque l'on fait descendre le curseur en bas de l'écran
- Private Sub tlbCommande_ButtonClick(ByVal Button As MSComctlLib.Button)
- If Button.Index < 5 Then
- 'Lors d'un click sur l'un des 3 premiers boutons (Reduire, Restaurer, Fermer)
- Select Case Button.Index
- Case 1: Me.WindowState = vbMinimized 'Réduire dans la barre des tâches
- Case 2: Me.WindowState = vbNormal 'Restaurer en mode fenêtré
- Case 3: Unload Me 'Fermer le programme
- End Select
- Else
- 'Lors d'un click sur l'un des 6 autres boutons, on appelle la procédure lblCommande_Click
- 'qui contient déjà les routines à exécuter pour chacun de ces 6 boutons (pour ne pas tout réecrire)
- 'L'index du bouton "Play" est "5" mais il correspond à l'index "0" pour le lblCommande, d'où
- Call lblCommande_Click(Button.Index - 5)
- End If
- End Sub
-
'Ce projet utilise un contrôle MediaPlayer pour lire les fichiers video.
'Il fonctionne avec la nouvelle version de Windows Media Player pour Win98,
'à savoir WMP7. Je n'ai pas testé avec les anciènnes versions.
Option Explicit
Dim fichier As String, i As Integer
'fichier = fichier à lire i = compteur de boucle
'APIs pour le déplacement de la fenêtre
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'API pour afficher la fenêtre au 1er plan, indispensable pour le mode plein écran
Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long)
'Procédure qui intervertit l'état actuel de la fenêtre lorsque l'on clique sur celle-ci :
'passage du mode fenêtré au mode plein écran et inversement
Private Sub Form_Click()
If Me.WindowState = vbNormal Then
Me.WindowState = vbMaximized
Else
Me.WindowState = vbNormal
End If
End Sub
'Procédure qui permet de déplacer la fenêtre en mode fenêtré (appel des APIs)
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Si on est en mode plein écran, on sort sans rien exécuter
If Me.WindowState = vbMaximized Then Exit Sub
Call ReleaseCapture
Call SendMessage(hwnd, &HA1, 2, 0&)
End Sub
'Procédure exécutée lorsque, on mode plein écran, on bouge la sourie,
'afin de faire apparaître la barre d'outils en bas de l'écran
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Si l'affichage est fenêtrée, on sort sans rien exécuter
If Me.WindowState = vbNormal Then Exit Sub
If Y > Me.Height - 500 Then
'Si on descend le curseur tout en bas de l'écran, la barre d'outils est affichée
tlbCommande.Visible = True
Else
'Sinon, on a plus qu'à remonter le curseur pour cacher la barre d'outils
tlbCommande.Visible = False
End If
End Sub
'Procédure exécutés lors du passage du mode fenêtré en mode plein écran et inversement
'Visuellement, il ne se passe rien dans les autres cas (mode réduit, par exemple) !
'mais en interne, l'API SetWindowPos est appelé dans tous les cas
Private Sub Form_Resize()
'Si le nouvel état (donc actuel) de la fenêtre est le mode fenêtré
If Me.WindowState = vbNormal Then
'La fenêtre reprend son image de fond qui est le même que celui du PictureBox picFenetre
Me.Picture = picFenetre.Picture
'Le contrôle MediaPlayer mplVideo reprend ses dimensiosn d'origine
mplVideo.Top = 440
mplVideo.Left = 330
mplVideo.Height = 5000
mplVideo.Width = 7000
'On "réactive" chacun des 3 "boutons" du groupe lblMenu (Réduire, Agrandir, Fermer),
'ainsi que le titre de la fenêtre (Index 0), en les rendant visibles
For i = 0 To 3
lblMenu(i).Visible = True
Next
'On "réactive" chacun des 6 "boutons" du groupe lblCommande
'(Play, Pause, Stop, Reverse, Forward, Open) en les rendant visibles
For i = 0 To 5
lblCommande(i).Visible = True
Next
'On cache également la barre d'outils qui s'affiche en bas de l'écran en
'mode plein écran, au cas où l'on viendrait justement du mode plein écran
tlbCommande.Visible = False
'Si le nouvel état (donc actuel) de la fenêtre est le mode plein écran
ElseIf Me.WindowState = vbMaximized Then
'On éfface l'image de fond de la feuille pour laisser place à une couleur de fond noir
'déjà définie dans la fenêtre des propriétés de la feuille (BackColor = WindowFrame)
Me.Picture = LoadPicture()
'On élargit les dimensions du contrôle MediaPlayer pour qu'il prenne tout l'écran
mplVideo.Top = 700
mplVideo.Left = 0
mplVideo.Height = Me.Height - 1400
mplVideo.Width = Me.Width
'On "désactive" chacun des 3 "boutons" du groupe lblMenu (Réduire, Agrandir, Fermer),
'ainsi que le titre de la fenêtre (Index 0), en les rendant invisibles
For i = 0 To 3
lblMenu(i).Visible = False
Next
'On "désactive" chacun des 6 "boutons" du groupe lblCommande
'(Play, Pause, Stop, Reverse, Forward, Open) en les rendant invisibles
For i = 0 To 5
lblCommande(i).Visible = False
Next
End If
Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 + &H1 + &H40)
End Sub
'Avant de quitter complètement le programme, on arrête un éventuel fichier en lecture
Private Sub Form_Unload(Cancel As Integer)
mplVideo.Stop
End
End Sub
'Procédure exécutée lorsque l'on clique sur les "boutons" de réduction,
'd'agrandissement ou de fermeture situés dans le coin supérieur droit de la fenêtre
Private Sub lblMenu_Click(Index As Integer)
Select Case Index
Case 1 'Réduire dans la barre des tâches
Me.WindowState = vbMinimized
Case 2 'Agrandir en mode plein écran
Me.WindowState = vbMaximized
Case 3 'Fermer le programme
Unload Me
End Select
End Sub
Private Sub lblCommande_Click(Index As Integer)
'Pause et Stop provoquent parfois des erreurs !?!
On Error Resume Next
Select Case Index
Case 0 'Play
'Si aucun fichier à lire n'a été sélectionné, on prévient l'utilisateur puis on sort
If fichier = "" Then
MsgBox "Aucun fichier sélectionné !" & vbCrLf & "Ouvrez d'abords un fichier", _
vbOKOnly + vbExclamation, App.EXEName & " : avertissement !"
Exit Sub
End If
mplVideo.Play
Case 1 'Pause
mplVideo.Pause
Case 2 'Stop
mplVideo.Stop
mplVideo.FileName = fichier
Case 3 'Reverse
mplVideo.FastReverse
Case 4 'Forward
mplVideo.FastForward
Case 5 'Open
dlgOuvrir.ShowOpen
fichier = dlgOuvrir.FileName
'Si aucun fichier sélectionné, on sort sans rien effectuer
If fichier = "" Then Exit Sub
mplVideo.FileName = fichier
'On affiche le contrôle MediaPlayer seulement si un fichier est sélectionné
mplVideo.Visible = True
End Select
End Sub
'Procédure exécutée lorsque l'on clique sur un bouton de la barre d'outils qui apparaît
'en bas en mode plein écran lorsque l'on fait descendre le curseur en bas de l'écran
Private Sub tlbCommande_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Index < 5 Then
'Lors d'un click sur l'un des 3 premiers boutons (Reduire, Restaurer, Fermer)
Select Case Button.Index
Case 1: Me.WindowState = vbMinimized 'Réduire dans la barre des tâches
Case 2: Me.WindowState = vbNormal 'Restaurer en mode fenêtré
Case 3: Unload Me 'Fermer le programme
End Select
Else
'Lors d'un click sur l'un des 6 autres boutons, on appelle la procédure lblCommande_Click
'qui contient déjà les routines à exécuter pour chacun de ces 6 boutons (pour ne pas tout réecrire)
'L'index du bouton "Play" est "5" mais il correspond à l'index "0" pour le lblCommande, d'où
Call lblCommande_Click(Button.Index - 5)
End If
End Sub
Conclusion
Si quelqu'un peut me dire comment faire pour montrer l'icone d'une fenêtre ayant pour propriété BorderStyle à 0 dans la barre des tâches, je le rajouterai dans la prochaine version.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|