Sunday, March 13, 2011

Contoh membuat pemutaran musik sederhana menggunakan VB 6

Disini saya akan menjelaskan cara membuat pemutaran musik sederhana menggunakan Visual Basic 6, dan saya akan memberikan gambarannya seperti yang di bawah ini :
Untuk Kodingannya :

Dim File As String
Dim Kode As Boolean
Dim EndTrack As Long


Private Sub cmdAbout_Click()
Me.Hide
frmAbout.Show
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
File1.FileName = "*.mp3"
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, "MUSIC Error"
Drive1.Refresh
Case 0
Exit Sub
End Select
End Sub

Private Sub File1_Click()
MMControl1.Command = "Close"
MMControl1.Refresh
lblFile.Caption = File1.FileName
Play
End Sub

Private Sub File1_DblClick()
Play
MMControl1.Command = "Play"
End Sub

Sub Play()
File = File1.Path & "\" & File1.FileName
If Mid(File, 3, 1) = "\" And Mid(File, 4, 1) = "\" Then
Path = Left(File1.Path, 3)
File = Path & File1.FileName
Else
File = File1.Path & "\" & File1.FileName
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, "MUSIC Error"
Else
End If
End Sub

Private Sub MMControl1_Done(NotifyCode As Integer)
If Kode = True Then Exit Sub
If MMControl1.TrackLength = MMControl1.Position Then
If File1.ListCount = File1.ListIndex Then
MMControl1.Command = "Close"
Else
With File1
.ListIndex = .ListIndex + 1
End With
MMControl1.Command = "Play"
End If
End If
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub MMControl1_PlayClick(Cancel As Integer)
Play
End Sub

Private Sub MMControl1_StopClick(Cancel As Integer)
MMControl1.Refresh
MMControl1.Command = "Close"
Kode = True
End Sub

Private Sub mnexit_Click()
End
End Sub

Private Sub smabout_Click()
Me.Hide
frmAbout.Show
End Sub

Dan Untuk Lebih Jelasnya,download lengkap dibawah ini :


Kritik dan Saran kirim aja dikomentar saya..
Thanks n Good Luck..

No comments:

Post a Comment

kritik dan saran kirim aja disini..