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 / Exemple :
'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.
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.