Membuat Program Media Player MP3 Sederhana dengan VB6


Meski akan segera UAS namun hasrat untuk tetep menulis tidak tertahankan lagi apalagi blog ini seakan tidak keurus lagi dikarenakan beragam kesibukan yang melanda. Namun, di tengah berbagai kesibukan yang melanda kali ini saya kembali lagi memposting sebuah artikel sederhana dan masih seputar pemrograman yaitu program tentang media player untuk format file MP3. Meski sangat sederhana, namun program ini dapat Anda jadikan sebagai media maupun referensi untuk memulai membuat program serupa atau bagi Anda yang sudah mahir Anda juga dapat memahami teknik maupun coding yang terdapat dalam program ini untuk lebih dikembangkan lagi sehingga menjadi program yang lebih kompleks dan menarik. Berikut gambar dari program final yang telah berhasil dirancang.

media-player

Untuk saat ini program ini tidak membutuhkan sebuah database karena data yang kita ambil dan mainkan hanya berasal dari local hard disk meski memang bisa juga jika dibuatkan database khusus untuk menyimpan data lagu baik yang bersifat flat database maupun menggunakan tool RDBMS.

Konsep yang diusung dalam program ini sangatlah sederhana dimana adanya berbagai tombol-tombol yang secara umum terdapat di dalam aplikasi media player MP3. Pengguna dapat memilih sbeuah file MP3 tunggal dan akan langsung dimainkan. Atau pengguna juga bisa memilih beberapa file lagu MP3 lalu memainkan lagu mana yang disukai, bisa dengan menekan tombol Play atau dengan double click.

Kebutuhan dasar untuk pengembangan program ini adalah sebagai berikut:
1. Pastinya IDE Visual Studio 6 donk
2. Component Microsoft Multimedia Control 6.0
3. Component Microsoft Common Dialog Control 6.0
4. Component Microsoft Windows Common Control 6.0 (SP6)
5. File OCX tambahan lavolpeButton (cari aja di internet)
6. File OCX tambahan ctrlLine (cari aja di internet)

Sedangkan, untuk kode program dapat dilihat sebagai berikut:

Option Explicit

Dim z As String
Dim A, B, C, Min, Min1, Sec, Sec1, totFiles As Integer

Private Sub Check1_Click()
    If mc1.Silent = False Then
        mc1.Silent = True
    ElseIf mc1.Silent = True Then
        mc1.Silent = False
    End If
End Sub

Private Sub Form_Load()
    totFiles = 0
    Label8.Caption = totFiles + List1.ListCount
    
    Slider2.Value = GetVolume
End Sub

Private Sub List1_Click()
    z = List1
    mc1.FileName = List1
End Sub

Private Sub List1_DblClick()
    mc1.Command = "Close"
    lvb3.Caption = "Play"
    If List1.ListCount > 0 Then
        mc1.Command = "Open"
        mc1.Command = "Play"
        lvb3.Caption = "Stop"
        Label2.Caption = List1.Text
    Else
        Exit Sub
    End If
End Sub

Private Sub lvb1_Click()
    totFiles = 0
    mc1.Command = "Close"
    cd1.ShowOpen
    mc1.FileName = cd1.FileName
    mc1.Command = "Open"
    mc1.Command = "Play"
    lvb3.Caption = "Stop"
    Label2.Caption = cd1.FileTitle
    List1.Clear
    List1.AddItem cd1.FileTitle
    Label8.Caption = totFiles + List1.ListCount
End Sub

Private Sub lvb2_Click()
    mc1.Command = "Close"
    On Error Resume Next
    If List1.ListCount = 0 Then
        MsgBox "Sorry, no file selected. Please select one...", vbExclamation, "Select file"
    Else:
        List1.ListIndex = List1.ListIndex - 1
        mc1.FileName = List1
        mc1.Command = "Open"
        mc1.Command = "Play"
        lvb3.Caption = "Stop"
        Label2.Caption = List1.Text
    End If
End Sub

Private Sub lvb3_Click()
    If List1.ListCount = 0 Then
        MsgBox "Sorry, no file found. Please choose at least one file...", vbExclamation, "Select file"
        lvb1.SetFocus
    Else
        If lvb3.Caption = "Play" Then
            mc1.Command = "Open"
            mc1.Command = "Play"
            lvb3.Caption = "Stop"
            Label2.Caption = List1.Text
        ElseIf lvb3.Caption = "Stop" Then
            mc1.Command = "Close"
            lvb3.Caption = "Play"
            Label1.Caption = "00:00"
            Label2.Caption = "No file selected. Choose one and play it..."
            Label3.Caption = "00"
            Label4.Caption = "00"
            Slider1.SelStart = 0
            Slider1.SelLength = 0
        End If
    End If
End Sub

Private Sub lvb4_Click()
    If List1.ListCount = 0 Then
        MsgBox "Sorry, no file selected. Please select at least file one...", vbExclamation, "Select file"
    Else
        If lvb4.Caption = "Pause" Then
            mc1.Command = "Pause"
            lvb4.Caption = "Play"
        Else
            mc1.Command = "Play"
            lvb4.Caption = "Pause"
        End If
    End If
End Sub

Private Sub lvb5_Click()
    mc1.Command = "Close"
    On Error Resume Next
    If List1.ListCount = 0 Then
        MsgBox "Sorry, no file selected. Please select one...", vbExclamation, "Select file"
    Else:
        List1.ListIndex = List1.ListIndex + 1
        mc1.FileName = List1
        mc1.Command = "Open"
        mc1.Command = "Play"
        lvb3.Caption = "Stop"
        Label2.Caption = List1.Text
    End If
End Sub

Private Sub lvb6_Click()
    totFiles = 0
    cd2.FileName = "*.mp3"
    cd2.ShowOpen
    List1.AddItem cd2.FileTitle
    Label8.Caption = totFiles + List1.ListCount
End Sub

Private Sub lvb7_Click()
    If List1.ListIndex = -1 Then
        MsgBox "Sorry, no file selected. Please select at least one...", vbExclamation, "Select File"
    Else
        List1.RemoveItem List1.ListIndex
    End If
End Sub

Private Sub lvb8_Click()
    totFiles = 0
    List1.Clear
    mc1.Command = "Close"
    lvb3.Caption = "Play"
    lvb4.Caption = "Pause"
    Label1.Caption = "00:00"
    Label2.Caption = "No file selected. Choose one and play it..."
    Label3.Caption = "00"
    Label4.Caption = "00"
    Label8.Caption = totFiles + List1.ListCount
    Slider1.SelStart = 0
    Slider1.SelLength = 0
End Sub

Private Sub mc1_StatusUpdate()
    If mc1.FileName = "" Then
        lvb3.Caption = "Play"
    Else
        lvb3.Caption = "Stop"
    End If
    
    Slider1.Max = mc1.Length
    Slider1.Value = mc1.Position
    A = mc1.Length Mod 1000
    B = (mc1.Length - A) / 1000
    Label4.Caption = Format(B Mod 100, "0#")
    Label3.Caption = Format(Round((B - Val(Label4.Caption)) / 60, 0), "0#")
    
    C = mc1.Position Mod 1000
    Sec = ((mc1.Position - C) / 1000) Mod 60
    Label1.Caption = Sec
    
    If Sec = 0 Then
        Min = Min + 1
    End If
    
    Min = Min Mod 60
    Label1.Caption = Format(Min, "0#") & ":" & Format(Sec, "0#")
    
    If Check1.Value = 1 Then
        mc1.Silent = True
    Else
        mc1.Silent = False
    End If
    
    On Error Resume Next
    If mc1.Position = mc1.Length Then
        List1.ListIndex = List1.ListIndex + 1
        mc1.Command = "Close"
        mc1.FileName = List1
        mc1.Command = "Open"
        mc1.Command = "Play"
    End If
End Sub

Private Sub Slider2_Change()
    SetVolume Slider2.Value
End Sub

Private Sub Slider2_Scroll()
    Slider2_Change
End Sub

Sedangkan berikut ini merupakan API untuk mengatur Master Volume artinya nilai volume bisa diatur dari program aplikasi yang telah kita rancang sebelumnya.

Option Explicit

Private hMixerHandle As Long
Private uMixerControls(20) As MIXERCONTROL

Private Const MMSYSERR_NOERROR = 0
Private Const MAXPNAMELEN = 32
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = &H4
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&

Private Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, _
ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
ByVal fdwOpen As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
"mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
"mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
ByVal fdwControls As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Public Enum VOL_CONTROL
SPEAKER = 0
End Enum

Private Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
lMinimum As Long
lMaximum As Long
RESERVED(10) As Long
End Type

Private Type MIXERCONTROLDETAILS
cbStruct As Long
dwControlID As Long
cChannels As Long
item As Long
cbDetails As Long
paDetails As Long
End Type

Private Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long
End Type

Private Type MIXERLINE
cbStruct As Long
dwDestination As Long
dwSource As Long
dwLineID As Long
fdwLine As Long
dwUser As Long
dwComponentType As Long
cChannels As Long
cConnections As Long
cControls As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
dwType As Long
dwDeviceID As Long
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type

Private Type MIXERLINECONTROLS
cbStruct As Long
dwLineID As Long
dwControl As Long
cControls As Long
cbmxctrl As Long
pamxctrl As Long
End Type

Public Function SetVolume(VolumeLevel As Long) As Boolean
Dim hmx As Long
Dim uMixerLine As MIXERLINE
Dim uMixerControl As MIXERCONTROL
Dim uMixerLineControls As MIXERLINECONTROLS
Dim uDetails As MIXERCONTROLDETAILS
Dim uUnsigned As MIXERCONTROLDETAILS_UNSIGNED
Dim RetValue As Long
Dim hMem As Long

' VolumeLevel value must be between 0 and 100
If VolumeLevel < 0 Or VolumeLevel > 100 Then GoTo error

' Open the mixer
RetValue = mixerOpen(hmx, 0, 0, 0, 0)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Initialize MIXERLINE structure and call mixerGetLineInfo
uMixerLine.cbStruct = Len(uMixerLine)
uMixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS
RetValue = mixerGetLineInfo(hmx, uMixerLine, _
MIXER_GETLINEINFOF_COMPONENTTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Initialize MIXERLINECONTROLS strucure and
' call mixerGetLineControls
uMixerLineControls.cbStruct = Len(uMixerLineControls)
uMixerLineControls.dwLineID = uMixerLine.dwLineID
uMixerLineControls.dwControl = MIXERCONTROL_CONTROLTYPE_VOLUME
uMixerLineControls.cControls = 1
uMixerLineControls.cbmxctrl = Len(uMixerControl)

' Allocate a buffer to receive the properties of the master volume control
' and put his address into uMixerLineControls.pamxctrl
hMem = GlobalAlloc(&H40, Len(uMixerControl))
uMixerLineControls.pamxctrl = GlobalLock(hMem)
uMixerControl.cbStruct = Len(uMixerControl)
RetValue = mixerGetLineControls(hmx, uMixerLineControls, _
MIXER_GETLINECONTROLSF_ONEBYTYPE)
If RetValue <> MMSYSERR_NOERROR Then GoTo error

' Copy data buffer into the uMixerControl structure
CopyMemory uMixerControl, ByVal uMixerLineControls.pamxctrl, _
Len(uMixerControl)
GlobalFree hMem
hMem = 0

uDetails.item = 0
uDetails.dwControlID = uMixerControl.dwControlID
uDetails.cbStruct = Len(uDetails)
uDetails.cbDetails = Len(uUnsigned)

' Allocate a buffer in which properties for the volume control are set
' and put his address into uDetails.paDetails
hMem = GlobalAlloc(&H40, Len(uUnsigned))
uDetails.paDetails = GlobalLock(hMem)
uDetails.cChannels = 1
uUnsigned.dwValue = CLng((VolumeLevel * uMixerControl.lMaximum) / 100)
CopyMemory ByVal uDetails.paDetails, uUnsigned, Len(uUnsigned)

' Set new volume level
RetValue = mixerSetControlDetails(hmx, uDetails, _
MIXER_SETCONTROLDETAILSF_VALUE)
GlobalFree hMem
hMem = 0
If RetValue <> MMSYSERR_NOERROR Then GoTo error

mixerClose hmx
' signal success
SetVolume = True
Exit Function

error:
' An error occurred

' Release resources
If hmx <> 0 Then mixerClose hmx
If hMem Then GlobalFree hMem
' signal failure
SetVolume = False
End Function

Public Function GetVolume() As Long
OpenMixer (0)
If GetVolumeP(SPEAKER) >= 0 Or GetVolumeP(SPEAKER) <= 100 Then
GetVolume = GetVolumeP(SPEAKER)
Else
GetVolume = 0
End If
CloseMixer
End Function

Public Function OpenMixer(ByVal MixerNumber As Long) As Long
Dim ret As Long
' is there a mixer available?
If MixerNumber < 0 Or MixerNumber > mixerGetNumDevs = 1 Then Exit Function

' open the mixer
ret = mixerOpen(hMixerHandle, MixerNumber, 0, 0, 0)
If ret <> MMSYSERR_NOERROR Then Exit Function

' get the primary line controls by name, (this does not get all of the controls).

' speaker (master) volume
ret = GetMixerControl(hMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, uMixerControls(SPEAKER))
' return the mixer handle
OpenMixer = True
End Function

Private Function CloseMixer() As Long
CloseMixer = mixerClose(hMixerHandle)
hMixerHandle = 0
End Function

Private Function GetVolumeP(Control As VOL_CONTROL) As Long
GetVolumeP = GetControlValue(hMixerHandle, uMixerControls(Control))
End Function

Private Function GetMixerControl(ByVal hMixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Long
' This function attempts to obtain a mixer control. Returns True if successful.
Dim mxlc As MIXERLINECONTROLS
Dim mxl As MIXERLINE
Dim hMem As Long
Dim ret As Long

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType

' Obtain a line corresponding to the component type
ret = mixerGetLineInfo(hMixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)

If ret = MMSYSERR_NOERROR Then
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = ctrlType
mxlc.cControls = 1
mxlc.cbmxctrl = Len(mxc)

' Allocate a buffer for the control
hMem = GlobalAlloc(&H40, Len(mxc))
mxlc.pamxctrl = GlobalLock(hMem)
mxc.cbStruct = Len(mxc)

' Get the control
ret = mixerGetLineControls(hMixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)

If ret = MMSYSERR_NOERROR Then
GetMixerControl = True

' Copy the control into the destination structure
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
Else
GetMixerControl = False
End If
GlobalFree (hMem)
Exit Function
End If

GetMixerControl = False
End Function

Private Function GetControlValue(ByVal hMixer As Long, mxc As MIXERCONTROL) As Long
'This function gets the value for a control.

Dim mxcd As MIXERCONTROLDETAILS
Dim vol As MIXERCONTROLDETAILS_UNSIGNED
Dim hMem As Long
Dim ret As Long

mxcd.item = 0
mxcd.dwControlID = mxc.dwControlID
mxcd.cbStruct = Len(mxcd)
mxcd.cbDetails = Len(vol)

hMem = GlobalAlloc(&H40, Len(vol))
mxcd.paDetails = GlobalLock(hMem)
mxcd.cChannels = 1

' Get the control value
ret = mixerGetControlDetails(hMixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)

' Copy the data into the control value buffer
CopyStructFromPtr vol, mxcd.paDetails, Len(vol)

If mxc.lMaximum > 100 Then
GetControlValue = ((vol.dwValue * 100) / (mxc.lMaximum - mxc.lMinimum))
Else
GetControlValue = vol.dwValue
End If

GlobalFree (hMem)
End Function

Seperti biasa untuk link download dapat dilihat di link berikut ini:

Download File Program Simple Media Player – VB6

Dengan demikian, selesai sudah pembuatan program media player MP3 sederhana. Semoga dapat bermamfaat bagi Anda.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s