Senin, 16 Mei 2011

Media Player with VB 6.0










Langkah Pembuatan
  1. Aktifkan Vb 6.0 Buat Projrct Baru
  2. Pilih menu Project -> add Form
  3. Pilih lagi menu Project -> Componen -> beri Conteng Pada
-          Microsoft Common Dialog Control 6.0 (SP3)
-          Microsoft Multimedia Control 6.0
-          Microsofr Common Control 6.0 (SP6) 
-          Window Media Player

  1. Pilih lagi menu Project -> add File -> masukkan file Modul dan User Cintrol 
  2. Buat form dengan rancangan berikut


 




Code Form 1

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
 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_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 form2

Option Explicit

Private Sub Form_Load()
Me.Top = 1000
Me.Left = Screen.Width
Timer1.Interval = 1
End Sub

‘Memanggil Prosedur Window Media Player Next pada form 1
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

Private Sub Timer3_Timer()
ProgressBar1.Value = WindowsMediaPlayer1.Controls.currentPosition
ProgressBar1.Max = WindowsMediaPlayer1.currentMedia.duration
Text1.Text = ProgressBar1.Value
Text2.Text = (ProgressBar1.Max - 2)
If Val(Text1.Text) >= Val(Text2.Text) Then
Timer2.Interval = 1
Else
Timer2.Interval = 0
End If
End Sub


 Untuk Instal Klik di sini :


RH Media Player V3.0.zip

RH Media Player V3.0 (Indonesia).rar

RH Media Player v.3.0.zip
Diposting oleh di
Label: ,

36 komentar:

  1. Anonim1 Juni 2011 pukul 16.35

    mas ga apa" kalo program ini saya kembangkan?

    BalasHapus
  2. Unknown7 Juni 2011 pukul 15.40

    Silahkan saja
    - saya boleh minta ya projectnya jika sudah selesai
    heheh.....

    BalasHapus
  3. mulyadie leo1 Oktober 2011 pukul 15.36

    numpang copy ya maz..
    q mw memahami n coba tuk mengembangkan lage..
    mksh maz..
    sukses selalu.

    BalasHapus
  4. Unknown22 Januari 2012 pukul 19.08

    maz q mw reques sofwere buat skin vb6 mazzz q tunggu scepatnya...............

    BalasHapus
    Balasan
    1. Unknown15 Maret 2012 pukul 14.34

      download di sini:
      http://www.4shared.com/rar/Xyq3qCJX/skin_form.html

      Hapus
  5. Unknown24 Februari 2012 pukul 02.00

    mas sediakan komponentnya fb dong

    BalasHapus
    Balasan
    1. Unknown15 Maret 2012 pukul 14.36

      ya...
      entar dicoba membuat x...
      terimakasi telah berkunjung

      Hapus
  6. Muhammad Sholihin11 Oktober 2012 pukul 19.27

    bikin biar bisa di istall di hardisk gimana mass.?

    BalasHapus
    Balasan
    1. Unknown12 November 2012 pukul 23.42

      di buat portebel aja pake winrar, tapi sebelumnya kumpulkan file OCX & DLL Package and Deployment Wizart, hasilnya pada folde support itu yang dijadian menjadi portebel

      Hapus
  7. Dian Apriani cuantek cekaleeee25 Februari 2013 pukul 14.14

    mz jika saya ingin membuat media player tetapi nanti program akan memulai sendiri lewat waktu yang sudah kita tentukan, caranya bagaimana ya???
    misal qt seting waktu pukul 13.00 , nah pada watu jam itu aplikasi player otomatis jalan sendiri...
    mohon bantuanya,terimakasih

    apingablh@gmail.com

    BalasHapus
    Balasan
    1. Unknown2 Maret 2013 pukul 14.55

      Buat aja from yang dilengkapi dengan timer

      jika waktu yang ditentukan sama dengan waktu sekarang maka
      tampilkan from Player
      jalankan perntah Play musik

      Pada timer Buat koding semisal

      if TxtTimer.text = Format$(Time, "HH:NN")'Format jam 24
      then
      FrmPlayer.Show
      FrmPLayer.Play_Musik
      end if

      pada form FrmPlayer buat sub agar bisa di panggil pada form lain

      Sub Play_Musik
      - Perintah Untuk Play
      end sub

      Hapus
    2. Unknown2 Mei 2013 pukul 05.29

      Mas Kalo nampilin Durasi gimana yah... Q dah coba2 ttp g jalan

      Hapus
    3. Unknown12 Juli 2013 pukul 21.30

      Label1.Caption = Me.WindowsMediaPlayer1.currentMedia.durationString

      Hapus
  8. Unknown8 Juli 2013 pukul 14.28

    mas mengganti slidernya sesuai keinginan kita gimana?, udah saya coba tapi tetep aja tampilan slidernya jadul..... plis mohon pencerahannya...

    BalasHapus
    Balasan
    1. Unknown12 Juli 2013 pukul 21.36

      code slider x di koding dalam timer, dan timer aktif/Enable=True saat musik play jika stop timer di matikan/enable=false

      Private Sub Timer1_Timer()
      slider1.Value = WindowsMediaPlayer1.Controls.currentPosition
      slider1.Max = WindowsMediaPlayer1.currentMedia.duration
      end sub

      perhatikan, name object x

      Hapus
    2. Unknown5 Maret 2014 pukul 01.29

      http://edukasi-informatika.blogspot.com/2011/06/music-player-mix-v320.html

      Hapus
  9. Unknown18 Oktober 2013 pukul 16.43

    mas mau tanya....
    klo playlist'y pake database caranya gmn???
    bisa g mas??

    thank's infonya

    BalasHapus
  10. Unknown10 Desember 2013 pukul 22.20

    mas jika kita putar secara otomatis pada waktu yang kita tentukan gmana caranya..file musik kita sudah ada dalam database

    BalasHapus
    Balasan
    1. Unknown5 Maret 2014 pukul 03.04

      http://edukasi-informatika.blogspot.com/2012/05/teblet-for-pclapotopnotebook-v-12.html

      Hapus
  11. Unknown10 Desember 2013 pukul 22.23

    mas jika kita putar secara otomatis pada waktu yang kita tentukan gmana caranya..file musik kita sudah ada dalam database. dah q coba beberapa kali ggal. kadang juga gak bisa pindah musik klo musiknya lebih dari 1

    BalasHapus
    Balasan
    1. Unknown5 Maret 2014 pukul 03.06

      http://edukasi-informatika.blogspot.com/2012/05/teblet-for-pclapotopnotebook-v-12.html

      Hapus
  12. Unknown6 Maret 2014 pukul 20.24

    mas gimana caranya supaya lagu berganti secara otomatis apabila lagu yang kita putar telah selesai dan langsung next ke lagu yang lain secara otomatis...????

    mohon pencerahannya mas

    BalasHapus
    Balasan
    1. Unknown6 Maret 2014 pukul 23.51

      algoritmanya seperti ini:

      if WMP.Corenposition = WMP.Corenduration then
      if list pada posisi akhir and REFEAT = On then
      List.item.MoveFirst
      WMP.PLay
      else if ist pada posisi akhir and REFEAT = Off then
      WMP.Stop
      else
      List.item.MoveNext
      WMP.PLay
      end if
      end if

      Hapus
  13. Unknown9 Maret 2014 pukul 23.59

    tapi kok pada if list pada posisi akhir and REFEAT = On then
    gak bisa malah error

    BalasHapus
  14. Unknown8 Mei 2014 pukul 00.54

    bang cara bikin equalizer yang tercantum untuk mengatur beragam macam jenis seperti classical jazz dll tu gimana?

    BalasHapus
  15. Unknown8 Agustus 2014 pukul 15.01

    kalau itu video mau kita simpan bagaimana caranya?
    terima kasih.

    BalasHapus
  16. Unknown22 April 2015 pukul 19.48

    keren juga ternyata vb 6, jadi tertarik nih buat belajar. oh iya mas Bisa minta sarannya ga?bahasa pemrograman yang enak buat dipelajari apa ya mas? saya masih baru banget belajar tentang pemrograman soalnya hmm.

    Makasih infonya mas, kapan kapan berkunjung ke blog saya yaa (y)
    mokingjay-art.blogspot.com

    BalasHapus
  17. Nano Saputra29 April 2015 pukul 02.04

    mas kalau mp3 nya pakai database gimana..kayak winamp sama AIMP gitu..??

    BalasHapus
  18. Unknown22 September 2015 pukul 08.03

    Mas mau tnyak donk kalau mau hapus daftar lagu yang di list itu gmna ?
    mohon bantuannya >>>>

    BalasHapus
  19. Unknown22 September 2015 pukul 08.04

    Mas mau tnyak donk kalau mau hapus daftar lagu yang di list itu gmna ?
    mohon bantuannya >>>>

    BalasHapus
    Balasan
    1. zenlypay29 Oktober 2015 pukul 13.23

      Private Sub Button4_Click()
      ListView1.ListItems.Clear
      List1.Clear
      End Sub

      untuk menghapus semua lagu di list

      Private Sub Button5_Click()
      On Error Resume Next
      List1.ListIndex = ListView1.selectedItem.Index - 1
      ListView1.ListItems.Remove (ListView1.selectedItem.Index)
      List1.RemoveItem (List1.ListIndex)
      List1.Selected(Val(FrmPlayer1.LbTrack.Caption) - 1) = True

      End Sub

      untuk 1 lagu

      Hapus
  20. Unknown22 Januari 2016 pukul 10.48

    kurang siip

    BalasHapus
  21. Unknown30 Mei 2016 pukul 12.01

    kok ga bisa dijalankan ya mas? sudah di run, tapi lagu yang diputar tidak ada suara, dan slidernya tidak berfungsi. kenapa ya mas? masih pemula nih :)

    BalasHapus
    Balasan
    1. DAFA BLOGER18 November 2016 pukul 03.10

      coba di cek lagi mbak

      Hapus
    2. DAFA BLOGER18 November 2016 pukul 03.11

      kalo mbak pengen share seputar visual basic 6.0 silahkan kontak ke email saya di mudaffar88@gmail.com dan juga untuk semua kawan yang lain, karena saya juga memakai vb6

      Hapus
  22. Tetesan Embun Mimbar Jumat29 November 2017 pukul 08.20

    mas rahman minta contoh koding vb 6, buat form yg bisa pangil otomatis dengan mengunkan durasi waktu tertentu

    BalasHapus

Langganan: Posting Komentar (Atom)