İ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.