Récupération du format d'une vidéo (width, height)

Résolu
Nnnico73 Messages postés 3 Date d'inscription mardi 10 novembre 2009 Statut Membre Dernière intervention 12 janvier 2010 - 11 janv. 2010 à 19:43
Nnnico73 Messages postés 3 Date d'inscription mardi 10 novembre 2009 Statut Membre Dernière intervention 12 janvier 2010 - 12 janv. 2010 à 17:58
Bonjour,

j'ai un petit souci avec un code vba je m'explique.

J'aimerai récupérer beaucoup d'information de fichier vidéo situé sur mon ordi mais je bloque. J'ai grâce au forum pu récupérer la durée de la vidéo mais j'aimerai pouvoir récupérer d'autres information dont la hauteur/largeur du fichier vidéo.

voici le code que j'ai pu trouver pour la durée du fichier vidéo :

'API Windows Multimedia à laquelle on envoit des commandes
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long


Private Function DureeFichier(sFichier As String) As String
'On crée un buffer de 128
    Dim sRetString As String * 128
    On Error Resume Next
    
'on ferme fichier au cas où il serait ouvert
    mciSendString "close sFichier", 0, 0, 0
'on ouvre le fichier passé en paramètre
    mciSendString "open """ & sFichier & """ type MPEGVideo alias fichier", 0, 0, 0
'on règle le format temporel sur milliseconde
    mciSendString "set fichier time format ms", 0, 0, 0
'on récupère la durée du fichier dans le buffer
    mciSendString "status fichier length", sRetString, 128, 0
'on passe cette durée à la fonction FormatTemps et on l'affecte à la valeur de notre fonction
    DureeFichier = FormatTemps(CDbl(Replace(sRetString, Chr(0), "") / 1000))
'et enfin on ferme fichier
    mciSendString "close fichier", 0, 0, 0

End Function


La fonction FormatTemps me permet de convertir les ms en hh:mm:ss.

J'ai cherché un peu partout (msdn, codes-sources, ...) mais aucun moyen de trouvé une explication qui me permettrait d'avoir quelques chose du style
mciSendString "status fichier width", Largeur, 128, 0
mciSendString "status fichier height", Hauteur, 128, 0


Est ce que quelqu'un pourrais m'aiguiller, faut il utiliser une autre librairie (wmplib) ?

Merci par avance.

3 réponses

Nnnico73 Messages postés 3 Date d'inscription mardi 10 novembre 2009 Statut Membre Dernière intervention 12 janvier 2010
12 janv. 2010 à 17:58
En premier lieu merci de ta réponse.

Je viens de le voir mais je me suis trompé de section ce n'est pas du vb6 sur quoi je programme mais du vba pour excel mais je pense que le code doit être similaire.

Comme le dit le vieux proverbe la nuit porte conseil j'ai donc résolu mon problème. Pour info je laisse le code que j'utilise des fois que ça aide quelqu'un :


'API Windows Multimedia à laquelle on envoit des commandes
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Dim sFichier As String
Dim MaxXY As String * 128
Dim MaxXY2 As String
Dim Height As Long
Dim Width As Long

Private Function DureeFichier(sFichier As String) As String
'On crée un buffer de 128
    Dim sRetString As String * 128
    On Error Resume Next
    
'on ferme fichier au cas où il serait ouvert
    mciSendString "close sFichier", 0, 0, 0
'on ouvre le fichier passé en paramètre
    mciSendString "open """ & sFichier & """ type MPEGVideo alias fichier", 0, 0, 0
'on règle le format temporel sur milliseconde
    mciSendString "set fichier time format ms", 0, 0, 0
'on récupère la durée du fichier dans le buffer
    mciSendString "status fichier length", sRetString, 128, 0
'On récupere les données d'hauteur et largeur de trame
    mciSendString "where fichier destination", MaxXY, 128, 0
    MaxXY2 = Left(MaxXY, InStr(1, MaxXY, Chr$(0)) - 1)
    MaxXY2 = Trim(MaxXY2)
    If Len(MaxXY2) > 1 Then
        p1 = InStrRev(MaxXY2, " ")
        Height = Val(Mid(MaxXY2, p1 + 1))
        p2 = InStrRev(MaxXY2, " ", p1 - 1)
        Width = Val(Mid(MaxXY2, p2 + 1, p1 - p2 - 1))
    End If
'on passe cette durée à la fonction FormatTemps et on l'affecte à la valeur de notre fonction
    DureeFichier = FormatTemps(CDbl(Replace(sRetString, Chr(0), "") / 1000))
'et enfin on ferme fichier
    mciSendString "close fichier", 0, 0, 0

End Function

Private Function FormatTemps(dTemps As Double) As String
'Fonction qui renvoie la durée formatée ainsi 00:00:00
    Dim lHeure As Long
    Dim lMinute As Long
    Dim lSeconde As Long
    Dim lTemps As Long

    lTemps = Round(dTemps)
    lHeure = Int(lTemps / 3600)
    lMinute = Int((lTemps - 3600 * lHeure) / 60)
    lSeconde = lTemps - 3600 * lHeure - 60 * lMinute
    FormatTemps = Format(lHeure, "00") & ":" & Format(lMinute, "00") & ":" & Format(lSeconde, "00")

End Function


Ce code n'est pas de moi hein!! j'aime pas m'attribuer le mérite des autres et de Google :p mais si ça intéresse quelqu'un au moins il est entier ici.

Merci à toi Renfield qui ma fait cherché un peu plus loin que le bout de mon nez.
3
Nnnico73 Messages postés 3 Date d'inscription mardi 10 novembre 2009 Statut Membre Dernière intervention 12 janvier 2010
11 janv. 2010 à 21:07
Je me répond à moi même sans pour autant résoudre mon souci.

J'ai trouvé ceci dans le forum qui je pense pourrai faire avancer le schmilblick :

Lecteur vidéo multimédia (Proger)

Je pense que la partie ou on récupère le format vidéo pourrai m'intéresser mais hélas j'ai quelques souci lorsque je l'intègre dans ma macro :'(

'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 
0
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
12 janv. 2010 à 09:16
le code semble coller, effectiveent.
quelques soucis.

lesquels ?

Renfield - Admin CodeS-SourceS - MVP Visual Basic
0
Rejoignez-nous