super player 9.0.frm

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

  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
  meuPing.Checked = False
  meuSilent.Checked = False
  meuSou.Checked = False
End Sub

Private Sub meuBack_Click()
    On Error Resume Next
  With CommonDialog2
   .Filter = "支持格式(*.bmp;*.jpg;)|*.bmp;*.jpg|All Files(*.*)|*.*|"
   .FileName = ""
   '.FileTitle = "打开图片"
   .DialogTitle = "图片文件"
   .ShowOpen
   If Err.Number = cdlCancel Then Exit Sub
   
  End With
  
  Form1.Picture = LoadPicture(CommonDialog2.FileName)
  
End Sub

Private Sub meuButton_Click()
  On Error Resume Next
  With CommonDialog2
     .DialogTitle = "背景颜色"
     .ShowColor
  If Err.Number = cdlCancel Then Exit Sub
     For x = 0 To 12
        Label8(x).BackStyle = 1
        Label8(x).BackColor = .Color
        Label8(x).BackStyle = 0
     Next x
  End With
 Open App.Path & "\temp\sight" For Output As #1
    Print #1, CommonDialog2.Color
 Close #1
End Sub

Private Sub meuCDAudio_Click()                      '播放CD音频

 On Error Resume Next
  Unload Form2
  meuCDQuMu.Visible = True
  meuMusic.Visible = False
  meuPlayList.Visible = False
  meuPlayFile.Visible = False
   meuCDAudio.Checked = True
   meuDATVideo.Checked = False
  MMControl1.DeviceType = "CDAudio"
  MMControl1.Command = "Stop"
  MMControl1.Command = "Close"
  VarM3u = 19
  VarVCD = 19
  MMControl1.Shareable = False
  Slider1.Enabled = True
  MMControl1.DeviceType = "CDAudio"
  MMControl1.FileName = FirstCDDrive & "\track1"
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
  For x = 1 To 200000
     DoEvents
  Next x
  
  For x = 0 To Val(MMControl1.Tracks)
     Load meuCDQ(x)
  Next x
  For k = 0 To Val(MMControl1.Tracks)
    meuCDQ(k).Caption = "Track" & k
  Next k
 If MMControl1.Tracks <= 3 Then

     MsgBox "CD碟未准备好,请装入CD后在试", vbInformation + vbOKOnly, "提示"
     'Form2.Show
     MMControl1.Command = "Stop"
     MMControl1.UpdateInterval = 1000
     For x = 1 To Val(MMControl1.Tracks)
        Unload meuCDQ(x)
     Next x
     meuCDQuMu.Visible = False
     MMControl1.Command = "Close"
     meuCDAudio.Checked = False
     Slider1.Value = 0
     Slider1.Enabled = True
     MMControl1.DeviceType = "MPEGVideo"
     Exit Sub
 End If
  meuCDQ(0).Checked = True
  meuPing.Checked = False
  meuSilent.Checked = False
  meuSou.Checked = False
  Label2.Caption = "曲目总数:" & MMControl1.Tracks
End Sub

Private Sub meuCDQ_Click(index As Integer)
    On Error Resume Next
    With MMControl1
      .Command = "Stop"
      .Command = "Close"
      Form7.WMP.URL = firstCD & ":\" & meuCDQ(index).Caption
      '.Command = "Open"
      '.Command = "Play"
      .UpdateInterval = 0
      For i = 0 To 30
        meuCDQ(i).Checked = False
      Next i
        Slider1.Enabled = True
        meuCDQ(index).Checked = True
      Label7.Caption = "Super Player 9.0   正在播放：" & Form7.WMP.URL
    End With
End Sub

'Private Sub meuCDQ_Click(index As Integer)
  'Slider1.Enabled = True
  'MMControl1.Command = "Stop"
  'MMControl1.Command = "Close"
 ' MMControl1.FileName = FirstCDDrive & ":\" & meuCDQ(index).Caption
 ' meuCDQ(index).Checked = True
 ' Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
 ' Slider1.Enabled = True
  'MMControl1.Command = "Open"
 ' MMControl1.Command = "Play"
  'MMControl1.UpdateInterval = 1000
'End Sub

Private Sub meuClose_Click()            '关上光驱
  CloseCDDoor
End Sub

Private Sub meuCloseCD_Click()
  meuClose_Click
End Sub

Private Sub meuDATVideo_Click()                               '播放VCD文件
  On Error Resume Next
   meuDATVideo.Checked = True
   meuCDAudio.Checked = False
   MMControl1.DeviceType = "MPEGVideo"
   Unload Form2
   meuPlayFile.Visible = False
   meuPlayList.Visible = False
   meuSilent.Checked = False
   meuSou.Checked = False
 If meuDATVideo.Checked = True Then
    meuMusic.Visible = True                          '设置曲目为可视
      VarVCD = 0
      MyFile(VarVCD) = Dir(FirstCDDrive & ":\Mpegav\*.DAT")    '判断是否有光驱或光碟
  End If
 meuCDQuMu.Visible = False
 MMControl1.Command = "Stop"
 MMControl1.Command = "Close"
 MMControl1.UpdateInterval = 1000
   Do Until MyFile(VarVCD) = ""                       '将光碟文件名加到曲目列表
       VarVCD = VarVCD + 1
       MyFile(VarVCD) = Dir
   Loop
   
   For x = 0 To VarVCD - 1
      Load meuQuMu(x)
      meuQuMu(x).Checked = False
      meuQuMu(x).Caption = MyFile(x)
    Next x
    Label2.Caption = "曲目总数:" & x
   If MyFile(0) = "" Then
NoDisk:
      MsgBox " 光 盘 没 有 准 备 好 !       ", vbInformation + vbOKOnly, "不能找到VCD文件"
      meuMusic.Visible = False
      MMControl1.Command = "Stop"
      MMControl1.Command = "Close"
      meuDATVideo.Checked = False
      Slider1.Value = 0
      MMControl1.UpdateInterval = 1000
      Exit Sub
   End If
    VarVCD = 0
   '播放VCD
    Form7.WMP.URL = FirstCDDrive & ":\Mpegav\" & meuQuMu(0).Caption     '播放文件
    Label7.Caption = "Super Player 9.0  正在播放：" & Form7.WMP.URL
     Slider1.Enabled = True
     Form7.Show
     'MMControl1.Command = "Open"
     'MMControl1.Command = "Play"
     'MMControl1.UpdateInterval = 1000
     Timer1.Enabled = True                                  '设置定时器有效
     meuQuMu(0).Checked = True
     meuPing.Checked = False
     
End Sub

Private Sub meuExit_Click()
  On Error Resume Next
  MMControl1.Command = "Stop"                             '停止设备
  MMControl1.Command = "Close"                            '关闭设备
  Set Form1 = Nothing
  Set Form6 = Nothing                                     '防止内存泄露
  Set Dialog3 = Nothing
  Set Form3 = Nothing
  End                                                     '退出
End Sub

Private Sub meuFileOpen_Click()
  VarMore = 0
  Form1.MMControl1.DeviceType = "MPEGVideo"
  meuPing.Checked = False
  meuSilent.Checked = False
  meuSou.Checked = False
  Dialog3.Show
End Sub


Private Sub meuFlash_Click()
   On Error Resume Next
   With CommonDialog2
      .FileName = ""
      .DialogTitle = "Flash文件"
      .Filter = "Flash(*.swf)|*.swf|All Files(*.*)|*.*|"
      .ShowOpen
    If Err.Number = cdlCancel Then Exit Sub
    Form5.Flash1.Movie = .FileName
    End With
    Form5.Show
    Form5.Flash1.Playing = True
End Sub

Private Sub meuFont_Click()
  On Error Resume Next
  With CommonDialog2
     .CancelError = True
     .DialogTitle = "颜色"
     .ShowColor
     If Err.Number = cdlCancel Then
        Exit Sub
     End If
  End With
 For x = 0 To 12
    Label8(x).ForeColor = CommonDialog2.Color
 Next x
    Label7.ForeColor = CommonDialog2.Color
    Label1(0).ForeColor = CommonDialog2.Color
    Label2.ForeColor = CommonDialog2.Color
    Label3.ForeColor = CommonDialog2.Color
    Label4.ForeColor = CommonDialog2.Color
    Label5.ForeColor = CommonDialog2.Color
 Open App.Path & "\temp\color" For Output As #1
    Print #1, CommonDialog2.Color
 Close #1
End Sub

Private Sub meuFull_Click()
    On Error Resume Next
    Form7.WMP.fullScreen = True
End Sub

Private Sub meuHelp_Click()

  Dialog1.Show
  
End Sub


Private Sub meuli_Click()
    meuli.Checked = Not meuli.Checked
  If meuli.Checked = True Then
     meuZuo.Checked = False
    
     meuYou.Checked = False
     
     MMControl1.Command = "Set Audio All On"
     
  End If
  
End Sub

Private Sub meuM3u_Click()

 On Error Resume Next
  Dim nextline As String
  MMControl1.DeviceType = "MPEGVideo"
  MMControl1.UpdateInterval = 1000
  CommonDialog1.Flags = cdlOFNFileMustExist       '设置对话框模式
  CommonDialog1.FileName = ""
  CommonDialog1.DialogTitle = "声音文件"
  CommonDialog1.Filter = "播放列表(*.m3u)|*.m3u|All Files(*.*)|*.*|"
  CommonDialog1.ShowOpen
  meuPing.Checked = False
  meuSilent.Checked = False
  meuSou.Checked = False
 
  If Err.Number = cdlCancel Then Exit Sub             '如果按下了取消键，是则退出模块
   Unload Form2
   Unload Form7
   meuCDQuMu.Visible = False
   meuPlayFile.Visible = False
   meuMusic.Visible = False
   Slider1.Enabled = True
   
   For x = 0 To 30
     Unload meu2(x)
   Next
   
   Dim sum As Integer
    sum = 0
  Open CommonDialog1.FileName For Input As #1
    Do While Not EOF(1)
       sum = sum + 1
       Line Input #1, nextline
    Loop
  Close #1
  Form1.Label2.Caption = "总曲目数:" & sum
  Open CommonDialog1.FileName For Input As #1
     Do While Not EOF(1)                          '将播放列表内内容读入菜单
      For VarM3u = 0 To sum - 1
         meu2(VarM3u).Caption = ""
         meu2(VarM3u).Checked = False
         meu2(VarM3u).Visible = True
         Load meu2(VarM3u)
       Line Input #1, nextline                     '读顺序文件
       meu2(VarM3u).Caption = nextline
      Next VarM3u
     Loop
  Close #1
   meu2(0).Checked = True
   meuPlayList.Visible = True
   meuPlayFile.Visible = False
   meuMusic.Visible = False
   meuCDAudio.Checked = False
   meuDATVideo.Checked = False
  MMControl1.Command = "Stop"
  MMControl1.Command = "Close"
  VarM3u = 0
  Slider1.Enabled = True
  MMControl1.FileName = meu2(VarM3u).Caption
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
  Label7.Caption = "Super Player 9.0  正在播放：" & MMControl1.FileName
 Open App.Path & "\temp\Music.m3u" For Output As #1
         For x = 0 To 40
           Print #1, meu2(x).Caption
           If meu2(x).Caption = "" Then Exit For   '//将打开文件写入文件
         Next x
 Close #1
End Sub

Private Sub meuMyMusic_Click(index As Integer)
  If meuMyMusic(1).Caption = "无可用音乐" Then
      Exit Sub
  End If
  MMControl1.Command = "Stop"
  MMControl1.Command = "Close"                             '//播放历史声音文件
  Unload Form2
  Slider1.Enabled = True
  MMControl1.FileName = meuMyMusic(index).Caption
  Slider1.Enabled = True
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
    For x = 1 To 20000
      DoEvents
    Next x
  If MMControl1.Mode = 524 Or MMControl1.Mode = 530 Then
     MsgBox "所选歌曲路径不正确或被转移" & Chr(10) + Chr(13) & "你可以把曲目复制到当前目录下", vbExclamation + vbOKOnly, "提示"
     Slider1.Value = 0
     MMControl1.Command = "Close"
     Exit Sub
  End If
  Label7.Caption = "Super Player 9.0  正在播放：" & MMControl1.FileName
 'On Error GoTo errline
'errline:  MsgBox "文件被更名或被删除。", vbExclamation + vbOKOnly, "警告"
End Sub

Private Sub meuMyTool_Click()
   Form6.Show
   VarMore = 0                    '//初始化全局变量 varmore
   meuPing.Checked = False
   meuSilent.Checked = False
   meuSou.Checked = False
End Sub

Private Sub meuOpen_Click()                              '打开文件
 
  On Error Resume Next
    MMControl1.DeviceType = "MPEGVideo"
    CommonDialog1.InitDir = "D:\My Documents\My music"
    CommonDialog1.Flags = cdlOFNFileMustExist       '设置对话框模式
    CommonDialog1.Filter = "支持媒体文件(*.cda;*.AVI;*.asf;*.asx;*.wpl;*.wm;*.wma;*.wmv;*.AU;*.WAV;*.DAT;*.mid;*.MIDI;*.RMI;*.MPG;*.Mp3;*.MPEG)|*.cda;*.AVI;*.WAV;*.DAT;MID;*.MIDI;*.asf;*.asx;*.wpl;*.wm;*.wma;*.wmv;*.AU;*.RMI;*.MPG;*.Mp3;*.MPEG| All Files(*.*)|*.*|"
    CommonDialog1.FileName = ""
    CommonDialog1.DialogTitle = "声音文件"
    CommonDialog1.ShowOpen
    
  If Err.Number = cdlCancel Then Exit Sub               '如果按下了取消键，是则退出模块
     Unload Form2
     VarMore = 0
     VarM3u = 19
     VarVCD = 19
     meuCDQuMu.Visible = False
     Slider1.Enabled = True
     MMControl1.Command = "Stop"
     MMControl1.Command = "Close"
     MMControl1.FileName = CommonDialog1.FileName             '打开对话框
     Label7.Caption = "Super Player 9.0  正在播放：" & MMControl1.FileName
     MMControl1.Command = "Open"                                    '打开媒体
     MMControl1.Command = "Play"
     MMControl1.UpdateInterval = 1000
    meuPlayList.Visible = False
    meuMusic.Visible = False
    meuPlayFile.Visible = False
    meuCDAudio.Checked = False
    meuDATVideo.Checked = False
    meuPing.Checked = False
    meuSilent.Checked = False
    meuSou.Checked = False
    Unload Form7
End Sub


Private Sub meuOpenCD_Click()          '弹出光驱
  If meuMusic.Visible = True Or MMControl1.Tracks >= 6 Then  '判断光驱中是否有光碟
     MMControl1.Command = "Stop"
  End If
  OpenCDD