file.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Dialog3 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "打开文件"
   ClientHeight    =   5400
   ClientLeft      =   6675
   ClientTop       =   4185
   ClientWidth     =   6840
   Icon            =   "File.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "File.frx":0E42
   ScaleHeight     =   5400
   ScaleWidth      =   6840
   ShowInTaskbar   =   0   'False
   Begin MSComDlg.CommonDialog Cmd1 
      Left            =   4080
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      InitDir         =   "我的文档"
   End
   Begin VB.CommandButton Command3 
      Caption         =   "另存为播放列表(&S)"
      Height          =   375
      Left            =   5520
      TabIndex        =   11
      ToolTipText     =   "另存为播放列表"
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   5520
      TabIndex        =   10
      ToolTipText     =   "取消"
      Top             =   840
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   5520
      TabIndex        =   9
      ToolTipText     =   "确定"
      Top             =   240
      Width           =   1215
   End
   Begin VB.DirListBox Dir1 
      Height          =   3450
      Left            =   2760
      TabIndex        =   8
      Top             =   1080
      Width           =   2535
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   2760
      TabIndex        =   7
      Top             =   5040
      Width           =   2535
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   120
      TabIndex        =   6
      Text            =   "Combo1"
      Top             =   5040
      Width           =   2535
   End
   Begin VB.FileListBox File1 
      Height          =   3510
      Hidden          =   -1  'True
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   5
      Top             =   1080
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      Height          =   405
      Left            =   120
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   600
      Width           =   2535
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "Label5"
      Height          =   855
      Left            =   2760
      TabIndex        =   3
      Top             =   120
      Width           =   2535
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "Label3"
      Height          =   255
      Left            =   2880
      TabIndex        =   2
      Top             =   4680
      Width           =   2295
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   4680
      Width           =   2055
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "选择文件"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   2055
   End
End
Attribute VB_Name = "Dialog3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Dim i As Integer

Private Sub Combo1_Click()
  'Dim index As Integer
  File1.Pattern = Combo1.Text
  Select Case Combo1.ListIndex
     Case 0
       Label2.Caption = "所有支持的媒体文件"
     Case 1
       Label2.Caption = "wav文件"
     Case 2
       Label2.Caption = "VCD视频"
     Case 3
       Label2.Caption = "影音文件"
     Case 4
       Label2.Caption = "所有文件"
  End Select
End Sub

Private Sub Command1_Click()
  On Error Resume Next
  Static t As Boolean
  Dim index As Integer
   t = Not t
   i = 0
  Form1.MMControl1.DeviceType = "MPEGVideo"
  Form1.MMControl1.Command = "Stop"
  Form1.MMControl1.Command = "Close"
  index = File1.ListCount
  
  For x = 1 To 50
    Unload Form1.meu(x)
  Next x
  
 If Text1.Text <> "" Then
   For x = 0 To 24
      Form1.Label8(x).Enabled = False
   Next x
   For index = 0 To index - 1
      If File1.Selected(index) Then             '//如果被选中则添加到曲目列表
         Form1.meu(i).Checked = False
         i = i + 1
         Load Form1.meu(i)
         Form1.Label8(i - 1).Enabled = True
         Form1.meu(i).Caption = Dir1.Path & "\" & File1.List(index)
      End If
   Next index
   Form1.Label2.Caption = "总曲目数:" & i
   Form1.meuPlayFile.Visible = True
   Form1.MMControl1.FileName = Form1.meu(1).Caption
   Form1.meu(1).Checked = True
   'Form1.Label7.Caption = "Super Player 9.0  正在播放：" & Form1.MMControl1.FileName
   Form1.MMControl1.Command = "Open"
   Form1.MMControl1.Command = "Play"
   Form1.MMControl1.UpdateInterval = 1000
   Form1.Slider1.Enabled = True
   Form1.meuPlayList.Visible = False
   Form1.meuCDQuMu.Visible = False
   Form1.meuMusic.Visible = False
   If Form1.MMControl1.Mode <> 526 Then
      MsgBox "未装声卡或驱动程序未正确安装或未加载", vbInformation + vbOKOnly, "提示"
    End If
   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, ""
      Print #1, Y
   Close #1
   
   Open App.Path & "\temp\Music.m3u" For Output As #1
        For x = 1 To 40
           Print #1, Form1.meu(x).Caption
           If Form1.meu(x).Caption = "" Then Exit For
        Next x
   Close #1
   
   Unload Form2
   Unload Me
Else
   DoEvents
End If
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Command3_Click()
  On Error Resume Next
  With Cmd1
     .FileName = "播放列表"
     .DialogTitle = "另存为播放列表"
     .Filter = "播放列表(*.m3u)|*.m3u|All Files(*.*)|*.*|"
     .CancelError = True
     .ShowSave
   If Err.Number = cdlCancel Then
        Dialog3.SetFocus
        Exit Sub
   End If
     Open Cmd1.FileName For Output As #1
       If Text1.Text <> "" Then
         For index = 0 To File1.ListCount - 1
           If File1.Selected(index) Then             '//如果被选中则添加到曲目列表
             'i = i + 1
             Print #1, Dir1.Path & "\" & File1.List(index)
           End If
        Next index
      End If
     Close #1
  End With
  Dialog3.SetFocus
End Sub

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
  Label5.Caption = "文件夹：" & Dir1.Path
End Sub

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

Private Sub File1_Click()
  Text1.Text = Text1.Text & "  " & File1.FileName
End Sub

Private Sub File1_DblClick()
   On Error Resume Next
    For x = 2 To 50
    Unload Form1.meu(x)
  Next x
  Form1.meuPlayFile.Visible = True
  With Form1.MMControl1
     .Command = "Close"
     .FileName = Dir1.Path & "\" & File1.FileName
     .Command = "Open"
     .Command = "Play"
     .UpdateInterval = 1000
  End With
  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, ""
      Print #1, Y
   Close #1
   Form1.meuPlayList.Visible = False
   Form1.meuCDQuMu.Visible = False
   Form1.meuMusic.Visible = False
   Form1.meu(1).Caption = Form1.MMControl1.FileName
   Unload Dialog3
   'Form1.Label7.Caption = "Super Player 9.0  正在播放：" & Form1.MMControl1.FileName
End Sub

Private Sub File1_KeyDown(KeyCode As Integer, Shift As Integer)
   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 File1_KeyUp(KeyCode As Integer, Shift As Integer)
  'On Error Resume Next
  '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 Form_Load()
   On Error Resume Next
   Text1.Text = ""
   Label3.Caption = "驱动器：" & Drive1.Drive
   Label5.Caption = "文件夹：" & Dir1.Path
   File1.Pattern = "*.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU"
   Label2.Caption = "所有支持的媒体文件"              '//支持格式
   'Drive1.Drive = "F:\"
   'Dir1.Path = "F:\"
 With Combo1
   .Text = "*.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU"
   .AddItem "*.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.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    '将上次打开的路径读入
    Do While Not EOF(1)
       Line Input #1, nextline
      If nextline = "" Then
         Exit Sub                                '为空则退出
      Else
       Seek #1, 0
       Line Input #1, nextline
       Dir1.Path = nextline
       nextline = ""
       Seek #1, 1
       Line Input #1, nextline
       Drive1.Drive = nextline
      End If
      Exit Sub
    Loop
 Close #1
End Sub