Je sais qu'il existe plusieurs source de lecteur de musique sur se site, mais je voulais avoir voscritiques sur le miens, s'il vous plait.
Il gère autant de playlist que vous voulez et mets plusieurs informations en memoire (dernière musique lut, fonds, couleurs).
Merci de prendre votre temp.
Source / Exemple :
1er forme
'________________________________________________________________'
'Nom: David Chardonnens '
'But: DanceNever, le plus gros boulot sur Never '
' '
'Notes: DanceNever est en anglais surtout pour une utilisation '
' personnel d'un des concepteur. Tout se qui peut paraitre '
' inutile dans se programme est en faite une correction '
' d'un bugue trouvé. Rien n'est inutile. '
'________________________________________________________________'
Option Explicit
Dim Dot As Long
Dim File, NameNev As Variant
Dim ClickUser, DoNotFinish As Boolean
Dim i, Number, NumPlay, intTemp, MemIV, OpenRandom, Y As Integer
Dim PlayListI, PlayListII, PlayListIII, StylePlay, strTemp, Temp, BGJPG, Mem, MemII, MemIII, MemV, TempRND, RandomPast As String
Private Sub Form_Unload(Cancel As Integer)
'Si l'utilisateur ne recharge pas la page on force a quitter (si danceneverplus est ouvert)
If Not DoNotFinish Then
'Si la playlist n'est pas vide
If lstPlayList.ListCount > 0 Then
'Demander de faire une sauvegare rapide
If MsgBox("Save your current playlist?", vbYesNo, "DanceNever | Quit") = vbYes Then
Call CreateNewName
i = 44
Call mnuSave_Click
End If
End If
End
End If
End Sub
'Dès que l'on appuis sur enter sur n'importe quel liste alors il appel la fonction qui vaut un double-click
Private Sub filPlayList_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call filPlayList_DblClick
End If
End Sub
Private Sub lstPlayList_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call lstPlayList_DblClick
End If
End Sub
Private Sub lstPlayListName_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call lstPlayListName_DblClick
End If
End Sub
Private Sub lstPlayListPath_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call lstPlayListPath_DblClick
End If
End Sub
Private Sub filOpen_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call filOpen_DblClick
End If
End Sub
Private Sub imgBG_DblClick()
'Dès que l'utilisateur clique sur le fond alors on cahcer toutes les formes qui sont ouverte
frmOpen.Visible = False
frmPlayList.Visible = False
End Sub
Private Sub mmcDanceNever_Done(NotifyCode As Integer)
'Si la musique est Done est que ce n'est pas de la faute de l'utilisateur est en random ou suivre
If Not ClickUser Then
If StylePlay = "R" Then
Call mnuRandom_Click
Else
MemIV = MemIV + 1
If MemIV = lstPlayList.ListCount Then
MemIV = 0
End If
lstPlayListPath.ListIndex = MemIV
Call lstPlayListPath_DblClick
End If
End If
End Sub
Private Sub mnuAdd_Click()
'On fais comme si on double-Clique sur le filOpen
Call filOpen_DblClick
End Sub
Private Sub mnuAddF_Click()
'On appel la fenetre name en donnant no name au texte jusqu'a la fin du dossier
For i = 0 To filOpen.ListCount - 1
filOpen.ListIndex = i
frmDanceNeverPlus.Show
frmDanceNeverPlus.txtName.Text = "No Name"
Next i
End Sub
Private Sub mnuClose_Click()
'Appel la fonction pour quitter
Call mnuQuit_Click
End Sub
Private Sub mnuHep_Click()
'On affiche des msgbox qui nous donne des informations
Call MsgBox("Extension can read:" + vbCrLf + vbCrLf + "[.mp3]|[.wma]|[.wav]|[.mid]" + vbCrLf + vbCrLf + vbCrLf + "What I can make:" + vbCrLf + vbCrLf + "You can slide a music in playlist" + vbCrLf + "Delete Add Rename musics" + vbCrLf + "Create Delete playlists" + vbCrLf + vbCrLf + vbCrLf + "What I can modify:" + vbCrLf + vbCrLf + "Background | Color | File desciption (Prsonalisable Name, Name of file, path of file)" + vbCrLf + vbCrLf + vbCrLf + "Where come DanceNever:" + vbCrLf + vbCrLf + "DanceNever is a project for my school" + vbCrLf + vbCrLf + vbCrLf + "How make DanceNever:" + vbCrLf + vbCrLf + "With Visual Basic6" + vbCrLf + vbCrLf + vbCrLf + "How many time I make DanceNever:" + vbCrLf + vbCrLf + "Five weeks" + vbCrLf + vbCrLf + vbCrLf + "DanceNever support:" + vbCrLf + vbCrLf + "David Chardonnens | glo0ny" + vbCrLf + "info@dave.lithobia.com" + vbCrLf + "For critic or bug report, thanks", vbInformation, "DanceNever | HELP")
End Sub
Private Sub mnuModify_Click()
'On ouvre la fenetre pour modifier de noms
frmDanceNeverPlus.Show
frmDanceNeverPlus.txtName.Text = "ChangeName"
End Sub
Private Sub mnuNext_Click()
'On reprends la derniere musique est on lit la suivante
MemIV = MemIV + 1
'Si on arrive au bout de la liste alors on revient a la premiere
If MemIV = lstPlayList.ListCount Then
MemIV = 0
End If
'On ouvre la musique
lstPlayListPath.ListIndex = MemIV
Call lstPlayListPath_DblClick
End Sub
Private Sub mnuPause_Click()
'Mets la player en pause
mmcDanceNever.Command = "pause"
mnuPlay.Enabled = True
'On dit que c'est l'utilisateur qui a mit en pause
ClickUser = True
End Sub
Private Sub mnuPlay_Click()
'Joue la musique est rends le play incliquable
mnuPlay.Enabled = False
mmcDanceNever.Command = "play"
'C'est plus l'utilisateur qui a cliqué!
ClickUser = True
MemIII = 0
End Sub
Private Sub mnuPlaylistPlay_Click()
'Dès que le bouton play de la playlist est cliqué dans le menu alors faire comme si on double-clique dans la playlist
Call lstPlayListName_DblClick
End Sub
Private Sub mnuRandF_Click()
'Si un random de 11 est divisible par 9 alors ajouter la musique
For i = 0 To filOpen.ListCount - 1
filOpen.ListIndex = i
Randomize
If CInt((Rnd * 11)) Mod 9 = 0 Then
frmDanceNeverPlus.Show
frmDanceNeverPlus.txtName.Text = "No Name"
End If
Next i
End Sub
Private Sub mnuSelDel_Click()
'Si c'est pour la musique ou pour la playlist
If filPlayList.Visible Then
'on reprends le fichier que l'on doit supprimer
MemV = filPlayList
'Avant demander de sauvegarder la playlist
If MsgBox("Save your current playlist before?", vbYesNo, "DanceNever | Delete") = vbYes Then
If txtPlayListName.Text <> "" And lstPlayList.ListCount < 0 Then
'Demande si il veutx garder le nom ou en creer un nouveau
If MsgBox("Create a new name?", vbYesNo, "DanceNever | Save") = vbYes Then
'Cree un nouveau nom
Call CreateNewName
End If
Else
'Si le nom est vide on cree une nouvel playlist d'office
Call CreateNewName
End If
'On sauve la playlist
i = 44
Call mnuSave_Click
End If
'On "tue" les fichiers slectionné
Temp = "PlayList\Name\" + MemV
Kill Temp
Temp = "PlayList\Name " + MemV
Kill Temp
Temp = "PlayList\Title " + MemV
Kill Temp
Temp = "PlayList\Path " + MemV
Kill Temp
'On recharge le tout, pour mettre a jour la playlist
Call mnuReloadPlayList_Click
Else
'Recher sur quel liste il a cliquer, si aucun n'est selectionner ne rien faire
If lstPlayListName.ListIndex <> -1 Then
intTemp = lstPlayListName.ListIndex
ElseIf lstPlayListPath.ListIndex <> -1 Then
intTemp = lstPlayListPath.ListIndex
ElseIf lstPlayList.ListIndex <> -1 Then
intTemp = lstPlayList.ListIndex
Else
Exit Sub
End If
'Enregistre le nom du fichier a enlever dans strtemp pour la verification d'apres
strTemp = lstPlayListPath.List(intTemp)
'Enlever la selection
lstPlayListName.RemoveItem (intTemp)
lstPlayList.RemoveItem (intTemp)
lstPlayListPath.RemoveItem (intTemp)
'Si inttemp est plus bas que memiv alors le mettre a niveau
If intTemp < MemIV Then
MemIV = MemIV - 1
End If
'Arrete la lecture via le bouton stop, si c'est la musique en cours qui est supprimer
If mmcDanceNever.FileName = strTemp And lstPlayListPath.ListCount > 0 Then
If StylePlay = "R" Then
Call mnuRandom_Click
Else
'La variable qui retient la denrie musique va a lui moins 1
MemIV = intTemp
'Si le intemp est a la fin de la playlist le remonter avec memiv
If intTemp > lstPlayList.ListCount - 2 Then
MemIV = -1
End If
Call mnuNext_Click
End If
ElseIf lstPlayListPath.ListCount = 0 Then
Call mnuStopMusic_Click
End If
End If
End Sub
Private Sub CreateNewName()
'Pour commencer toute les variables ont une valeurs de départ
i = 1
txtPlayListName.Text = "QuickSave000"
intTemp = 0
While i <> 0
'On mets a jour le temp et que le fichiers ouvert pour l'instant n'a pas de corespondance
Y = 1
Temp = "PlayList\Name " + txtPlayListName.Text + ".nev"
'Rajoute une ligne dans le fichier, juste pour le créer
Open Temp For Append As #1
Write #1, ""
Close #1
'Lit si le fichier a quqlque chose dedans ou que l'on vient de la cree
Open Temp For Input As #1
While Not EOF(1)
Input #1, strTemp
If strTemp <> "" Then
Y = 0
End If
Wend
Close #1
If Y = 1 Then
i = 0
Else
intTemp = intTemp + 1
'On met le chemin du fichier avec le numéro du fichier qui est testé
If intTemp < 10 Then
txtPlayListName.Text = "QuickSave00" + CStr(intTemp)
ElseIf intTemp < 100 Then
txtPlayListName.Text = "QuickSave0" + CStr(intTemp)
Else
txtPlayListName.Text = "QuickSave" + CStr(intTemp)
End If
End If
Wend
End Sub
Private Sub mnuShowRand_Click()
'On affiche danns un msgbox la variable qui stock tout
Call MsgBox("Music in order of play" + vbCrLf + RandomPast, vbInformation, "DanceNever")
End Sub
Private Sub mnuStyle_Click(Index As Integer)
'Affiche les musiques par se qu'a choisit l'utilisateur (Nom, Chemin, Nom de fichier)
Select Case mnuStyle(Index).Caption
Case "Name"
lstPlayList.Visible = False
lstPlayListName.Visible = True
lstPlayListPath.Visible = False
Case "Path"
lstPlayList.Visible = False
lstPlayListName.Visible = False
lstPlayListPath.Visible = True
Case "File"
lstPlayList.Visible = True
lstPlayListName.Visible = False
lstPlayListPath.Visible = False
End Select
End Sub
Private Sub mnuBG_Click()
'Quand l'utilisateur clique sur le bouton Background, afficher dans le Form Name "don't use" pour activer l'option
frmDanceNeverPlus.Show
frmDanceNeverPlus.txtName.Text = "don't use"
End Sub
Private Sub mnuDelAll_Click()
'Quand l'utilisateur click sur Delete All, surpprimer toute la playlist
If lstPlayList.ListCount >= 0 Then
For i = 0 To lstPlayList.ListCount - 1
lstPlayList.RemoveItem (0)
lstPlayListPath.RemoveItem (0)
lstPlayListName.RemoveItem (0)
Next i
End If
'Appeler la fonciton pour eteindre la musique
Call mnuStopMusic_Click
MemIV = -1
End Sub
Private Sub mnuLoad_Click()
'Le bouton pour charger une playlist avec un filebox (dans le dossier de playlist)
If filPlayList.Visible Then
filPlayList.Visible = False
Else
filPlayList.Visible = True
End If
End Sub
Private Sub load()
'Si la playlist n'est pas vide alors tout décharger
If lstPlayList.ListCount >= 0 Then
For i = 0 To lstPlayList.ListCount - 1
lstPlayList.RemoveItem (0)
lstPlayListPath.RemoveItem (0)
lstPlayListName.RemoveItem (0)
Next i
End If
'Recupérer tout se qu'il y a pour la playlist
Open PlayListII For Input As #1
While Not EOF(1)
Input #1, strTemp
lstPlayListPath.AddItem (strTemp)
Wend
Close #1
Open PlayListIII For Input As #1
While Not EOF(1)
Input #1, strTemp
lstPlayListName.AddItem (strTemp)
Wend
Close #1
Open PlayListI For Input As #1
While Not EOF(1)
Input #1, strTemp
lstPlayList.AddItem (strTemp)
Wend
Close #1
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
MemIV = -1
End Sub
Private Sub mnuMax_Click()
'Pour réglé la taille de la fenetre au maximum (plein écran) sinon le rendre petit
If frmDanceNever.WindowState = 2 Then
frmDanceNever.WindowState = 0
Else
frmDanceNever.WindowState = 2
End If
End Sub
Private Sub mnuMin_Click()
'Pour reduire le Form
frmDanceNever.WindowState = 1
End Sub
Private Sub mnuOpen_Click()
'Si il click sur ouvrir un fichier alors rendre invisible les options, si ouvrir est deja visible le rendre invisible
If frmOpen.Visible Then
mnuOpen.Caption = "Open"
frmOpen.Visible = False
Else
mnuOpen.Caption = "Hide Open"
frmOpen.Visible = True
End If
End Sub
Private Sub mnuPlayList_Click()
'Si il clique sur le bouton playlist alors le rendre visbile si il l'est deja le rendre invisible
If frmPlayList.Visible Then
frmPlayList.Visible = False
mnuPlaylist.Caption = "Show"
Else
frmPlayList.Visible = True
mnuPlaylist.Caption = "Hide"
End If
End Sub
Private Sub mnuQuit_Click()
'Si l'utilisateur veut fermer le faire via l'interface Never
Unload Me
End Sub
Private Sub mnuRandom_Click()
'On rajoute une musique jouer dans le nombre total
NumPlay = NumPlay + 1
'Si le nombre jouer est la dernière musique non jouer alors on repart de 0
If NumPlay = lstPlayList.ListCount Then
NumPlay = 0
RandomPast = " "
End If
'Jusqu'a que plus aucun fichier n'est trouver
While InStr(1, RandomPast, TempRND, vbTextCompare) <> 0
'On mets une nouvelle valeur dans la variable pour les randoms
Randomize
intTemp = CInt(Rnd * (lstPlayList.ListCount - 1))
If intTemp < 10 Then
TempRND = "00" + CStr(intTemp)
ElseIf intTemp < 100 Then
TempRND = "0" + CStr(intTemp)
Else
TempRND = CStr(intTemp)
End If
Wend
'On lance la lecture (DANCE DANCE EVERYBODY!!!)
lstPlayListPath.ListIndex = CInt(TempRND)
Call lstPlayListPath_DblClick
'Ajoute le fichier jouer dans la variable pour qu'elle ne passe plus dedans et si randompast est vide ne pas rajouter le |
If RandomPast = " " Then
RandomPast = vbCrLf + TempRND
Else
'On ajoute le numéro avec une separation
RandomPast = RandomPast + " | " + TempRND
End If
End Sub
Private Sub mnuReloadPlayList_Click()
'Recharger le toute pour avoir la playlist neuve
DoNotFinish = True
frmDanceNeverPlus.Show
frmDanceNeverPlus.Visible = False
Unload Me
frmDanceNeverPlus.txtName.Text = "Recharge Me Please!!!"
End Sub
Private Sub mnuSave_Click()
'Si le nom choisit par l'utilisateur ne vaut rien, alors afficher une erreur, sinon ...
If txtPlayListName.Text <> "" Then
'... enregistrer la playlist avec son nom, et tout ses fichiers
Temp = "PlayList\Name\" + txtPlayListName.Text + ".nev"
Open Temp For Output As #1
Print #1, txtPlayListName.Text
Close #1
Mem = txtPlayListName.Text
txtPlayListName.Text = " " + txtPlayListName.Text
lstPlayListPath.ListIndex = 0
lstPlayList.ListIndex = 0
lstPlayListName.ListIndex = 0
Open PlayListII For Output As #1
Write #1, lstPlayListPath.Text
Close #1
Open PlayListI For Output As #1
Write #1, lstPlayList.Text
Close #1
Open PlayListIII For Output As #1
Write #1, lstPlayListName.Text
Close #1
For i = 1 To lstPlayList.ListCount - 1
lstPlayListPath.ListIndex = i
lstPlayList.ListIndex = i
lstPlayListName.ListIndex = i
Open PlayListII For Append As #1
Write #1, lstPlayListPath.Text
Close #1
Open PlayListI For Append As #1
Write #1, lstPlayList.Text
Close #1
Open PlayListIII For Append As #1
Write #1, lstPlayListName.Text
Close #1
Call mnuStopMusic_Click
Next i
txtPlayListName.Text = Mem
If i <> 44 Then
Call mnuReloadPlayList_Click
End If
End If
End Sub
Private Sub mnuColor_Click()
'Si l'utilisateur alors afficher la palette de couleur dans le Form Name
frmDanceNeverPlus.Show
frmDanceNeverPlus.txtName.Text = "color"
End Sub
Private Sub mnuStopMusic_Click()
'Quand l'utilisateur click sur Stop, alors appelé la fonction pour stoper la musique
mmcDanceNever.Command = "stop"
mmcDanceNever.FileName = ""
mmcDanceNever.Command = "close"
'On dit que c'est l'utilisateur qui a stopper la musique
ClickUser = True
End Sub
Private Sub filPlayList_DblClick()
'Lorsqu'un double-click dans la FileList des playlists, alors charger la playlist est mettre son nom dans le TextBox
filPlayList.Visible = False
Call mnuStopMusic_Click
txtPlayListName.Text = filPlayList
'Charge la playlist
Mem = txtPlayListName.Text
txtPlayListName.Text = " " + txtPlayListName.Text
PlayListIII = "PlayList\" + "Name" + txtPlayListName.Text
PlayListII = "PlayList\" + "Path" + txtPlayListName.Text
PlayListI = "PlayList\" + "Title" + txtPlayListName.Text
Call load
'Efface le .nev dans le textbox
Dot = InStr(1, Mem, ".nev", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
txtPlayListName.Text = NameNev
'Ouvre la première musique
lstPlayListPath.ListIndex = 0
Call lstPlayListPath_DblClick
End Sub
'Dès que l'on insert un fichier en Drag N Drop dans la playlist il l'ajoute par les trois chemin possible
Private Sub lstPlayListName_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Chemin Direct, soit chemin su fichier
For Each File In Data.Files
lstPlayListPath.AddItem (File)
Mem = File
Next
'Verifie que le fichier peut etre supporter par le lecteur ([.mp3][.wmv][.wma])
If (InStr(1, Mem, ".wav", vbTextCompare) <> 0) Or (InStr(1, Mem, ".mp3", vbTextCompare) <> 0) Or (InStr(1, Mem, ".wma", vbTextCompare)) Or (InStr(1, Mem, ".wmv", vbTextCompare)) Then
'Nom du fichier, effacer tout se qu'il y a avant le dernier "\"
i = lstPlayListPath.ListCount - 1
For i = 1 To Len(Mem)
Dot = InStr(1, Mem, "\", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot)
Mem = File
Next i
lstPlayList.AddItem (File)
'Effacer tout se qu'il y a après le .
If InStr(1, Mem, ".mp3", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mp3", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wmv", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wmv", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wma", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wma", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wav", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wav", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".mid", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mid", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
End If
'Et on ajoute dans la playlist des noms la chanson toute coupé!
lstPlayListName.AddItem (strTemp)
Else
'Si le fichier n'est pas supporter alors effecer la première étape
lstPlayListPath.RemoveItem (lstPlayListPath.ListCount - 1)
End If
'On appel la verification si c'est la permeire musique de la lsite ou non
Call FirstMusic
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
End Sub
Private Sub lstPlayList_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Chemin Direct, soit chemin su fichier
For Each File In Data.Files
lstPlayListPath.AddItem (File)
Mem = File
Next
'Verifie que le fichier peut etre supporter par le lecteur ([.mp3][.wmv][.wma])
If (InStr(1, Mem, ".wav", vbTextCompare) <> 0) Or (InStr(1, Mem, ".mp3", vbTextCompare) <> 0) Or (InStr(1, Mem, ".wma", vbTextCompare)) Or (InStr(1, Mem, ".wmv", vbTextCompare)) Then
'Nom du fichier, effacer tout se qu'il y a avant le dernier "\"
i = lstPlayListPath.ListCount - 1
For i = 1 To Len(Mem)
Dot = InStr(1, Mem, "\", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot)
Mem = File
Next i
lstPlayList.AddItem (File)
'Effacer tout se qu'il y a après le .
If InStr(1, Mem, ".mp3", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mp3", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wmv", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wmv", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wma", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wma", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wav", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wav", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".mid", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mid", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
End If
'Et on ajoute dans la playlist des noms la chanson toute coupé!
lstPlayListName.AddItem (strTemp)
Else
'Si le fichier n'est pas supporter alors effecer la première étape
lstPlayListPath.RemoveItem (lstPlayListPath.ListCount - 1)
End If
'On appel la verification si c'est la permeire musique de la lsite ou non
Call FirstMusic
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
End Sub
Private Sub lstPlayListPath_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Chemin Direct, soit chemin su fichier
For Each File In Data.Files
lstPlayListPath.AddItem (File)
Mem = File
Next
'Verifie que le fichier peut etre supporter par le lecteur ([.mp3][.wmv][.wma])
If (InStr(1, Mem, ".wav", vbTextCompare) <> 0) Or (InStr(1, Mem, ".mp3", vbTextCompare) <> 0) Or (InStr(1, Mem, ".wma", vbTextCompare)) Or (InStr(1, Mem, ".wmv", vbTextCompare)) Then
'Nom du fichier, effacer tout se qu'il y a avant le dernier "\"
i = lstPlayListPath.ListCount - 1
For i = 1 To Len(Mem)
Dot = InStr(1, Mem, "\", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot)
Mem = File
Next i
lstPlayList.AddItem (File)
'Effacer tout se qu'il y a après le .
If InStr(1, Mem, ".mp3", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mp3", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wmv", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wmv", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wma", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wma", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wav", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wav", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".mid", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mid", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
End If
'Et on ajoute dans la playlist des noms la chanson toute coupé!
lstPlayListName.AddItem (strTemp)
Else
'Si le fichier n'est pas supporter alors effecer la première étape
lstPlayListPath.RemoveItem (lstPlayListPath.ListCount - 1)
End If
'On appel la verification si c'est la permeire musique de la lsite ou non
Call FirstMusic
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
End Sub
Private Sub FirstMusic()
'Si c'est la premiere musique dans la liste
If lstPlayList.ListCount = 1 Then
lstPlayListPath.ListIndex = 0
Call lstPlayListPath_DblClick
End If
End Sub
Private Sub Form_Load()
'On dit que l'utilisateur ne veut pas recharger la page lorsqu'il va quitter
DoNotFinish = False
'On dit pour la variable memiv que il faut quelque chose de faux
MemIV = -1
'On dit que le random est activer
StylePlay = "F"
'Charge la couleur du programme
Temp = "Temp\Color.nev"
Open Temp For Input As #1
Input #1, strTemp
Close #1
frmOpen.BackColor = strTemp
frmPlayList.BackColor = strTemp
'Rends la fenetre au minimum de sa taille
frmDanceNever.Height = 5626
frmDanceNever.Width = 7681
'Charge le fond d'écran
BGJPG = "Temp\BG.nev"
Open BGJPG For Input As #1
Input #1, Temp
Close #1
imgBG.Picture = LoadPicture(Temp)
'Rends les chemins d'accéd a leur valeur de base
filPlayList.Path = "PlayList\Name\"
'Ce n'est pas l'utilisateur qui a stopé la music, logique dans le debut du programme
ClickUser = False
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
NumPlay = -1
'Charge la dernière musique lu dans le lecteur
Temp = "Temp\TemporaryPath.nev"
Open Temp For Input As #1
Input #1, strTemp
Close #1
lstPlayListPath.AddItem (strTemp)
If strTemp = "" Then
lstPlayListPath.RemoveItem (0)
Exit Sub
End If
Temp = "Temp\TemporaryFile.nev"
Open Temp For Input As #1
Input #1, strTemp
Close #1
lstPlayList.AddItem (strTemp)
Temp = "Temp\TemporaryName.nev"
Open Temp For Input As #1
Input #1, strTemp
Close #1
lstPlayListName.AddItem (strTemp)
lstPlayListPath.ListIndex = 0
Call lstPlayListPath_DblClick
End Sub
Private Sub dirOpen_Change()
'Quand on change le chamin de la DirBox elle met à jour la FileBox
filOpen.Path = dirOpen.Path
End Sub
Private Sub driOpen_Change()
'Quand on change la DriveBox elle met a jour la DirBox
dirOpen.Path = driOpen.Drive
End Sub
Private Sub filOpen_DblClick()
'Quand l'utilisateur double-click sur la musique de la FileBox, le Form Name s'ouvre pour choisir le nom
frmDanceNeverPlus.Show
End Sub
Private Sub SaveName()
'Quand le nom de la musique choisit est vide alors reprendre la nom du fichier moins l'extension
If frmDanceNeverPlus.txtName.Text = "" Then
Mem = filOpen
If InStr(1, Mem, ".mp3", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mp3", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wmv", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wmv", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wma", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wma", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".wav", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".wav", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
ElseIf InStr(1, Mem, ".mid", vbTextCompare) <> 0 Then
Dot = InStr(1, Mem, ".mid", vbTextCompare)
File = Right$(Mem, Len(Mem) - Dot + 1)
NameNev = Left$(Mem, Len(Mem) - Len(File))
strTemp = NameNev
End If
Else
strTemp = frmDanceNeverPlus.txtName.Text
End If
'Décharger le Form Name
Unload frmDanceNeverPlus
'Rentre la musique dans la playlist
lstPlayListName.AddItem (strTemp)
lstPlayListPath.AddItem (dirOpen + "\" + filOpen)
lstPlayList.AddItem (filOpen)
'Pour le random, on remets les valeurs a zero (vide)
RandomPast = " "
End Sub
Private Sub Form_Resize()
'Appel le design
Call Place
End Sub
'Quand on Double-click sur la playlist elle lit se fichier
Private Sub lstPlayList_DblClick()
lstPlayListName.ListIndex = lstPlayList.ListIndex
lstPlayListPath.ListIndex = lstPlayList.ListIndex
Call LastPlayed
End Sub
Private Sub lstPlayListName_DblClick()
lstPlayList.ListIndex = lstPlayListName.ListIndex
lstPlayListPath.ListIndex = lstPlayList.ListIndex
Call LastPlayed
End Sub
Private Sub lstPlayListPath_DblClick()
lstPlayList.ListIndex = lstPlayListPath.ListIndex
lstPlayListName.ListIndex = lstPlayList.ListIndex
Call LastPlayed
End Sub
Private Sub LastPlayed()
'On ouvre le musique selectionné
mmcDanceNever.Command = "close"
mmcDanceNever.FileName = lstPlayListPath.Text
mmcDanceNever.Command = "open"
mmcDanceNever.Command = "play"
'On sauvegarde dans une variable la derniere musique joué
MemIV = lstPlayListPath.ListIndex
'Enregistre la dernière musique séléctionné
strTemp = lstPlayListPath.Text
Temp = "Temp\TemporaryPath.nev"
Open Temp For Output As #1
Write #1, strTemp
Close #1
strTemp = lstPlayListName.Text
Temp = "Temp\TemporaryName.nev"
Open Temp For Output As #1
Write #1, strTemp
Close #1
strTemp = lstPlayList.Text
Temp = "Temp\TemporaryFile.nev"
Open Temp For Output As #1
Write #1, strTemp
Close #1
'C'est temporairement l'utilisateur qui a cliqué
MemIII = 0
ClickUser = True
End Sub
Private Sub mnuStylePlay_Click()
If mnuStylePlay.Caption = "Random" Then
mnuStylePlay.Caption = "Follow"
StylePlay = "R"
Else
mnuStylePlay.Caption = "Random"
StylePlay = "F"
End If
End Sub
Private Sub timVerif_Timer()
'Si il n'y a aucune musique séléctionné, rendre le bouton pour supprimer l'élément séléctionné
If (lstPlayList.ListIndex <> -1) Or (lstPlayListPath.ListIndex <> -1) Or (lstPlayListName.ListIndex <> -1) Then
mnuSelDel.Caption = "Delete Music"
mnuSelDel.Enabled = True
Else
mnuSelDel.Enabled = False
End If
'Si les playlist sont ouverte alors seldel est pour les playlist et plus pour la music
If filPlayList.Visible Then
mnuSelDel.Enabled = True
mnuSelDel.Caption = "Delete PlayList"
'Si rien n'est selectionner alors ne pas pouvoir cliquer dessus
If filPlayList.ListIndex = -1 Then
mnuSelDel.Enabled = False
End If
End If
'Si une musique a ajouter est selectionner montrer le menu d'ajout
If filOpen.ListIndex < 0 Then
mnuAdd.Enabled = False
Else
mnuAdd.Enabled = True
End If
'Si un dossier est ouvert est qu'il une musique dedans activer le menu dependant de sa
If filOpen.ListCount > 0 Then
mnuAddF.Enabled = True
mnuRandF.Enabled = True
Else
mnuAddF.Enabled = False
mnuRandF.Enabled = False
End If
'Si aucune musique est joue alors le menu est en faux sinon il est cliquable
If mmcDanceNever.Command = "play" Then
mnuPause.Enabled = True
mnuPlay.Enabled = False
mnuStopMusic.Enabled = True
Else
mnuPause.Enabled = False
mnuStopMusic.Enabled = False
End If
'Si memiv n'est pas a -1 alors l'activer
If MemIV = -1 Then
mnuNext.Enabled = False
Else
mnuNext.Enabled = True
End If
'Si le nom de playlist n'est pas vide
If txtPlayListName.Text <> "" Then
mnuSave.Enabled = True
Else
mnuSave.Enabled = False
End If
'On peux rendre le clique de l'tuilisateur si le temp ecoule est asser long 1 sec (on fait une double verification juste pour que MemIII augmente de 1 et ne sois plus egale apres)
If MemIII = 0 Then
MemIII = MemIII + 1
If MemIII = 1 Then
ClickUser = False
End If
End If
'Si un focus sur une autre musique est fait alors mettre a jour les deux autre
If lstPlayList.ListIndex <> lstPlayListName.ListIndex And lstPlayList.ListIndex <> lstPlayListPath.ListIndex Then
lstPlayListName.ListIndex = lstPlayList.ListIndex
lstPlayListPath.ListIndex = lstPlayList.ListIndex
ElseIf lstPlayListPath.ListIndex <> lstPlayListName.ListIndex And lstPlayListPath.ListIndex <> lstPlayList.ListIndex Then
lstPlayListName.ListIndex = lstPlayListPath.ListIndex
lstPlayList.ListIndex = lstPlayListPath.ListIndex
ElseIf lstPlayListName.ListIndex <> lstPlayList.ListIndex And lstPlayListName.ListIndex <> lstPlayListPath.ListIndex Then
lstPlayList.ListIndex = lstPlayListName.ListIndex
lstPlayListPath.ListIndex = lstPlayListName.ListIndex
End If
'Si une musique est selectionner activer le bouton play
If lstPlayList.ListIndex >= 0 Or lstPlayListName.ListIndex >= 0 Or lstPlayListPath.ListIndex >= 0 Then
mnuPlaylistPlay.Enabled = True
Else
mnuPlaylistPlay.Enabled = False
End If
'Si quelque chose est selectionné sur lstplaylistname alors activer le bouton modifier
If lstPlayListName.ListIndex >= 0 Then
mnuModify.Enabled = True
Else
mnuModify.Enabled = False
End If
'Mettre a jour le nombre de musiques
If lstPlayList.ListCount <> 0 Then
mnuMusics.Caption = "Number of musics on playlist: " + CStr(lstPlayList.ListCount)
Else
mnuMusics.Caption = "Number of musics on playlist: None"
End If
'Musique jouer actuelement
If mmcDanceNever.Command = "play" Then
mnuCurrent.Enabled = True
mnuCurrent.Caption = "Number of current music: " + CStr(MemIV + 1)
ElseIf mmcDanceNever.Command = "pause" Then
mnuCurrent.Enabled = False
Else
mnuCurrent.Enabled = False
mnuCurrent.Caption = "Number of current music: None"
End If
'Donne le nom de la fenetre comme nom de la musique
If mmcDanceNever.Command = "play" Then
If lstPlayListName.Visible Then
frmDanceNever.Caption = "DanceNever | " + lstPlayListName.List(MemIV)
ElseIf lstPlayList.Visible Then
frmDanceNever.Caption = "DanceNever | " + lstPlayList.List(MemIV)
ElseIf lstPlayListPath.Visible Then
frmDanceNever.Caption = "DanceNever | " + lstPlayListPath.List(MemIV)
End If
Else
frmDanceNever.Caption = "DanceNever"
End If
'On regarde combien il y a de musiques dans le dossier ouvert
If filOpen.ListCount <> 0 Then
mnuCountFolder.Caption = "Number of musics on folder: " + CStr(filOpen.ListCount)
Else
mnuCountFolder.Caption = "Number of musics on folder: None"
End If
'Si il y a une musique passer dans le random alors afficher le bouton pour voir la variable
If RandomPast <> " " Then
mnuShowRand.Enabled = True
Else
mnuShowRand.Enabled = False
End If
End Sub
Private Sub txtPlayListName_Change()
'Mets a jour les chemins des fichiers pour la playlist
PlayListIII = "PlayList\" + "Name" + txtPlayListName.Text + ".nev"
PlayListII = "PlayList\" + "Path" + txtPlayListName.Text + ".nev"
PlayListI = "PlayList\" + "Title" + txtPlayListName.Text + ".nev"
End Sub
Private Sub txtPlayListName_KeyDown(KeyCode As Integer, Shift As Integer)
'Si il clique sur enter faire comme si on clique sur saver
If KeyCode = 13 Then
Call mnuSave_Click
End If
End Sub
Private Sub txtStart_Change()
'Si le texte de start change en "go" alors appelé SaveName
If txtStart.Text = "go" Then
Call SaveName
'Si c'est la premiere musique a etre ajouter alors la lire sinon ne rien faire
If lstPlayList.ListCount = 1 Then
lstPlayListPath.ListIndex = 0
Call lstPlayListPath_DblClick
End If
End If
'Si le texte de start change en "size?" alors appelé Size
If txtStart.Text = "size?" Then
Call Size
End If
'le text vaut "end go"
txtStart.Text = "end go"
End Sub
Private Sub Size()
'On retaille l'image de fonds, pour quel fasse la bonne taille apres le chamgenement
imgBG.Height = frmDanceNever.Height
imgBG.Width = frmDanceNever.Width
End Sub
Private Sub Place()
'Mise à jour de l'emplacement du design (trois fois pour eviter les bugs)
For i = 0 To 2
'Si la fenetre est en statu normal
If frmDanceNever.WindowState <> 1 Then
'Si la fenetre et plus grande que 5625
If frmDanceNever.Height >= 5625 Then
'Si la fenetre est plus grande que 7680
If frmDanceNever.Width <= 7680 Then
frmDanceNever.Width = 7681
Else
'Tout le design se charge ici (bouton, image, frame, ...)
frmOpen.Width = frmDanceNever.Width / 2
frmPlayList.Width = frmOpen.Width
frmPlayList.Left = frmOpen.Width
lstPlayList.Width = frmPlayList.Width - 360
lstPlayListName.Width = lstPlayList.Width
lstPlayListPath.Width = lstPlayList.Width
txtPlayListName.Width = lstPlayList.Width
filPlayList.Width = lstPlayList.Width
frmPlayList.Height = frmDanceNever.Height - 360
frmOpen.Height = frmPlayList.Height
filOpen.Width = frmOpen.Width - 240 - driOpen.Width
filOpen.Height = frmOpen.Height - 600
lstPlayList.Height = frmPlayList.Height - txtPlayListName.Height - 820
lstPlayListName.Height = lstPlayList.Height
lstPlayListPath.Height = lstPlayList.Height
filPlayList.Height = lstPlayList.Height
dirOpen.Height = filOpen.Height - driOpen.Top - 240
txtPlayListName.Top = lstPlayList.Height + 240
Call Size
End If
Else
'Mettre la fenetre a la taille minimale
frmDanceNever.Height = 5626
End If
End If
Next i
End Sub
2ème Form
'________________________________________________________________'
'Nom: David Chardonnens '
'But: Option de DanceNever (projet MAS6) '
'________________________________________________________________'
Option Explicit
Dim Temp, strTemp
Dim Memory As Integer
Dim Directory, BGJPG, MemName, MemPath, MemFile As String
Private Sub cboExtension_Click()
'Change les extentions de fichier image
filJPG.Pattern = "*" + cboExtension.Text
End Sub
'Des qu'un click sur un des boutons pour annuler decharger la fennetre
Private Sub cmdCan_Click()
frmDanceNever.Show
Unload frmDanceNeverPlus
End Sub
Private Sub cmdCancel_Click()
frmDanceNever.Show
Unload frmDanceNeverPlus
End Sub
Private Sub cmdCel_Click()
frmDanceNever.Show
Unload frmDanceNeverPlus
End Sub
Private Sub cmdChange_Click()
'On ajoute tout dans la playlist
If txtName = "" Or txtName = " " Then
frmDanceNever.lstPlayListName.AddItem (MemName)
Else
frmDanceNever.lstPlayListName.AddItem (txtName.Text)
End If
frmDanceNever.lstPlayList.AddItem (MemFile)
frmDanceNever.lstPlayListPath.AddItem (MemPath)
'On affiche DanceNever et Cache les options
frmDanceNever.Show
Unload Me
End Sub
Private Sub cmdColor_Click(Index As Integer)
'Quand un click est executer sur une des couleurs, la mettre en fond et l'enregistrer et changer le bouton annuler
frmDanceNever.frmOpen.BackColor = cmdColor(Index).BackColor
frmDanceNever.frmPlayList.BackColor = cmdColor(Index).BackColor
strTemp = cmdColor(Index).BackColor
Temp = "Temp\Color.nev"
Open Temp For Output As #1
Print #1, strTemp
Close #1
cmdCel.Caption = "Finish"
End Sub
Private Sub cmdName_Click()
'Lancer une action sur l'interface Never
frmDanceNever.txtStart.Text = "go"
frmDanceNever.Show
Unload frmDanceNeverPlus
End Sub
Private Sub dirJPG_Change()
'Changer la FileBox par apport au dir
filJPG.Path = dirJPG.Path
End Sub
Private Sub driJPG_Change()
'Changer le dir par apport au Dirve selectionner
dirJPG.Path = driJPG.Drive
End Sub
Private Sub filJPG_DblClick()
'Des qu'une image est choisit, la mettre en fond sur DanceNever et enregistrer le chemin
Directory = dirJPG + "\" + filJPG
BGJPG = "Temp\BG.nev"
Open BGJPG For Output As #1
Write #1, Directory
Close #1
frmDanceNever.imgBG.Picture = LoadPicture(Directory)
frmDanceNever.txtStart.Text = "size?"
cmdCan.Caption = "Finish"
End Sub
Private Sub Form_Load()
'Choisir les chemins de base pour les images
dirJPG.Path = "Images\"
filJPG.Path = dirJPG.Path
frmDanceNeverPlus.Height = 750
frmDanceNeverPlus.Width = 3375
End Sub
Private Sub txtName_Change()
'Choix possible depuis l'interface Never
If txtName.Text = "don't use" Then
'Pour le nom d'un fichier
txtName.Visible = False
cmdName.Visible = False
cmdCancel.Visible = False
frmBG.Top = 0
frmDanceNeverPlus.Width = frmBG.Width
frmDanceNeverPlus.Height = frmBG.Height
End If
If txtName.Text = "color" Then
'Pour la couleur du fond
txtName.Visible = False
cmdName.Visible = False
cmdCancel.Visible = False
frmColor.Top = 0
frmDanceNeverPlus.Width = frmColor.Width
frmDanceNeverPlus.Height = frmColor.Height
End If
If txtName.Text = "Recharge Me Please!!!" Then
'Pour recharger DanceNever et se decharger
frmDanceNever.Show
frmDanceNever.filPlayList.Visible = True
Unload Me
End If
If txtName.Text = "No Name" Then
'Si no name est ecrit alors rendre la musique avec un nom nul et valider
txtName.Text = ""
Call cmdName_Click
End If
If txtName.Text = "ChangeName" Then
'Pour changer de nom
cmdChange.Visible = True
cmdName.Visible = False
'On remete le texte a la valeur du titre de depart
txtName.Text = frmDanceNever.lstPlayListName.List(frmDanceNever.lstPlayListName.ListIndex)
'On reprends les informations deja presente
Memory = frmDanceNever.lstPlayListName.ListIndex
MemName = frmDanceNever.lstPlayListName.List(Memory)
MemPath = frmDanceNever.lstPlayListPath.List(Memory)
MemFile = frmDanceNever.lstPlayList.List(Memory)
'On efface le tout
frmDanceNever.lstPlayListName.RemoveItem (Memory)
frmDanceNever.lstPlayList.RemoveItem (Memory)
frmDanceNever.lstPlayListPath.RemoveItem (Memory)
End If
End Sub
Private Sub txtName_DblClick()
'Quand l'utilisateur click sur le textbox nom, il s'efface
txtName.Text = ""
End Sub
Private Sub txtName_KeyDown(KeyCode As Integer, Shift As Integer)
'Quand l'utilisateur click sur enter dans la textBox l'action du bouton OK se fait appelé
Select Case KeyCode
Case 13
If cmdName.Visible Then
Call cmdName_Click
ElseIf cmdChange.Visible Then
Call cmdChange_Click
End If
End Select
End Sub
Conclusion :
Je l'ai fait seu dans le cadre d'un projet de cours, mais je l'utilise personnelement, c'est pour sa que je vous demande vos critiques.
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.