Pada Mp3 Player kali ini menggunakn User Control sebagai perangkat pendukungnya dan Multi Media Control (MMContrl) sebagai media playernya, tombol nya mengunakan Button dari User Control jadi anda harus meng-Add button dan Slider dari user control buat rancangan fom sebagai mana gambar berikut :
Gambar : Rancangan Form Mp3 Player
Membuat menu utama Nya dangan Pilih menu Tools à Menu Editor
Setelah Formnya siap tinggal anda masukkan kode berikut :
Dim posTengah As Integer
Dim File As String
Dim Kode As Boolean
Dim EndTrack As Long
______________________________________________________
Sub Play()
File = File1.Path & "\" & File1.FileName
If Mid(File, 3, 1) = "\" And Mid(File, 4, 1) = "\" Then
Path = Left(File1.Path, 3)
File = Path & File1.FileName
Else
File = File1.Path & "\" & File1.FileName
End If
MMControl1.FileName = File
MMControl1.Command = "Open"
EndTrack = MMControl1.TrackLength
If EndTrack = 0 Then
MsgBox "Soory Can't Play in this Application", vbOKOnly + vbCritical, "Scope Error"
Else
Label2.Caption = EndTrack
End If
End Sub
____________________________________________________________
Private Sub ButNext_Click()
MMControl1.Command = "Next"
End Sub
______________________________________________________________
Private Sub ButPause_Click()
MMControl1.Command = "Pause"
End Sub
______________________________________________________________
Private Sub ButPlay_Click()
MMControl1.Command = "Play"
BarOke
End Sub
__________________________________________________________
Private Sub Butprev_Click()
MMControl1.Command = "Prev"
End Sub
_______________________________________________________
Private Sub ButStop_Click()
MMControl1.Command = "Stop"
MMControl1.Refresh
MMControl1.Command = "Close"
Kode = True
End Sub
__________________________________________________
Private Sub Dir1_Change()
File1.Path = Dir1.Path
File1.FileName = "*.MP3"
End Sub
____________________________________________________
Private Sub Drive1_Change()
On Error GoTo Perangkap
Dir1.Path = Drive1.Drive
Perangkap:
Select Case Err
Case 68
MsgBox "Can't Access Drive " & Drive1.Drive, vbOKOnly + vbCritical, "Scope Error"
Drive1.Refresh
Case 0
Exit Sub
End Select
End Sub
__________________________________________________________
Private Sub File1_Click()
MMControl1.Command = "Close"
MMControl1.Refresh
Label1.Caption = File1.FileName
Play
End Sub
_____________________________________________________
Private Sub File1_DblClick()
Play
BarOke
MMControl1.Command = "Play"
End Sub
______________________________________________________
Private Sub Form_Activate()
FrmPlayer.Height = 5580
End Sub
___________________________________________________________
Private Sub Form_Load()
‘Mengatur Posisi awal Muuncul dan Posisi pada Dekstop
Me.Top = Me.Height * -1
Me.Left = (Screen.Width - Me.Width) / 2
posTengah = (Screen.Height - Me.Height) / 2
Me.Timer1.Interval = 50
End Sub
_________________________________________________________________
Private Sub Form_Resize()
'mengatur tinggi secara ototmatis ketika form di tinggikan
Frame2.Height = (FrmPlayer.Height - 3800)
File1.Height = (Frame2.Height - 450)
Dir1.Height = File1.Height
Labeltitle.Top = (FrmPlayer.Height - 1250)
'mengatur lebar secara otomatis ketika form di lebarkan
Frame2.Width = (FrmPlayer.Width - 390)
File1.Width = Frame2.Width / 2
Dir1.Width = (Frame2.Width / 2 - 280)
File1.Left = ((Frame2.Width - 100) / 2)
Labeltitle.Width = FrmPlayer.Width
Slider1.Width = (FrmPlayer.Width - 390)
Label1.Width = FrmPlayer.Width
End Sub
____________________________________________________
Private Sub MMControl1_Done(NotifyCode As Integer)
If Kode = True Then Exit Sub
If MMControl1.TrackLength = MMControl1.Position Then
If File1.ListCount = File1.ListIndex Then
MMControl1.Command = "Close"
Else
With File1
.ListIndex = .ListIndex + 1
End With
BarOke
MMControl1.Command = "Play"
End If
End If
End Sub
Private Sub MMControl1_PlayClick(Cancel As Integer)
Play
BarOke
End Sub
________________________________________________________
Private Sub MMControl1_StopClick(Cancel As Integer)
MMControl1.Refresh
MMControl1.Command = "Close"
Kode = True
End Sub
___________________________________________________
Private Sub nmAbout_Click()
Me.Hide
FrmAboutMP3.Show
End Sub
________________________________________________________
Private Sub nmExit_Click()
Keluar
End Sub
_____________________________________________
Sub Keluar()
posTengah = Me.Top
Me.Top = Me.Top + 10
Me.Timer2.Interval = 50
End Sub
Private Sub nmNext_Click()
MMControl1.Command = "Next"
End Sub
___________________________________________________
Private Sub nmpause_Click()
MMControl1.Command = "Pause"
End Sub
___________________________________________________
Private Sub nmPlay_Click()
MMControl1.Command = "Play"
BarOke
End Sub
_____________________________________________________
Private Sub nmPrev_Click()
MMControl1.Command = "Prev"
End Sub
____________________________________________________
Private Sub nmstop_Click()
MMControl1.Command = "Stop"
MMControl1.Refresh
MMControl1.Command = "Close"
Kode = True
End Sub
______________________________________________________
Private Sub Timer1_Timer()
‘Mengatur cara Form Masuk
If Me.Top < posTengah Then
Me.Top = Me.Top + ((posTengah - Me.Top) / 2)
Else
Me.Top = posTengah
Me.Timer1.Interval = 0
End If
End Sub
______________________________________________________
Private Sub Timer2_Timer()
‘Mengatur cara form keluar
If Me.Top < Screen.Height Then
Me.Top = Me.Top + ((Me.Top - posTengah) * 2)
Else
Unload Me
End If
End Sub
______________________________________________________
Sub BarOke()
Slider1.min = 0
Slider1.Max = Val(MMControl1.TrackLength)
End Sub
________________________________________________________
‘Mengatur kerja slider
Private Sub Timer3_Timer()
Slider1.Value = MMControl1.Position
Label3.Caption = MMControl1.Position
End Sub
_________________________________________________________
‘Jam Digital
Private Sub Timer4_Timer()
Label5.Caption = Time
End Sub
Tidak ada komentar:
Posting Komentar