İlk Yapılacaklar :
1- Bi tane veritabanı oluşturun, adı sabit.mdb olsun.
2- Bu veritabanında bi tane tablo oluşturun adı tbl_muzikyayini olsun.
3- Bu tabloyada iki tane alan yerleştirin, biri zil_müzikler_toplanmis diğeri zil_müzikler_acilmis olsun.
4- Sonra forma; 2 list kutusu, 4 text kutusu, 1 comman button, 1 data nesnesi, 2 timer, 1 tanede commondialog control ekleyin.
5- Commanbuttonun captionuna ekle yazın.
6- Timerlerin interval özelliğini 1 yapın.


Açıklama :
1- Commandbutonun captionuna ekle yazın, bununla belirttiğimiz bir klasörden müzik dosyasını list2'ye akatarıcaz.list2'de dosyanın tam yolu yazacağı için, ordan list1'e sadece müzik dosyasının adı gelecek.
2- Text4 ile müziğin şu an çalıp çalmadığını kontrol edicez, çalıyosa playing yazacak, çalmıyorsa stoping yazacak.
3- Timer2 ile durumu kontrol edicez müzik dosyası çalıyomu çalmıyomu, buna göre bir sonraki müzik dosyasını çaldırtıcaz.
4- Timer1 ile de duruma göre bir sonraki müzik dosyasını çaldırıcaz.
5- Text3 ile çalınan müzik dosyasının uzunluğunu dakika cinsinden göstericez.

VEEEE AŞAĞIDAKİ KODLARI OLDUĞU GİBİ FORMA YAPIŞTIRICAZ

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 Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long



Function StripPath(T$) As String '''''''Dosyanın kısa adını gösteren kod
Dim x%, ct%
StripPath$ = T$
x% = InStr(T$, "")
Do While x%
ct% = x%
x% = InStr(ct% + 1, T$, "")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function

Private Sub Command1_Click() '''''Projemize müzik dosyası buradan ekleniyor
On Error Resume Next
Data1.Recordset.AddNew
Data2.Recordset.AddNew

With CommonDialog1
'On Cancel do nothing
.CancelError = True

.DialogTitle = "\\\\\\\\\\\\\\\\\Sunasoft Yazılım///////////////////////////////////"
.Filter = "Hepsi ( *.mp3 *.wav *.mid ) |*.mp3;*.wav;*.mid|Şarkı Dosyaları (*.mp3) |*.mp3; |Ses Dosyaları (*.wav) |*.wav; |Midi Dosyaları (*.mid) |*.mid"
.InitDir = App.Path & "müzikler"
.ShowOpen
'Handle no filename
If Len(.FileName) = 0 Then Exit Sub

Text1.Text = .FileName
List1.AddItem Text1.Text


file = StripPath(Text1.Text)
Text2.Text = file
List2.AddItem file

List1.Clear
List2.Clear
Form_Activate

End With

error: 'Do nothing

End Sub



Private Sub Form_Activate() '''Burada list kutusunu veritabanına bağlıyoruz
On Error Resume Next
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
List1.AddItem (Data1.Recordset![zil_müzikler_acilmis])
Data1.Recordset.MoveNext
Loop

Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
List2.AddItem (Data1.Recordset![zil_müzikler_toplanmis])
Data1.Recordset.MoveNext
Loop

End Sub


Private Sub Form_Load() ''''Data nesenesine bağlantı ayarları buradan yapılıyor
mciSendString "close Yenises", 0, 0, 0 'Müzik dosyasını kapat

Data1.DatabaseName = App.Path & "sabit.mdb"
Data1.RecordSource = "tbl_muzikyayini"
End Sub

Private Sub Form_Unload(Cancel As Integer) '''Çıkarken çalan müziği kapatıyoruz
mciSendString "close Yenises", 0, 0, 0
End Sub

Private Sub List2_Click() ''''List2'de tıklanan müziği çaldırtıyoruz
On Error Resume Next

Dim i
For i = 0 To List2.ListCount - 1
If List2.Selected(i) Then

mciSendString "close Yenises", 0, 0, 0
Hata = mciSendString("open " & Chr$(34) & List2.List(i) & Chr$(34) & " alias YeniSes", 0, 0, 0)
mciSendString "play YeniSes", 0, 0, 0 'Müziği oynatma kısmı

Dim Dondur As String * 128 '''Burada adı geçen dondur=çalmasüresidir
mciSendString "status YeniSes length", Dondur, 128, 0
Text3.Text = ((Dondur / 60000))

End If
Next

End Sub

Private Sub Timer1_Timer()

If Text4.Text = "stopped" Then 'Eğer müzik dosyası çalmıyorsa demek oluyo.


If List2.ListIndex = List2.ListCount - 1 Then '''Eğer listenin sonuna gelinmişşe
List2.Selected(0) = True '''Listenin en başındakini seç
Else 'Gelmemişse daha o zaman alttaki koddan devam et
List2.Selected(List2.ListIndex + 1) = True ''Bir önceki dosyadan sonrakini çalmaya devam et
End If



For i = 0 To List2.ListCount - 1
If List2.Selected(i) Then

mciSendString "close Yenises", 0, 0, 0
Hata = mciSendString("open " & Chr$(34) & List2.List(i) & Chr$(34) & " alias YeniSes", 0, 0, 0)
mciSendString "play YeniSes", 0, 0, 0

Dim Dondur As String * 128
mciSendString "status YeniSes length", Dondur, 128, 0
Text3.Text = ((Dondur / 60000))

End If
Next

End If

End Sub

Private Sub Timer2_Timer() '''Durumu sürekli olarak kontrol et
Dim Durum As String * 128
mciSendString "status YeniSes mode", Durum, 128, 0
Text4.Text = Durum
End Sub


Not : ;
Daha çok açıklama yapmak isterdim ama, bunların yeterli olacağını düşünüyorum, siz bi bakın takıldığınız yer olursa ben yardımcı olurum.