Udah beberapa hari ni kagak ada posting hehe soalnya lagi belajar lebih lanjut ni tentang vb. .
Ane udah dapet ni cara membuat tu MEDIA PLAYER dari visual basic
yaudah langsung aja ntar kalo basa basi mulu kagak jadi posting ni wkwkwkw
Langkah Pertama :
- Buka visual basic
- Tekan Ctrl + T
-Lalu beri tanda ceklis pada
. Microsoft Common Dialog 6.0 (sp3)
. Microsoft Multimedia Control 6.0
. Microsoft common Control 6.0 (sp6)
. Windows Media Player
Lalu aply dan close
-PIlih Menu Project add file Masukan File Module dan file control
-Buat Desain seperti Berikut
form 1
.bmp)
form 2
.bmp)
.bmp)
.bmp)
Langkah Berikunya yaitu memberi Code
-Klik kanan pada form lalu paste kan Code berikut..
Option Explicit
Dim File As String
Dim Kode As Boolean
Dim EndTrack As Long
Dim Jam, menit, detik, mldetik As Integer
Sub Play()
'-----Pengaturan Waktu Time Player----------
mldetik = 0
detik = 0
menit = 0
Jam = 0
'-----------------------------------------
File = List2
If Mid(File, 3, 1) = "\" And Mid(File, 4, 1) = "\" Then
'Path = Left(List1, 3)
File = List1
Else
File = List2
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, "Player Error"
End If
End Sub
'-----Memerintahkan Window Media Player Next----------
Sub WMplayerNext()
If Label1.Caption = Label2.Caption Then
List1.ListIndex = 0
Timer6.Enabled = True
Else
With List1
.ListIndex = .ListIndex + 1
End With
Timer6.Enabled = True
End If
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
File1.FileName = "*.MP3;*.Mpg;*.WAV;*.MIDI;*.DAT;*.AVI"
End Sub
Private Sub Drive1_Change()
On Error GoTo Perangkap
Perangkap:
Select Case Err
Case 68
MsgBox "Can't Access Drive " & vbOKOnly + vbCritical, "Scope Error"
Refresh
Case 0
Exit Sub
End Select
End Sub
Private Sub File1_DblClick()
If File1.FileName = "" Then
Exit Sub
Else
List1.AddItem File1.FileName
List2.AddItem File1.Path & "\" & File1.FileName
Label1.Caption = List1.ListIndex + 1
Label2.Caption = List1.ListCount
End If
End Sub
Private Sub Form_Load()
'mengatur posisi awal form
Me.Left = 5000
Me.Top = Screen.Height
Timer5.Interval = 1
End Sub
'mengakhiri semua proses jika form ini Unload
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'menghapus semua file di list player
Private Sub GradientButton1_Click()
List1.Clear
List2.Clear
End Sub
Private Sub GradientButton2_Click()
Dim i As Integer
If i = 0 Then
MsgBox " tiadak ada selected"
Else
i = List1.ListIndex
List1.RemoveItem (i)
End If
End Sub
'meng add file mengunakan tool CommonDialog
Private Sub GradientButton3_Click()
On Error Resume Next
Dim buka As String
With CommonDialog1
.Filter = "All Support|*.mp3;*.wav;*.mid;*.wma;*.dat;*.avi;*.wmv;*.mpeg;*.mpg|mp3 files|*.mp3|all files|*.*"
.DialogTitle = "Mp3 Player V 1.0 Open Music files"
.FileName = ""
.ShowOpen
buka = .FileName
If .FileName = "" Then
Exit Sub
Else
List2.AddItem buka
List1.AddItem .FileTitle
End If
End With
End Sub
Private Sub GradientButton4_Click()
If Label1.Caption = Label2.Caption Then
MsgBox "Index Tidak Ada"
Else
With List1
.ListIndex = .ListIndex + 1
End With
End If
End Sub
Private Sub GradientButton5_Click()
If GradientButton5.Caption = "Repeat" Then
GradientButton5.Caption = "OFF"
Else
GradientButton5.Caption = "Repeat"
End If
End Sub
Private Sub GradientButton6_Click()
If GradientButton6.Caption = "<" Then
Timer3.Interval = 1
GradientButton6.Caption = ">"
Else
Timer4.Interval = 1
GradientButton6.Caption = "<"
End If
End Sub
'jika List1 di klik maka siap untuk di PLAY di MMControl
Private Sub List1_Click()
List2.ListIndex = List1.ListIndex
Label1.Caption = List1.ListIndex + 1
Label2.Caption = List1.ListCount
MMControl1.Command = "Close"
MMControl1.Refresh
Play
End Sub
' jika list1 di Double click maka jalankan Windows Media Player
Private Sub List1_DblClick()
Form2.Show
Form2.WindowsMediaPlayer1.URL = List2
Form2.WindowsMediaPlayer1.ShowWhatsThis
End Sub
Private Sub MMControl1_Done(NotifyCode As Integer)
If Kode = True Then Exit Sub
If MMControl1.TrackLength = MMControl1.Position Then
'======Kode Pengaturan Next dan Repeat===========================
If Label1.Caption = Label2.Caption Then
'------jika tombol 4 bertulis repeat maka jalankan-------------
If GradientButton5.Caption = "Repeat" Then
If Label2.Caption = "1" Then
'MsgBox "Soory Can't Repeat", vbOKOnly + vbCritical, "Player Error"
MMControl1.Command = "Close"
Timer2.Enabled = False
Label6.Caption = "STOP"
Label6.BackColor = &HFF&
'__jika list index tidak = 1 maka list index ke posisi paling atas dan PLAY____
Else
If Label1.Caption = Label2.Caption Then
List1.ListIndex = 0
MMControl1.Command = "Play"
End If
End If
'_jika tombol 4 tidak bertulis REPEAT maka Player STOP--
Else
If Label1.Caption = Label2.Caption Then
MMControl1.Command = "Close"
Label6.Caption = "STOP"
Label6.BackColor = &HFF&
End If
End If
'--jika List index tidak sama dangan list Count maka NEXT PLAYER---
Else
With List1
.ListIndex = .ListIndex + 1
End With
MMControl1.Command = "Play"
End If
End If
End Sub
'Tombol PAUSE
Private Sub MMControl1_PauseClick(Cancel As Integer)
If Label6.Caption = "PLAY" Then
Timer2.Enabled = False
Label6.Caption = "PAUSE"
Label6.BackColor = &HFFFF&
Else
Timer2.Enabled = True
Label6.Caption = "PLAY"
Label6.BackColor = &HFF00&
End If
End Sub
'Tombol Play
Private Sub MMControl1_PlayClick(Cancel As Integer)
Play
ProgressOke
Label3.Caption = List1
Timer2.Enabled = True
Label6.Caption = "PLAY"
Label6.BackColor = &HFF00&
End Sub
'tombol STOP
Private Sub MMControl1_StopClick(Cancel As Integer)
MMControl1.Refresh
MMControl1.Command = "Close"
Kode = True
Timer2.Enabled = False
Label6.Caption = "STOP"
Label6.BackColor = &HFF&
End Sub
'Mengatur Posis Slider
Sub ProgressOke()
Slider1.Min = 0
Slider1.Max = Val(MMControl1.TrackLength)
End Sub
'menjalankan Slide saat Play
Private Sub Timer1_Timer()
On Error Resume Next
Slider1.Value = MMControl1.Position
End Sub
Private Sub Timer2_Timer()
'penghitung waktu
If mldetik = 10 Then
detik = detik + 1
mldetik = 0
End If
If detik = 60 Then
menit = menit + 1
detik = 0
End If
If menit = 60 Then
Jam = Jam + 1
menit = 0
End If
'----Menampilkan Ke Label------------------------------
Label5.Caption = Jam & ":" & menit & ":" & detik
mldetik = mldetik + 1
End Sub
'Menutup File Box
Private Sub Timer3_Timer()
Form1.Width = Val(Form1.Width) - 100
If Form1.Width <= 3375 Then
Timer3.Interval = 0
End If
End Sub
'membuka File Box
Private Sub Timer4_Timer()
Form1.Width = Form1.Width + 100
If Form1.Width >= 5985 Then
Timer4.Interval = 0
End If
End Sub
'mengatur form muncul DARI BAWAH KE ATSAS
Private Sub Timer5_Timer()
If Me.Top <= 1000 Then
Timer1.Interval = 0
Else
Me.Top = Me.Top - 100
End If
End Sub
Code form 2
Option Explicit
Private Sub Form_Load()
Me.Top = 1000
Me.Left = Screen.Width
Timer1.Interval = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form1.WMplayerNext
End Sub
Private Sub Timer1_Timer()
If Me.Left <= (5000 - Me.Width) Then
Timer1.Interval = 0
Else
Me.Left = Me.Left - 100
End If
End Sub
Private Sub Timer2_Timer()
If Me.Top >= Screen.Height Then
Unload Me
Else
Me.Top = Me.Top + 100
End If
End Sub
Lalu tekan F5 jika terjadi eror silahkan komen.
Segini dulu ya postingan hari ni mau makan dulu ni udahh laper hehehe
Jika agan berminat download yang sudah jadi Di sini
TRIMAKASIH
.bmp)
.bmp)
.bmp)
.bmp)
.bmp)
.bmp)
.bmp)
.bmp)