Welcome Guest [Log In] [Register]
Welcome to VITINHTHANHSON. We hope you enjoy your visit.


You're currently viewing our forum as a guest. This means you are limited to certain areas of the board and there are some features you can't use. If you join our community, you'll be able to access member-only sections, and use many member-only features such as customizing your profile, sending personal messages, and voting in polls. Registration is simple, fast, and completely free.


Join our community!


If you're already a member please log in to your account to access all of our features:

Username:   Password:
Add Reply
Tạo chương trình nghe nhạc bằng VB 6.0
Topic Started: Jul 10 2006, 11:17 PM (964 Views)
Dinhvanquanglk
Member Avatar
Tổng thư ký
Administration
Thêm vào Project một Modul với tên là Modul1
Option Explicit 'Kiểu bản ghi của file danh sách, chỉ gồm 2 trường
Type Media
Path As String * 250
Name As String * 100
'Tên file bài hát không dài quá 250 ký tự
'Đường dẫn không dài quá 100 ký tự
End Type
'=============
' Viết cho đối tượng
Dim Song As Media
Dim DATAfile As String
Dim RecEnd
Dim i, Filenum, Sogia As Integer
Dim p

'Hàm kiểm tra sự tồn tại của 1 file
Function FileExists(FileName) As Boolean
Dim Msg As String
On Error GoTo CheckError
FileExists = (Dir(FileName) <> "")
Exit Function
CheckError:
Const mnErrDiskNotReady = 71, mnErrDeviceUnavailable = 68
If (Err.Number = mnErrDiskNotReady) Then
Msg = "Put a floppy disk in the drive."
If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
Resume
Else
Resume Next
End If
ElseIf Err.Number = mnErrDeviceUnavailable Then
Msg = "This drive or path does not exist: " & FileName
MsgBox Msg, vbExclamation
Resume Next
Else
Msg = "Unexpected error #" & Str(Err.Number) & " occurred: " _
& Err.Description
MsgBox Msg, vbCritical
Stop
End If
Resume
End Function

Private Sub cmdCapNhat_Click()
Capnhat
End Sub

Private Sub Command1_Click()
PopupMenu mnuSetting
End Sub

Private Sub Capnhat()
Filenum = FreeFile
Open DATAfile For Random As #Filenum Len = Len(Song)
RecEnd = FileLen(DATAfile) / Len(Song)
For i = 1 To RecEnd
Get #Filenum, i, Song
List1.AddItem (Trim(Song.Name))
List2.AddItem (Trim(Song.Path))
Next i
Close #Filenum
End Sub

Private Sub Form_Load()
Volume1.Value = 10 'Giá trị mặc định của Volume khi khởi động

'Mở file danh sách
If Len(App.Path) > 3 Then
DATAfile = App.Path & "\TMedia.lst"
Else
DATAfile = App.Path & "TMedia.lst"
End If
mnuRepeat.Checked = True
mnuMini.Checked = False
On Error Resume Next
mnuMini.Checked = GetSetting("FastRun 1.0", "Media", "Check Mini")
mnuRepeat.Checked = GetSetting("FastRun 1.0", "Media", "Check Repeat")
frmMedia.Top = GetSetting("FastRun 1.0", "Media", "Media Top")
frmMedia.Left = GetSetting("FastRun 1.0", "Media", "Media Left")
List1.BackColor = GetSetting("FastRun 1.0", "Media", "Back Color")
List1.ForeColor = GetSetting("FastRun 1.0", "Media", "Text Color")
mnuDam.Checked = GetSetting("FastRun 1.0", "Media", "Font Bold")
Hengio = GetSetting("FastRun 1.0", "Media", "Time Song")
Volume1.Value = GetSetting("FastRun 1.0", "Media", "Volume")
CheckDefaultList = GetSetting("FastRun 1.0", "Media", "DefaultList")
Capnhat
Mini
Dam
Volume1_Scroll
End Sub

Private Sub SaveReg()

'Ghi cấu hình vào Registry
On Error Resume Next
SaveSetting "FastRun 1.0", "Media", "Check Mini", mnuMini.Checked
SaveSetting "FastRun 1.0", "Media", "Check Repeat", mnuRepeat.Checked
SaveSetting "FastRun 1.0", "Media", "Media Top", frmMedia.Top
SaveSetting "FastRun 1.0", "Media", "Media Left", frmMedia.Left
SaveSetting "FastRun 1.0", "Media", "Volume", Volume1.Value
SaveSetting "FastRun 1.0", "Media", "Font Bold", mnuDam.Checked
SaveSetting "FastRun 1.0", "Media", "Back Color", List1.BackColor
SaveSetting "FastRun 1.0", "Media", "Text Color", List1.ForeColor
DeleteSetting "FastRun 1.0", "Media", "Time Song"
End Sub

Private Sub KetThuc()
SaveReg
Unload frmMedia
Unload frmAuthor
Unload frmOpen
End Sub

Private Sub Form_Unload(Cancel As Integer)
KetThuc
End Sub

Private Sub List1_DblClick()
If FileExists(List2.List(List1.ListIndex)) = True Then
MediaPlayer1.FileName = List2.List(List1.ListIndex)
ThanhCong = True
Else
If List1.ListIndex = List1.ListCount - 1 And ThanhCong = False Then
MsgBox "TÊt c¶ c¸c bµi trong danh s¸ch ®Òu sai ®­êng dÉn hoÆc tªn file." + vbCrLf + "B¹n cÇn n¹p l¹i danh s¸ch !", vbCritical, "Media - Warning"
Else
HetBai
End If
End If
End Sub


Private Sub HetBai()
If mnuRepeat.Checked = True And List1.ListCount > 0 Then
If List1.ListIndex + 1 < List1.ListCount Then
List1.ListIndex = List1.ListIndex + 1
Else
List1.ListIndex = 0
ThanhCong = False
End If
On Error Resume Next
List1_DblClick
End If
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
If Keyascii = 13 Then
List1_DblClick
End If
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If List1.ListIndex >= 0 Then
List1.ToolTipText = Left(List1.List(List1.ListIndex), Len(List1.List(List1.ListIndex)) - 3)
End If
End Sub

Private Sub MediaPlayer1_EndOfStream(ByVal Result As Long)
'Hành động khi hết một bài

HetBai
End Sub

Private Sub mnuAdd_Click()
frmOpen.Show vbModal
End Sub

Private Sub mnuAuthor_Click()
frmAuthor.Show
End Sub

Private Sub mnuDelete_Click()
frmListEdit.Show
End Sub

Private Sub mnuChu_Click()
CommonDialog1.Color = List1.ForeColor
CommonDialog1.Action = 3
List1.ForeColor = CommonDialog1.Color
End Sub

Private Sub mnuDam_Click()
If mnuDam.Checked = False Then
List1.FontBold = False
mnuDam.Checked = True
Else
List1.FontBold = True
mnuDam.Checked = False
End If
Dam
End Sub

Private Sub Dam()
If mnuDam.Checked = False Then
List1.FontBold = False
Else
List1.FontBold = True
End If
End Sub

Private Sub mnuExit_Click()
KetThuc
End Sub

Private Sub mnuMini_Click()
If mnuMini.Checked = True Then
mnuMini.Checked = False
Else
mnuMini.Checked = True
End If
Mini
End Sub

Private Sub Mini()
If mnuMini.Checked = True Then
List1.Height = 255
frmMedia.Height = 1740
List1.ListIndex = List1.ListIndex
Else
List1.Height = 2400
frmMedia.Height = 3885
End If
End Sub

Private Sub mnuNumber_Click()
If mnuNumber.Checked = True Then
mnuNumber.Checked = False
Else
mnuNumber.Checked = True
End If
End Sub

Private Sub mnuNen_Click()
CommonDialog1.Color = List1.BackColor
CommonDialog1.Action = 3
List1.BackColor = CommonDialog1.Color
End Sub

Private Sub mnuRepeat_Click()
If mnuRepeat.Checked = True Then
mnuRepeat.Checked = False
Else
mnuRepeat.Checked = True
End If
End Sub

Private Sub Text1_Click()
Text1.Text = Str(MediaPlayer1.Volume)
End Sub

Private Sub Volume1_Scroll()
Select Case Volume1.Value
Case 13: Sogia = 0
Case 12: Sogia = -40
Case 11: Sogia = -90
Case 10: Sogia = -180
Case 9: Sogia = -280
Case 8: Sogia = -410
Case 7: Sogia = -500
Case 6: Sogia = -650
Case 5: Sogia = -860
Case 4: Sogia = -1100
Case 3: Sogia = -1350
Case 2: Sogia = -1900
Case 1: Sogia = -2600
Case 0: Sogia = -9640
End Select
MediaPlayer1.Volume = Sogia
End Sub

3. Tạo một form mới đặt tên là frmOpen

-Nội dung:

Option Explicit
Dim SongOpen As Media
Dim i, CurrentSong, Filenum As Integer
Dim PathSong As String
Dim DATAfile As String
Dim RecEnd

Function FileExists(FileName) As Boolean
Dim Msg As String
On Error GoTo CheckError
FileExists = (Dir(FileName) <> "")
Exit Function
CheckError:
Const mnErrDiskNotReady = 71, mnErrDeviceUnavailable = 68
If (Err.Number = mnErrDiskNotReady) Then
Msg = "Put a floppy disk in the drive."
If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
Resume
Else
Resume Next
End If
Else If Err.Number = mnErrDeviceUnavailable Then
Msg = "This drive or path does not exist: " & FileName
MsgBox Msg, vbExclamation
Resume Next
Else
Msg = "Unexpected error #" & Str(Err.Number) & " occurred: " _
& Err.Description
MsgBox Msg, vbCritical
Stop
End If
Resume
End Function

Private Sub cmdAddAll_Click()
If Len(Dir1.Path) = 3 Then
PathSong = Dir1.Path
Else
PathSong = Dir1.Path + "\"
End If
For i = 0 To File1.ListCount - 1
List1.AddItem (File1.List(i))
List2.AddItem (PathSong + File1.List(i))
Next i
If cmdClear.Enabled = False Then
cmdClear.Enabled = True
End If
KTnutClear
End Sub

Private Sub cmdCancel_Click()
Unload frmOpen
End Sub

Private Sub cmdClear_Click()
KTnutClear
If cmdClear.Enabled = True Then
If List1.ListIndex < 0 And List1.ListCount > 0 Then
List1.ListIndex = 0
End If
CurrentSong = List1.ListIndex
List1.RemoveItem (CurrentSong)
List2.RemoveItem (CurrentSong)
If List1.ListCount < 0 Then
List1.ListIndex = List1.ListCount - 1
End If
If List1.ListCount = 0 Then
cmdClear.Enabled = False
End If
End If
End Sub

Private Sub cmdClearAll_Click()
KTnutClear
If cmdClearAll.Enabled = True Then
List1.Clear
List2.Clear
End If
End Sub

Private Sub cmdOK_Click()
'save in file
If Len(App.Path) > 3 Then
DATAfile = App.Path + "\TMedia.lst"
Else
DATAfile = App.Path + "TMedia.lst"
End If
If FileExists(DATAfile) = True Then
Kill DATAfile
End If
frmMedia.List1.Clear
frmMedia.List2.Clear
If List1.ListCount > 0 Then
Filenum = FreeFile
Open DATAfile For Random As #Filenum Len = Len(SongOpen)
If List1.ListCount > 0 Then
For i = 0 To List1.ListCount - 1
SongOpen.Name = List1.List(i)
SongOpen.Path = List2.List(i)
Put #Filenum, i + 1, SongOpen
Next i
End If
Close #Filenum
frmMedia.cmdCapNhat.Value = True
End If
Unload frmOpen
frmMedia.SetFocus
End Sub


Private Sub Combo1_Click()
File1.Pattern = Combo1.Text
If Combo1.ListIndex = 1 Then
cmdAddAll.Enabled = False
MsgBox "NÕu b¹n chän kiÓu file lµ '' *.* '', b¹n sÏ kh«ng thªm ®­îc file vµo danh s¸ch", vbCritical, "Warning"
Else
cmdAddAll.Enabled = True
End If
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
KTnutAddAll
End Sub

Private Sub Dir1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dir1.Path = Dir1.List(Dir1.ListIndex)
'File1_DblClick
End If
End Sub

Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
If Err Then
MsgBox "Kh«ng t×m thÊy ®Üa", vbCritical, "Media - Warning"
Drive1.Drive = Dir1.Path
End If
End Sub

Private Sub File1_DblClick()
If File1.Pattern <> "*.*" Then
If Len(Dir1.Path) = 3 Then
PathSong = Dir1.Path + File1.FileName
Else
PathSong = Dir1.Path + "\" + File1.FileName
End If
List1.AddItem (File1.FileName)
List2.AddItem (PathSong)
If cmdClear.Enabled = False Then
cmdClear.Enabled = True
End If
KTnutClear
Else
MsgBox "B¹n cÇn ®Æt kiÓu file trong hép Pattern lµ ''*.mp3;*.wav;*.mid''", vbCritical, "Media - Warning"
End If
End Sub

Private Sub File1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
File1_DblClick
End If
End Sub

Private Sub Form_Load()
For i = 0 To frmMedia.List1.ListCount - 1
List1.AddItem (frmMedia.List1.List(i))
List2.AddItem (frmMedia.List2.List(i))
Next i
KTnutAddAll
KTnutClear
Combo1.ListIndex = 0
File1.Pattern = Combo1.Text
File1.Hidden = True
File1.ReadOnly = True
File1.System = True
End Sub

Private Sub KTnutAddAll()
If File1.ListCount > 0 And File1.Pattern <> "*.*" Then
cmdAddAll.Enabled = True
Else
cmdAddAll.Enabled = False
End If
End Sub

Private Sub KTnutClear()
If List1.ListCount > 0 Then
cmdClear.Enabled = True
cmdClearAll.Enabled = True
Else
cmdClear.Enabled = False
cmdClearAll.Enabled = False
End If
End Sub

Posted Image

[size=5]Nhà 0 số-Mố Cầu Long Biên-Long Biên-Hà Nội[/size]
Offline Profile Quote Post Goto Top
 
Dinhvanquanglk
Member Avatar
Tổng thư ký
Administration
Quote:
 
Thêm vào Project một Modul với tên là Modul1
Option Explicit 'Kiểu bản ghi của file danh sách, chỉ gồm 2 trường
Type Media
Path As String * 250
Name As String * 100
'Tên file bài hát không dài quá 250 ký tự
'Đường dẫn không dài quá 100 ký tự
End Type
'=============
' Viết cho đối tượng
Dim Song As Media
Dim DATAfile As String
Dim RecEnd
Dim i, Filenum, Sogia As Integer
Dim p

'Hàm kiểm tra sự tồn tại của 1 file
Function FileExists(FileName) As Boolean
Dim Msg As String
On Error GoTo CheckError
FileExists = (Dir(FileName) <> "")
Exit Function
CheckError:
Const mnErrDiskNotReady = 71, mnErrDeviceUnavailable = 68
If (Err.Number = mnErrDiskNotReady) Then
Msg = "Put a floppy disk in the drive."
If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
Resume
Else
Resume Next
End If
ElseIf Err.Number = mnErrDeviceUnavailable Then
Msg = "This drive or path does not exist: " & FileName
MsgBox Msg, vbExclamation
Resume Next
Else
Msg = "Unexpected error #" & Str(Err.Number) & " occurred: " _
& Err.Description
MsgBox Msg, vbCritical
Stop
End If
Resume
End Function

Private Sub cmdCapNhat_Click()
Capnhat
End Sub

Private Sub Command1_Click()
PopupMenu mnuSetting
End Sub

Private Sub Capnhat()
Filenum = FreeFile
Open DATAfile For Random As #Filenum Len = Len(Song)
RecEnd = FileLen(DATAfile) / Len(Song)
For i = 1 To RecEnd
Get #Filenum, i, Song
List1.AddItem (Trim(Song.Name))
List2.AddItem (Trim(Song.Path))
Next i
Close #Filenum
End Sub

Private Sub Form_Load()
Volume1.Value = 10 'Giá trị mặc định của Volume khi khởi động

'Mở file danh sách
If Len(App.Path) > 3 Then
DATAfile = App.Path & "\TMedia.lst"
Else
DATAfile = App.Path & "TMedia.lst"
End If
mnuRepeat.Checked = True
mnuMini.Checked = False
On Error Resume Next
mnuMini.Checked = GetSetting("FastRun 1.0", "Media", "Check Mini")
mnuRepeat.Checked = GetSetting("FastRun 1.0", "Media", "Check Repeat")
frmMedia.Top = GetSetting("FastRun 1.0", "Media", "Media Top")
frmMedia.Left = GetSetting("FastRun 1.0", "Media", "Media Left")
List1.BackColor = GetSetting("FastRun 1.0", "Media", "Back Color")
List1.ForeColor = GetSetting("FastRun 1.0", "Media", "Text Color")
mnuDam.Checked = GetSetting("FastRun 1.0", "Media", "Font Bold")
Hengio = GetSetting("FastRun 1.0", "Media", "Time Song")
Volume1.Value = GetSetting("FastRun 1.0", "Media", "Volume")
CheckDefaultList = GetSetting("FastRun 1.0", "Media", "DefaultList")
Capnhat
Mini
Dam
Volume1_Scroll
End Sub

Private Sub SaveReg()

'Ghi cấu hình vào Registry
On Error Resume Next
SaveSetting "FastRun 1.0", "Media", "Check Mini", mnuMini.Checked
SaveSetting "FastRun 1.0", "Media", "Check Repeat", mnuRepeat.Checked
SaveSetting "FastRun 1.0", "Media", "Media Top", frmMedia.Top
SaveSetting "FastRun 1.0", "Media", "Media Left", frmMedia.Left
SaveSetting "FastRun 1.0", "Media", "Volume", Volume1.Value
SaveSetting "FastRun 1.0", "Media", "Font Bold", mnuDam.Checked
SaveSetting "FastRun 1.0", "Media", "Back Color", List1.BackColor
SaveSetting "FastRun 1.0", "Media", "Text Color", List1.ForeColor
DeleteSetting "FastRun 1.0", "Media", "Time Song"
End Sub

Private Sub KetThuc()
SaveReg
Unload frmMedia
Unload frmAuthor
Unload frmOpen
End Sub

Private Sub Form_Unload(Cancel As Integer)
KetThuc
End Sub

Private Sub List1_DblClick()
If FileExists(List2.List(List1.ListIndex)) = True Then
MediaPlayer1.FileName = List2.List(List1.ListIndex)
ThanhCong = True
Else
If List1.ListIndex = List1.ListCount - 1 And ThanhCong = False Then
MsgBox "TÊt c¶ c¸c bµi trong danh s¸ch ®Òu sai ®­êng dÉn hoÆc tªn file." + vbCrLf + "B¹n cÇn n¹p l¹i danh s¸ch !", vbCritical, "Media - Warning"
Else
HetBai
End If
End If
End Sub


Private Sub HetBai()
If mnuRepeat.Checked = True And List1.ListCount > 0 Then
If List1.ListIndex + 1 < List1.ListCount Then
List1.ListIndex = List1.ListIndex + 1
Else
List1.ListIndex = 0
ThanhCong = False
End If
On Error Resume Next
List1_DblClick
End If
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
If Keyascii = 13 Then
List1_DblClick
End If
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If List1.ListIndex >= 0 Then
List1.ToolTipText = Left(List1.List(List1.ListIndex), Len(List1.List(List1.ListIndex)) - 3)
End If
End Sub

Private Sub MediaPlayer1_EndOfStream(ByVal Result As Long)
'Hành động khi hết một bài

HetBai
End Sub

Private Sub mnuAdd_Click()
frmOpen.Show vbModal
End Sub

Private Sub mnuAuthor_Click()
frmAuthor.Show
End Sub

Private Sub mnuDelete_Click()
frmListEdit.Show
End Sub

Private Sub mnuChu_Click()
CommonDialog1.Color = List1.ForeColor
CommonDialog1.Action = 3
List1.ForeColor = CommonDialog1.Color
End Sub

Private Sub mnuDam_Click()
If mnuDam.Checked = False Then
List1.FontBold = False
mnuDam.Checked = True
Else
List1.FontBold = True
mnuDam.Checked = False
End If
Dam
End Sub

Private Sub Dam()
If mnuDam.Checked = False Then
List1.FontBold = False
Else
List1.FontBold = True
End If
End Sub

Private Sub mnuExit_Click()
KetThuc
End Sub

Private Sub mnuMini_Click()
If mnuMini.Checked = True Then
mnuMini.Checked = False
Else
mnuMini.Checked = True
End If
Mini
End Sub

Private Sub Mini()
If mnuMini.Checked = True Then
List1.Height = 255
frmMedia.Height = 1740
List1.ListIndex = List1.ListIndex
Else
List1.Height = 2400
frmMedia.Height = 3885
End If
End Sub

Private Sub mnuNumber_Click()
If mnuNumber.Checked = True Then
mnuNumber.Checked = False
Else
mnuNumber.Checked = True
End If
End Sub

Private Sub mnuNen_Click()
CommonDialog1.Color = List1.BackColor
CommonDialog1.Action = 3
List1.BackColor = CommonDialog1.Color
End Sub

Private Sub mnuRepeat_Click()
If mnuRepeat.Checked = True Then
mnuRepeat.Checked = False
Else
mnuRepeat.Checked = True
End If
End Sub

Private Sub Text1_Click()
Text1.Text = Str(MediaPlayer1.Volume)
End Sub

Private Sub Volume1_Scroll()
Select Case Volume1.Value
Case 13: Sogia = 0
Case 12: Sogia = -40
Case 11: Sogia = -90
Case 10: Sogia = -180
Case 9: Sogia = -280
Case 8: Sogia = -410
Case 7: Sogia = -500
Case 6: Sogia = -650
Case 5: Sogia = -860
Case 4: Sogia = -1100
Case 3: Sogia = -1350
Case 2: Sogia = -1900
Case 1: Sogia = -2600
Case 0: Sogia = -9640
End Select
MediaPlayer1.Volume = Sogia
End Sub

  3. Tạo một form mới đặt tên là frmOpen

-Nội dung:

Option Explicit
Dim SongOpen As Media
Dim i, CurrentSong, Filenum As Integer
Dim PathSong As String
Dim DATAfile As String
Dim RecEnd

Function FileExists(FileName) As Boolean
Dim Msg As String
On Error GoTo CheckError
FileExists = (Dir(FileName) <> "")
Exit Function
CheckError:
Const mnErrDiskNotReady = 71, mnErrDeviceUnavailable = 68
If (Err.Number = mnErrDiskNotReady) Then
Msg = "Put a floppy disk in the drive."
If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
Resume
Else
Resume Next
End If
Else If Err.Number = mnErrDeviceUnavailable Then
Msg = "This drive or path does not exist: " & FileName
MsgBox Msg, vbExclamation
Resume Next
Else
Msg = "Unexpected error #" & Str(Err.Number) & " occurred: " _
& Err.Description
MsgBox Msg, vbCritical
Stop
End If
Resume
End Function

Private Sub cmdAddAll_Click()
If Len(Dir1.Path) = 3 Then
PathSong = Dir1.Path
Else
PathSong = Dir1.Path + "\"
End If
For i = 0 To File1.ListCount - 1
List1.AddItem (File1.List(i))
List2.AddItem (PathSong + File1.List(i))
Next i
If cmdClear.Enabled = False Then
cmdClear.Enabled = True
End If
KTnutClear
End Sub

Private Sub cmdCancel_Click()
Unload frmOpen
End Sub

Private Sub cmdClear_Click()
KTnutClear
If cmdClear.Enabled = True Then
If List1.ListIndex < 0 And List1.ListCount > 0 Then
List1.ListIndex = 0
End If
CurrentSong = List1.ListIndex
List1.RemoveItem (CurrentSong)
List2.RemoveItem (CurrentSong)
If List1.ListCount < 0 Then
List1.ListIndex = List1.ListCount - 1
End If
If List1.ListCount = 0 Then
cmdClear.Enabled = False
End If
End If
End Sub

Private Sub cmdClearAll_Click()
KTnutClear
If cmdClearAll.Enabled = True Then
List1.Clear
List2.Clear
End If
End Sub

Private Sub cmdOK_Click()
'save in file
If Len(App.Path) > 3 Then
DATAfile = App.Path + "\TMedia.lst"
Else
DATAfile = App.Path + "TMedia.lst"
End If
If FileExists(DATAfile) = True Then
Kill DATAfile
End If
frmMedia.List1.Clear
frmMedia.List2.Clear
If List1.ListCount > 0 Then
Filenum = FreeFile
Open DATAfile For Random As #Filenum Len = Len(SongOpen)
If List1.ListCount > 0 Then
For i = 0 To List1.ListCount - 1
SongOpen.Name = List1.List(i)
SongOpen.Path = List2.List(i)
Put #Filenum, i + 1, SongOpen
Next i
End If
Close #Filenum
frmMedia.cmdCapNhat.Value = True
End If
Unload frmOpen
frmMedia.SetFocus
End Sub


Private Sub Combo1_Click()
File1.Pattern = Combo1.Text
If Combo1.ListIndex = 1 Then
cmdAddAll.Enabled = False
MsgBox "NÕu b¹n chän kiÓu file lµ '' *.* '', b¹n sÏ kh«ng thªm ®­îc file vµo danh s¸ch", vbCritical, "Warning"
Else
cmdAddAll.Enabled = True
End If
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
KTnutAddAll
End Sub

Private Sub Dir1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dir1.Path = Dir1.List(Dir1.ListIndex)
'File1_DblClick
End If
End Sub

Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
If Err Then
MsgBox "Kh«ng t×m thÊy ®Üa", vbCritical, "Media - Warning"
Drive1.Drive = Dir1.Path
End If
End Sub

Private Sub File1_DblClick()
If File1.Pattern <> "*.*" Then
If Len(Dir1.Path) = 3 Then
PathSong = Dir1.Path + File1.FileName
Else
PathSong = Dir1.Path + "\" + File1.FileName
End If
List1.AddItem (File1.FileName)
List2.AddItem (PathSong)
If cmdClear.Enabled = False Then
cmdClear.Enabled = True
End If
KTnutClear
Else
MsgBox "B¹n cÇn ®Æt kiÓu file trong hép Pattern lµ ''*.mp3;*.wav;*.mid''", vbCritical, "Media - Warning"
End If
End Sub

Private Sub File1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
File1_DblClick
End If
End Sub

Private Sub Form_Load()
For i = 0 To frmMedia.List1.ListCount - 1
List1.AddItem (frmMedia.List1.List(i))
List2.AddItem (frmMedia.List2.List(i))
Next i
KTnutAddAll
KTnutClear
Combo1.ListIndex = 0
File1.Pattern = Combo1.Text
File1.Hidden = True
File1.ReadOnly = True
File1.System = True
End Sub

Private Sub KTnutAddAll()
If File1.ListCount > 0 And File1.Pattern <> "*.*" Then
cmdAddAll.Enabled = True
Else
cmdAddAll.Enabled = False
End If
End Sub

Private Sub KTnutClear()
If List1.ListCount > 0 Then
cmdClear.Enabled = True
cmdClearAll.Enabled = True
Else
cmdClear.Enabled = False
cmdClearAll.Enabled = False
End If
End Sub
Posted Image

[size=5]Nhà 0 số-Mố Cầu Long Biên-Long Biên-Hà Nội[/size]
Offline Profile Quote Post Goto Top
 
1 user reading this topic (1 Guest and 0 Anonymous)
ZetaBoards - Free Forum Hosting
Join the millions that use us for their forum communities. Create your own forum today.
Learn More · Sign-up Now
« Previous Topic · Visual Basic · Next Topic »
Add Reply