VB6 : Membuat Media Player Sendiri

Pasti semua orang yang mengenal komputer sudah memakai aplikasi Windows Media Player untuk memutar file video atau winamp untuk memutar file mp3. Apakah kita hanya sebagai pemakai saja ? Tidakah kita mempunyai keinginan untuk membuatnya sendiri ? Nah sekarang marilah kita mencoba membuat sebuah aplikasi yang bisa memutar hampir semua file video (kecuali file 3gp dan file mov), menampilkan file image dan memutar file suara. Wah pasti susah, tidak ada yang susah kok tergantung dari kemauan kita.

Langkah pertama

Atur properties form sebagai berikut

Height

:

6315

Width

:

9135

BorderStyle

:

Fixed

ScaleMode

:

Pixel

Kemudian tempelkan pada form tersebut

Nama Kontrol

Jumlah

DriveListBox

1

DirListBox

1

FileListBox

1

Timer

1

Shape

1

HscrollBar

1

CommandButton

4

Atur Properties masing-masing Kontrol sebagai berikut

DriveListBox

Name

:

Drive1

Left

:

12

Top

:

12

Height

:

21

Width

:

137

DirListBox

Name

:

Dir1

Left

:

12

Top

:

36

Height

:

126

Width

:

137

FileListBox

Name

:

File1

Left

:

12

Top

:

164

Height

:

188

Width

:

137

Timer

Name

:

Timer1

Enabled

:

False

Interval

:

1000

Shape

Name

:

Shape1

Left

:

152

Top

:

8

Height

:

321

Width

:

437

FillStyle

:

Solid

FillColor

:

Black (&H00000000&)

HscrollBar

Name

:

Hscroll1

Left

:

152

Top

:

328

Height

:

17

Width

:

437

CommandButton

Name

:

Command1

Left

:

156

Top

:

352

Height

:

29

Width

:

93

Caption

:

Play

Name

:

Command2

Left

:

248

Top

:

352

Height

:

29

Width

:

93

Caption

:

Pause

Name

:

Command3

Left

:

340

Top

:

352

Height

:

29

Width

:

93

Caption

:

Stop

Name

:

Command4

Left

:

432

Top

:

352

Height

:

29

Width

:

93

Caption

:

Exit

Sehingga tampilan kontrol pada form sebagai berikut

Sekarang kita tulis kodenya

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Dim wHandler As Long

Dim fShortName As String, TrackLength As String * 60

Dim a As Integer, cou As Integer

Dim tt As Boolean

Public Function GetShortName(ByVal sLongFileName As String) As String

Dim lRetVal As Long

Dim sShortPathName As String

Dim iLen As Integer

sShortPathName = Space(255)

iLen = Len(sShortPathName)

lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)

GetShortName = Left(sShortPathName, lRetVal)

End Function

Private Sub Command1_Click()

On Error Resume Next

fShortName = GetShortName(File1.Path &  "SLASH" & File1.FileName)

mciSendString "close all", vbNullString, 0, 0

mciSendString "open " & fShortName & " type MPEGVideo style child alias mpeg parent " & Me.hwnd, vbNullString, 0, 0

mciSendString "status mpeg length", TrackLength, Len(TrackLength), 0

mciSendString "put mpeg window at 152 8 437 321", 0&, 0, 0

mciSendString "set window show maximized", vbNullString, 0, 0

mciSendString "play mpeg", vbNullString, 0, 0

HScroll1.Max = CLng(TrackLength)

Timer1.Enabled = True

End Sub

Private Sub Command2_Click()

If Command2.Caption = "Pause" Then

mciSendString "pause mpeg", vbNullString, 0, 0

Command2.Caption = "Resume"

Timer1.Enabled = False

Else

mciSendString "resume mpeg", vbNullString, 0, 0

Command2.Caption = "Pause"

Timer1.Enabled = True

End If

End Sub

Private Sub Command3_Click()

mciSendString "stop mpeg", vbNullString, 0, 0

mciSendString "close all", vbNullString, 0, 0

Timer1.Enabled = False

End Sub

Private Sub Command4_Click()

End

End Sub

Private Sub Dir1_Change()

File1.Path = Dir1.Path

cou = File1.ListCount

End Sub

Private Sub Drive1_Change()

Dir1.Path = Drive1.Drive

End Sub

Private Sub File1_Click()

a = File1.ListIndex

Command1_Click

If tt = True Then Command3_Click

End Sub

Private Sub Form_Load()

Me.Left = 1

Me.Top = 5

Drive1.Drive = "C:"

a = 0

tt = False

End Sub

Private Sub HScroll1_Change()

mciSendString "stop mpeg", vbNullString, 0, 0

mciSendString "play mpeg from " & CStr(HScroll1.Value), vbNullString, 0, 0

End Sub

Private Sub Timer1_Timer()

On Error Resume Next

Dim CurPos As String * 40

mciSendString "status mpeg position", CurPos, Len(CurPos), 0

HScroll1.Value = CLng(CurPos)

If HScroll1.Value >= HScroll1.Max Then

Timer1.Enabled = False

a = a + 1

If a < cou Then

HScroll1.Value = 0

File1.ListIndex = a

Else

a = 0

HScroll1.Value = 0

File1.ListIndex = a

End If

End If

End Sub

Selamat mencoba

CATATAN :

Berhubung pada tulisan ini tdiak bisa menampilkan tanda Slah, maka bila pada coding ada tulisan

SLASH  ganti dengan tanda

[caption id="attachment_26072" align="alignnone" width="300" caption="Form Properties"][/caption]