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
TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Arnault Nouvel et Antoine Dongois Le processus à prendre : Apprendre (découvrir la plateforme) Préparer (documenter l'historique et choisir la méthode de MAJ) Test (Test de MAJ) Implémenter (Effectuer la MAJ) Valid...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : LA PLEINIèRE DU SECOND JOURTECHDAYS PARIS 2010 : LA PLEINIèRE DU SECOND JOUR par ROMELARD Fabrice
Après un retour sur l'histoire des TechDays de Paris et le fait que ce soit le plus gros event MS au monde (du fait de sa gratuité), le président de MS France (Eric Boustoullier) a fait une présentation de la vision Microsoft pour les années à venir...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|