Code:
Option Explicit
Private Sub Add_Click()
Dim sfile As String
With Dialog
.CancelError = False
.Filter = "Mp3 files|*.mp3;"
.ShowOpen
If .FileName = "" Then
Exit Sub
ElseIf Not LCase$(Right$(.FileName, 4)) = ".mp3" Then
Exit Sub
End If
End With
sfile = Dialog.FileName
Dialog.FileName = ""
List1.AddItem sfile
sfile = ""
End Sub
Private Sub Back_Click()
Dim spev As String
If last < 1 Then
Exit Sub
End If
last = last - 1
spev = List1.List(last)
List1.ListIndex = List1.ListIndex - 1
Play.FileName = spev
Play.Play
plays = ""
Slider1.Max = Play.Duration
Songname.Caption = List1.Text
End Sub
Private Sub cmdplay_Click()
On Error Resume Next
Play.FileName = List1.Text
Play.Play
plays = ""
Slider1.Max = Play.Duration
Songname.Caption = List1.Text
End Sub
Private Sub Command1_Click()
VB.Unload Me
End
End Sub
Private Sub Command2_Click()
Play.Stop
End Sub
Private Sub Command3_Click()
On Error GoTo soo
Dim snext As String
last = last + 1
snext = List1.List(last)
List1.ListIndex = List1.ListIndex + 1
Play.FileName = snext
Play.Play
soo:
last = List1.ListIndex
plays = ""
Slider1.Max = Play.Duration
Songname.Caption = List1.Text
End Sub
Private Sub Command4_Click()
Dim sfile As String
With Dialog
.CancelError = False
.Filter = "Mp3 Play list|*.mpl"
.ShowOpen
If .FileName = "" Then
Exit Sub
End If
sfile = Dialog.FileName
Dialog.FileName = ""
End With
List1.Clear
Dim a As String
Dim X As String
On Error GoTo error
Open sfile For Input As #1
Do Until EOF(1)
Input #1, a$
List1.AddItem a$
Loop
Close 1
sfile = ""
Exit Sub
error:
X = MsgBox("File Not Found", vbOKOnly, "Error")
End Sub
Private Sub Command5_Click()
Me.WindowState = 1
End Sub
Private Sub Command6_Click()
List1.Clear
End Sub
Private Sub Command7_Click()
Image7_Click
End Sub
Private Sub Form_Load()
plays = "stop"
sloop = "False"
Slider2.Value = 2500
Dim sfile, a As String
sfile = App.Path + "\" + "default.mpl"
On Error GoTo serr
Open sfile For Input As #1
Do Until EOF(1)
Input #1, a$
List1.AddItem a$
Loop
Close #1
serr:
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim sfile As String
Dim i As Long
sfile = App.Path + "\" + "default.mpl"
On Error GoTo error
Open sfile For Output As #1
For i = 0 To 100
List1.ListIndex = i
Write #1, List1.Text
Next i
error:
Close #1
End Sub
Private Sub Image7_Click()
If frmmain.Height = 5715 Then
frmmain.Height = 2085
ElseIf frmmain.Height = 2085 Then
frmmain.Height = 5715
End If
End Sub
Private Sub Image8_Click()
frmAbout.Show vbModal
End Sub
Private Sub List1_DblClick()
plays = "stop"
Play.FileName = List1.Text
Play.Play
Slider1.Max = Play.Duration
last = List1.ListIndex
Songname.Caption = List1.Text
End Sub
Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
If List1.ListIndex = -1 Then
Else
List1.RemoveItem List1.ListIndex
End If
End If
End Sub
Private Sub mnumainclose_click()
End
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu main
End If
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
FormDrag Me
End If
End Sub
Private Sub open_Click()
Dim sfile As String
With Dialog
.CancelError = False
.Filter = "MP3 Files|*.mp3"
.ShowOpen
End With
If Dialog.FileName = "" Then
Exit Sub
ElseIf Not Right$(Dialog.FileName, 4) = ".mp3" Then
Exit Sub
End If
sfile = Dialog.FileName
Dialog.FileName = ""
Play.FileName = sfile
List1.Clear
List1.AddItem sfile
Slider1.Max = Play.Duration
sfile = ""
List1.ListIndex = 0
Songname.Caption = List1.Text
End Sub
Private Sub Pause_Click()
On Error Resume Next
If Play.PlayState = 1 Then
Play.Play
Else
Play.Pause
End If
End Sub
Private Sub Play_EndOfStream(ByVal Result As Long)
If Rep.BackColor = &HFF& Then
Exit Sub
Else: Play.Play
End If
End Sub
Private Sub Rem_Click()
If List1.ListIndex = -1 Then
Else
List1.RemoveItem List1.ListIndex
End If
End Sub
Private Sub Rep_Click()
If Rep.BackColor = &HFF& Then
Rep.BackColor = &HFF00&
sloop = "True"
ElseIf Rep.BackColor = &HFF00& Then
Rep.BackColor = &HFF&
sloop = "False"
End If
End Sub
Private Sub Savelist_Click()
Dim i As Long
Dim sfile As String
With Dialog
.CancelError = False
.Filter = "Mp3 list|*.mpl"
.ShowOpen
If .FileName = "" Then
Exit Sub
End If
End With
sfile = Dialog.FileName
Dialog.FileName = ""
On Error GoTo error
Open sfile For Output As #1
For i = 0 To 100
List1.ListIndex = i
Write #1, List1.Text
Next i
error:
Close #1
End Sub
Private Sub Slider1_Click()
Play.CurrentPosition = Slider1.Value
End Sub
Private Sub Slider1_Scroll()
Play.CurrentPosition = Slider1.Value
End Sub
Private Sub Slider2_Click()
Play.Volume = Slider2.Value - 2500
End Sub
Private Sub Slider2_Scroll()
Play.Volume = Slider2.Value - 2500
End Sub
Private Sub Timer1_Timer()
Slider1.Value = Play.CurrentPosition
End Sub
Private Sub Timer2_Timer()
Dim tinseconden As Long
Dim lengths, lengths1, min, sec As Long
lengths = Play.Duration
tinseconden = Play.CurrentPosition
lengths1 = lengths - tinseconden
min = lengths1 \ 60
sec = lengths1 - min * 60
time.Caption = min & " : " & sec
End Sub
In order to use your player as default, do the following: