addfile.frm

两个VB播放器 两个VB播放器 两个VB播放器 两个VB播放器

VERSION 5.00
Begin VB.Form Dialog6 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "添加文件"
   ClientHeight    =   4200
   ClientLeft      =   4695
   ClientTop       =   4200
   ClientWidth     =   6840
   Icon            =   "AddFile.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4200
   ScaleWidth      =   6840
   ShowInTaskbar   =   0   'False
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   0
      TabIndex        =   5
      Text            =   "Combo1"
      Top             =   3840
      Width           =   2535
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&E)"
      Height          =   375
      Left            =   5640
      TabIndex        =   4
      Top             =   840
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&Q)"
      Height          =   375
      Left            =   5640
      TabIndex        =   3
      Top             =   240
      Width           =   1095
   End
   Begin VB.DirListBox Dir1 
      Height          =   3660
      Left            =   2640
      TabIndex        =   2
      Top             =   120
      Width           =   2775
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   2640
      TabIndex        =   1
      Top             =   3840
      Width           =   2775
   End
   Begin VB.FileListBox File1 
      Height          =   3690
      Left            =   0
      MultiSelect     =   2  'Extended
      TabIndex        =   0
      Top             =   120
      Width           =   2535
   End
End
Attribute VB_Name = "Dialog6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
  On Error Resume Next
  Dim index As Integer
If Dialog5.Text1.Text <> "" Then                     '//用途1     ‘//必须输入文件名
  Form6.List1.Clear
   Open App.Path & "\temp" & "\" & Dialog5.Text1.Text & ".txt" For Output As #1       '有何用处，缺少为何无法写入
      Print #1, ""
   Close #1
   Open App.Path & "\temp" & "\" & Dialog5.Text1.Text & ".txt" For Output As #1     '将打开的路径保存
       For index = 0 To File1.ListCount - 1
           If File1.Selected(index) Then             '//如果被选中则添加到曲目列表
             Form6.List1.AddItem Dir1.Path & "\" & File1.list(index)
             Print #1, Dir1.Path & "\" & File1.list(index)
           End If
        Next index
   Close #1
   x = Drive1.Drive
   y = Dir1.Path
   Open App.Path & "\temp\dir" For Output As #1       '有何用处，缺少为何无法写入
      Print #1, ""
   Close #1
   Open App.Path & "\temp\dir" For Output As #1    '将打开的路径保存
      Print #1, x
      Print #1, y
   Close #1
   Form6.List3.Clear
   For i = 0 To Form6.List1.ListCount - 1
     Form6.MCI.Command = "stop"
     Form6.MCI.Command = "close"
     'MCI.DeviceType = "MPEGVideo"
     Form6.MCI.FileName = Form6.List1.list(i)
     Form6.MCI.Silent = True
     Form6.MCI.Command = "Open"
     Form6.MCI.Command = "play"
     Form6.MCI.Silent = True
     leng_1 = Form6.MCI.TrackLength / 100000
     gettime = Int(leng_1 * 1.6) & ":" & Int((leng_1 Mod 60) * 1.6)
     Form6.List3.AddItem gettime
     DoEvents
  Next i
     Form6.MCI.Command = "stop"
     Form6.MCI.Command = "close"
     'MCI.DeviceType = "MPEGVideo"
     Form6.MCI.FileName = Form6.List1.list(0)
     Form6.MCI.Command = "Open"
     Form6.MCI.Command = "play"
     Form6.MCI.UpdateInterval = 1000
   Form6.Label11.Caption = "播放列表数：" & Form6.List2.ListCount
   Form6.Label9.Caption = "文件数：" & Form6.List1.ListCount
   
   Open App.Path & "\temp" & "\" & Dialog5.Text1.Text & "_time" For Output As #1       '有何用处，缺少为何无法写入
       For i% = 0 To Form6.List3.ListCount - 1
           Print #1, Form6.List3.list(i)
       Next i
   Close #1
   
   Unload Me
   Dialog5.SetFocus
 Else                                             '//用途2，用于添加文件
     For index = 0 To File1.ListCount - 1
         If File1.Selected(index) Then
            Form6.List1.AddItem Dir1.Path & "\" & File1.list(index)
         End If
     Next index
  Open App.Path & "\temp" & "\" & Form6.List2.Text & ".txt" For Output As #1      '将打开的路径保存
        For i = 0 To Form6.List1.ListCount - 1
            Print #1, Form6.List1.list(i)
        Next i
  Close #1
  
  Form6.List3.Clear
  For i = 0 To Form6.List1.ListCount - 1
     Form6.MCI.Command = "stop"
     Form6.MCI.Command = "close"
     'MCI.DeviceType = "MPEGVideo"
     Form6.MCI.FileName = Form6.List1.list(i)
     Form6.MCI.Silent = True
     Form6.MCI.Command = "Open"
     Form6.MCI.Command = "play"
     Form6.MCI.UpdateInterval = 1000
     Form6.MCI.Silent = True
     leng_1 = Form6.MCI.TrackLength / 100000
     gettime = Int(leng_1 * 1.6) & ":" & Int((leng_1 Mod 60) * 1.6)
     Form6.List3.AddItem gettime
     DoEvents
  Next i
     Form6.MCI.Command = "stop"
     Form6.MCI.Command = "close"
    'MCI.DeviceType = "MPEGVideo"
     Form6.MCI.FileName = Form6.List1.list(0)
     Form6.MCI.Command = "Open"
     Form6.MCI.Command = "play"
     Form6.MCI.UpdateInterval = 1000
   Form6.Label9.Caption = "文件数：" & Form6.List1.ListCount
   Form6.Label10.Caption = "正在播放：" & Form6.MCI.FileName
   
   Open App.Path & "\temp" & "\" & Form6.List2.Text & "_time" For Output As #1       '有何用处，缺少为何无法写入
       For i% = 0 To Form6.List3.ListCount - 1
           Print #1, Form6.List3.list(i)
       Next i
   Close #1
 End If
   Form6.Slider1.Enabled = True
    Unload Me
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub
Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
  On Error GoTo errorlabel
   Dir1.Path = Drive1.Drive
   Exit Sub
errorlabel:  MsgBox "设备可能未准备好，请准备好再试.", vbExclamation, "提示"
End Sub


Private Sub File1_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim index As Integer
    index = 0
   If Shift = 2 And KeyCode = vbKeyA Then
     For index = 0 To File1.ListCount - 1
         File1.Selected(index) = True
     Next index
  End If
End Sub

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

Private Sub Form_Load()
   On Error Resume Next
   File1.Pattern = "*.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU"
 With Combo1
   .Text = "*.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU"
   .AddItem "*.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU"
   .AddItem "*.wav"
   .AddItem "*.Dat"
   .AddItem "*.Mpeg"
   .AddItem "*.*"
 End With
 Open App.Path & "\temp\dir" For Input As #1    '将上次打开的路径读入
   On Error Resume Next
    Do While Not EOF(1)
       Line Input #1, nextline
      If nextline = "" Then
         Close #1
         Exit Sub                                '为空则退出
      Else
       Seek #1, 0
       Line Input #1, nextline
       Dir1.Path = nextline
       nextline = ""
       Seek #1, 1
       Line Input #1, nextline
       Drive1.Drive = nextline
       Exit Do
      End If
    Loop
 Close #1
End Sub