AVI&MPXB3 - LECTEUR DIVX ET VCD-SVCD UTILISANT LE CONTRÔLE MEDIAPLAYER

'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
  

Télécharger le zip