Lecteur multimedia (mp3,avi,au...)/manipulation des listes

Télécharger le projet
Commenter
Description

lecteur multemedia pas comme winamp mais ca peut aider les débutants comme moi à manipuler les listes ,les fichier ,controle de saisi ,lecture des fichiers multimedia...
Source / Exemple :

'Form1************************
Dim minutes As Integer   'minutes de temps écoulé
Dim secondes As Integer    ' secodes de temps écoulé
Dim indexplay As Integer    ' index du piste en cours
Dim silente As Boolean          ' l'etat du silence activé ou non
Dim pausee As Boolean
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Function WndSetOpacity(ByVal hWnd As Long, Optional ByVal crKey As Long = vbBlack, Optional ByVal Alpha As Byte = 255, Optional ByVal ByAlpha As Boolean = True) As Boolean
'Return : True si il n'y a pas eu d'erreur.
'hWnd    : hWnd de la fenêtre à rendre transparente
'crKey : Couleur à rendre transparente si ByAlpha=False (utiliser soit les constantes vb:vbWhite ou en hexa:&HFFFFFF)
'Alpha : 0-255 0=transparent 255=Opaque si ByAlpha=true (défaut)
    Dim ExStyle As Long
    ExStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    If ExStyle <> (ExStyle Or WS_EX_LAYERED) Then
        ExStyle = (ExStyle Or WS_EX_LAYERED)
        Call SetWindowLong(hWnd, GWL_EXSTYLE, ExStyle)
    End If
    WndSetOpacity = (SetLayeredWindowAttributes(hWnd, crKey, Alpha, IIf(ByAlpha, LWA_ALPHA, LWA_COLORKEY)) <> 0)
End Function
Private Sub cmdaddfiles_Click()
On Error Resume Next
Form2.Show
End Sub
Private Sub cmddeplacer_Click()
On Error GoTo err
Dim alire2 As String
Dim ind As Integer
Dim pos2 As Integer
Dim s As String
Dim chaine As String
 poin = "."    ' le nom de fichier commence apres le point
 indexcour = List1.ListIndex      ' index du elément sélectionné ds la liste
  Y = List1.List(indexcour)          ' garder l' élément sélectionné (nom fichier)  de list1 ds y
  z = List2.List(indexcour)           'garder l' élément sélectionné (chemin de fichier)  de list2 ds z
ind = (InputBox("tapez le N° de l'emplacement : ", "Bilel Player") - 1)
If (ind < 0) Or (ind > (List1.ListCount - 1)) Then
        MsgBox "emplacement erroné!", vbOKOnly, "Bilel Player"    ' nouvo emplacement non valide
       Exit Sub
 End If
List1.RemoveItem indexcour        'suuprimer l'élement à deplacer
List2.RemoveItem indexcour       'suuprimer son chemin de la list2
List1.AddItem Y, ind                      ' ajouter sa copie ds le nouvo emplacement(ind)
List2.AddItem z, ind                       'ajouter sa copie de chemin ds l'emplacement correspondant (ind)ds list2
    
    '******la liste est numéroté en ordre  ---> apres le déplacement réordonner la liste********
For i = 0 To (List1.ListCount - 1)
      s = List1.List(i)       'réservé l'element i de liste
        pos2 = InStr(List1.List(i), poin)             'determiner la pos de point ds l'element
       alire2 = Right(s, (Len(List1.List(i)) - pos2))      'mettre ds alire2  juste le nom de fichier
       chaine = Str(i + 1) + "  ." + alire2                          ' preceder le nom de fichier par un numero d'ordre ds la liste et un point
       List1.RemoveItem i                                               'supprimer l'element i
       List1.AddItem chaine, i                                          'le rendre ds la liste avec le nouvo num ds la liste
Next
err:  Exit Sub
End Sub
Private Sub cmdexit_Click()
On Error Resume Next
    MMControl1.Notify = False
    MMControl1.Wait = True
    MMControl1.Command = "Close"   'fermer le pereferik avant de sortir
    Open "c:\flist1.txt" For Output As #1       ' créer 2 fichiers pour sovgarder les listes avan de kitter
    Open "c:\flist2.txt" For Output As #2      'pour les trouver ds le prochin lancement de prog
    For i = 0 To (List1.ListCount - 1)
      Print #1, List1.List(i)       ' sovgarder la liste des fichiers ds flist1
      Print #2, List2.List(i)       'sovgarder la liste des chemins ds flist2
    Next
    Close #1
    Close #2
    End
End Sub

Private Sub cmdfind_Click()       'recherce un élement ds la liste et le selectionne
Dim rech As String                'chaine recherchée
Dim item As String               ' pour copier l'élément
Dim i As Integer
Dim trouve As Boolean        'pour sortir de la boucle
trouve = False
i = 0     'pour lma boucle while
rech = (InputBox(" tapez le nom du chonson ou une  partie du mot a cherché  :", "Bilel Player"))
While Not trouve And i < List1.ListCount
       item = List1.List(i)
       pos = InStr(1, item, rech, 1)
       If pos > 0 Then      'trouvé
                      trouve = True
                      List1.selected(i) = True   'selectionner l' element
        End If
        i = i + 1
Wend
If Not trouve Then
    MsgBox "chaine introuvable", vbOKOnly, "Bilel Player"
End If
End Sub

Private Sub cmdnext_Click()
MMControl1.Command = "Next"
End Sub

Private Sub cmdp2_Click()
Call cmdplay_Click
End Sub

Private Sub cmdpause_Click()
On Error Resume Next
MMControl1.Command = "Pause"
If tmrtempsecoule.Enabled = True Then
           tmrtempsecoule.Enabled = False
           If Label1.Caption <> "silent" Then
                       Label1 = "Pause"
            End If
            pausee = True
          Else
               tmrtempsecoule.Enabled = True
               If Label1 <> "silent" Then
               Label1 = ""
               End If
                pausee = False
End If
End Sub

Private Sub cmdpause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Visible = True
End Sub

Private Sub cmdpause_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Visible = False
Call cmdpause_Click
End Sub

Private Sub cmdplay_Click()
   On Error Resume Next

    hsc.Value = 1                 ' mettre le hscrollbarr au debut
     poin = "."
    pos = InStr(List1.Text, poin)          'position de poin ds l'element de liste
    alire = Right(List1.Text, (Len(List1.Text) - pos))       ' lire juste le nom de fichier on enlevan le num et le poin
     lblnowplay = List1.Text
    lbltime.Caption = "00:00"
    secondes = 0
    minutes = 0
   MMControl1.Command = "Close"
    nom = List2.Text + "\" + alire       ' nom = chemin de fichier + \+ nom fichier = chemin complet à lire
    MMControl1.FileName = nom
    MMControl1.Command = "Open"
    MMControl1.Notify = False
    MMControl1.Wait = False
    MMControl1.Command = "Play"
    tmrtempsecoule.Enabled = True
    tmrnextpiste.Enabled = True
    Timer4.Enabled = True
    hsc.Max = Int((MMControl1.Length / 1004))     ' determiner le max de hscrollbar en fonction de longueur de la piste 1 seconde = 1004 (lenght)
    indexplay = List1.ListIndex       'sovgarder l'index de la piste en cours de lecture
      
      '*****déselectionner les otres elements selectionné*********
    For i = 0 To List1.ListCount - 1
              If i <> indexplay Then
                        List1.selected(i) = False
                        Else
                            List1.selected(indexplay) = True
             End If
Next
Shape2.Visible = False
Shape3.Visible = False
End Sub

Private Sub cmdplay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Visible = True
End Sub

Private Sub cmdplay_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Visible = False
Call cmdplay_Click
End Sub

Private Sub cmdprevious_Click()
On Error Resume Next
MMControl1.Command = "prev"
hsc.Value = 1
lbltime = "00:00"
minutes = 0
secondes = 0
End Sub
Private Sub cmdremove_Click()
On Error Resume Next
poin = "."
 i = 0
 While i <= List1.ListCount - 1
               If List1.selected(i) = True Then        'selectionner ou non
                          If List1.List(i) = lblnowplay.Caption Then    'piste courante est selectionné pour etre supprimer
                                     Call cmdstop_Click              'stoper la piste courante pour etre supprimer
                          End If
                        List1.RemoveItem (i)           'supp l'element
                        List2.RemoveItem (i)           'supp son chemin de list2
                       Else
                            i = i + 1
                End If
 Wend
 
 '******rénumeroter la liste apres la suppression de la liste***********
 For i = 0 To (List1.ListCount - 1)
       s = List1.List(i)
       pos2 = InStr(List1.List(i), poin)
       alire2 = Right(s, (Len(List1.List(i)) - pos2))
       chaine = Str(i + 1) + "  ." + alire2
       List1.RemoveItem i
       List1.AddItem chaine, i
Next
End Sub
Private Sub cmdremoveall_Click()
On Error Resume Next
rep = (MsgBox("are you sure to remove all items?", vbYesNo, "Bilel Player"))
If rep = vbYes Then
           Call cmdstop_Click  'stoper la piste courante
            List1.Clear         'vider la list1
            List2.Clear         'vider la list2
            lblnowplay.Caption = ""
            lbltime.Caption = ""
End If
End Sub

Private Sub cmdsearch_Click()
Form3.Show
End Sub

Private Sub cmdselectall_Click()
On Error Resume Next
For i = 0 To List1.ListCount - 1
        List1.selected(i) = True
Next
End Sub

Private Sub cmdsilent_Click()
On Error Resume Next
  If Not silente Then    'activer le silence
          MMControl1.Silent = True
          silente = True
           Label1 = "silent"
         Else
             MMControl1.Silent = False    'desactiver le silence
            silente = False
            If pausee Then
             Label1 = "pause"
             Else
             Label1 = ""
             End If
           
  End If
End Sub
Private Sub cmdstop_Click()
On Error Resume Next
 MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Command = "stop"
tmrtempsecoule.Enabled = False
hsc.Value = 1      'mettre le hscrollbar au debut
End Sub

Private Sub cmdvolume_Click()
On Error Resume Next
r = Shell("sndvol32 /t") ' Affiche la petite fenêtre volume de windows
End Sub
Private Sub disp_Click()          ' menu deplacer
Call cmddeplacer_Click
End Sub
Private Sub exit_Click()            ' menu exit
Call cmdexit_Click
End Sub

Private Sub Label2_Click()
frmAbout.Show
End Sub

Private Sub lblnowplay_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblnowplay.ToolTipText = lblnowplay.Caption
End Sub

Private Sub list1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Select Case KeyCode
 Case 80:   Call cmdplay_Click
 Case 82: Call cmdprevious_Click
 Case 78: Call cmdnext_Click
 Case 83:   Call cmdstop_Click
 Case 65: Call cmdpause_Click
 Case 73: Call cmdsilent_Click
 Case 86: Call cmdvolume_Click
 Case 70: Call cmdfind_Click
 Case 68: Call cmddeplacer_Click
 Case 69: Call cmdsearch_Click
 Case 76: Call cmdaddfiles_Click
Case 67: Call cmdselectall_Click
Case 77: Call cmdremoveall_Click
Case 79: Call cmdremove_Click
End Select
End If
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then        'taper Entrée
        Call cmdplay_Click      'lecture
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
'Utilisation :
'Dans l'événement Form_Load mettre :
'WndSetOpacity hWnd, , 10 '(rend la fenêtre translucide à 50%
WndSetOpacity hWnd, vbBlack, , False '(rend la couleur noir transparente)

'préparation de péréphirique
    MMControl1.Notify = False
    MMControl1.Wait = False
    MMControl1.Shareable = False
    
    '*******charger la liste des fichier à la liste************
    If ExisteFichier("c:\flist1.txt") Then
             Open "c:\flist1.txt" For Input As #1          'liste des nom des fichiers
            Open "c:\flist2.txt" For Input As #2           'liste des chemins
             i = 0
             While Not EOF(1)
                     Line Input #1, X
                     List1.List(i) = X       'nom fichier ds list1
                      Line Input #2, X
                      List2.List(i) = X          'chemin ds list2
                         i = i + 1
            Wend
             Close #1
             Close #2
    End If
    silente = False              'activer lecture ---> not silencieux
End Sub

Private Sub List1_Click()
On Error Resume Next
 Extension = LCase(Right(List1.Text, 3)) 'mettre lextension de nom de fichier en minuscule et garder ds extension
Select Case Extension          'determiner le type de fichier selon l'extension
    Case "mid", "rmi"
     TypeDeFichier = "sequencer"
    Case "wav"
     TypeDeFichier = "waveaudio"
    Case "avi"
     TypeDeFichier = "avivideo"
    Case "mp3", "aif", "peg", "mpg", ".au", ".mpeg"
     TypeDeFichier = "mpegvideo"
    Case "mov", "jpg", "pic"
     TypeDeFichier = "QTWVideo"
End Select
     MMControl1.DeviceType = TypeDeFichier       'detreminer devicetype de mmcontrol selon l'extension
     List2.ListIndex = List1.ListIndex                       '1 er element ds list1 a son chemin ds le 1 er element ds list2 et ainsi de suite
      List1.ToolTipText = List1.Text
End Sub
Private Sub List1_dblClick()
Call cmdplay_Click
End Sub
'appel du menu déroulant
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim selected As Boolean
selected = False
If Button = 2 Then    'bouton droit de la souris
             '*****verifier sil ya des elements selectionner ds la list
       For i = 0 To (List1.ListCount - 1)
                If List1.selected(i) = True Then
                          selected = True
               End If
        Next
        If Not selected Then      'aukin element selectionner
                disp.Enabled = False       'desactiver le deplacement du menu
                reme.Enabled = False       'desactiver la suppressiont du menu
               Else                               '1 ou +eurs elements selectionnésd
                     disp.Enabled = True
                     reme.Enabled = True
        End If
         PopupMenu fic                  'appel du menu déroulant "fic"
End If
End Sub
Private Sub pause_Click()    'pause de menu
cmdpause_Click
End Sub

Private Sub play_Click()        'play de menu
Call cmdplay_Click
End Sub
Private Sub reme_Click()        'remove de menu
Call cmdremove_Click
End Sub
Private Sub stop_Click()       'stop de menu
Call cmdstop_Click
End Sub
'********verifi sil ya des element selectionner pour activer/desactiver les boutons supprimer et deplacer
Private Sub Timer3_Timer()
Dim selected As Boolean
If List1.ListCount > 0 Then
      For i = o To (List1.ListCount - 1)
           If List1.selected(i) = True Then
                   selected = True
                    cmdsilent.Enabled = True
                    cmdremove.Enabled = True
                    cmddeplacer.Enabled = True
          End If
    Next
  If Not selected Then        'okin element selectionné
              cmdsilent.Enabled = False
              cmdremove.Enabled = False
              cmddeplacer.Enabled = False
    End If
End If
End Sub
'*****avancer le hscrollbarr
Private Sub Timer4_Timer()
 If tmrtempsecoule.Enabled = True Then   'verifier si en cour de lecture et né pas en pause
         If hsc.Value < hsc.Max Then
                 hsc.Value = hsc.Value + 1
         End If
  End If
End Sub
Private Sub tmrnextpiste_Timer()
On Error Resume Next
If MMControl1.Length = MMControl1.Position Then   'fin de piste ( position = lenght)
       If (indexplay = (List1.ListCount - 1)) Then      ' piste en cours est la derniere
                 List1.ListIndex = 0                                        ' retour au debut de liste
       Else
             List1.ListIndex = indexplay + 1                      'sinon avancer a la piste suivante
      End If
     Call cmdplay_Click
End If
End Sub
'************Fermeture******************
Private Sub Form_Unload(Cancel As Integer)
Call cmdexit_Click
End Sub
'*************calculer le temps ecouler**************
Private Sub tmrtempsecoule_Timer()
On Error Resume Next
Dim temp As String
secondes = secondes + 1       'chak seconde incrementer secondes
If secondes = 60 Then        'minute
     secondes = 0
     minutes = minutes + 1
End If
'************Mise en forme du temps ("**:**")
   If minutes < 10 Then
           If secondes < 10 Then
                      temp = "0" & minutes & ":0" & secondes
                     Else
                      temp = "0" & minutes & ":" & secondes
            End If
           Else
            If secondes < 10 Then
                      temp = minutes & ":0" & secondes
                     Else
                      temp = minutes & ":" & secondes
            End If
     End If
     lbltime = temp
End Sub
Function ExisteFichier(File As String) As Boolean
    On Error GoTo erreur
    FileLen File
    ExisteFichier = True
    Exit Function
erreur:
    ExisteFichier = False
End Function
                 'Form2***********
Private Sub cmdaddnowplay_Click()
On Error Resume Next
Dim chemin As String
Dim nom As String
Dim item As String
For i = 0 To List1.ListCount - 1
 If List1.selected(i) = True Then
               item = List1.List(i)
               nom = Str(Form1.List1.ListCount + 1) + "   ." + item 'rajouter le num et un poin a lelement
              Form1.List1.AddItem nom
              chemin = Dir.Path + "\"
              Form1.List2.AddItem chemin
 End If
 Next
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdplaylist_Click()
On Error Resume Next
Form1.List1.Clear
Form1.List2.Clear
Form1.MMControl1.Command = "stop"
Call cmdaddnowplay_Click
End Sub

Private Sub cmdselectall_Click()
On Error Resume Next
For i = 0 To List1.ListCount - 1
      List1.selected(i) = True
Next
End Sub

Private Sub Dir_Change()
On Error Resume Next
File.Path = Dir.Path
File.Pattern = "*.mp3;*.avi;*.mid;*.rmi;*.wav;*.aif;*.peg;*.mpg;*.au;*.mov;*.jpg;*.pic;*.mpeg;*.m3u"
File.ListIndex = 0
List1.Clear
'remplir list1 par les files de file pour avoir multiselection
For i = 0 To File.ListCount - 1
      List1.AddItem File.FileName
      File.ListIndex = File.ListIndex + 1
Next
End Sub

Private Sub Drive_Change()
On Error Resume Next
Dir.Path = Left$(Drive.Drive, 2) + "\"
File.Path = Dir.Path
File.Pattern = "*.mp3;*.avi;*.mid;*.rmi;*.wav;*.aif;*.peg;*.mpg;*.au;*.mov;*.jpg;*.pic;*.mpeg;*.m3u"
End Sub

Private Sub Form_Load()
On Error Resume Next
 Dir.Path = "d:\"
 File.Path = "d:\"
    '*****filtrer les types suivants*********
 File.Pattern = "*.mp3;*.avi;*.mid;*.rmi;*.wav;*.aif;*.peg;*.mp1;*.au;*.mov;*.mp2;*.mpeg;*.m3u"
End Sub

Private Sub List1_Click()
List1.ToolTipText = List1.Text
End Sub

'********verifi la selection des element pour activer/desactiver les bouton "add to list" et "play list"
Private Sub Timer1_Timer()
Dim selected As Boolean
If List1.ListCount > 0 Then
cmdselectall.Enabled = True
      For i = o To (List1.ListCount - 1)
           If List1.selected(i) = True Then
                   selected = True
                    cmdaddnowplay.Enabled = True
                    cmdplaylist.Enabled = True
           End If
    Next
  If Not selected Then
             cmdaddnowplay.Enabled = False
              cmdplaylist.Enabled = False
    End If
Else
     cmdselectall.Enabled = False
     cmdaddnowplay.Enabled = False
     cmdplaylist.Enabled = False
End If
End Sub

'Form3****************
Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Timer1.Enabled = True
End Sub

Private Sub List1_dblClick()
j = 0
While j < (Form1.List1.ListCount)
      If Form1.List1.List(j) = List1.Text Then
                Form1.List1.ListIndex = j
                Form1.cmdp2.Value = True
                Unload Me
                 Exit Sub
                Else
                      j = j + 1
       End If
Wend
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
 Call List1_dblClick
 End If
End Sub

Private Sub Timer1_Timer()
txtsearch.SetFocus
Timer1.Enabled = False
End Sub

Private Sub txtsearch_Change()
On Error Resume Next
For i = 0 To (Form1.List1.ListCount - 1)
       If InStr(1, Form1.List1.List(i), txtsearch.Text, 1) > 0 Then
              List1.AddItem Form1.List1.List(i)
        End If
Next
End Sub

Private Sub txtsearch_KeyUp(KeyCode As Integer, Shift As Integer)
List1.Clear
txtsearch_Change
End Sub
Conclusion :

je veux bien savoir comment faire avancer et reculer ds la piste .Merci.
Télécharger le projet
Codes Sources

A voir également

Lecteur multimedia (mp3,avi,au...)/manipulation des listes
Eclipse lecteur mp3 ✓ - Forum Java
Ajouter un lecteur mp3 a mon myspace - Forum Flash
Lecteur m3u en ligne - Forum Flash
Lecteur M3U pour site internet - Forum PHP
Lecteur mp3 la source ✓ - Forum Visual Basic
S'inscrire maintenant
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.
Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
