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]