super player 9.0.frm

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

  With Toolbar1
     .Buttons(1).Image = 1
     .Buttons(3).Image = 2
     .Buttons(4).Image = 3
     .Buttons(6).Image = 4
     .Buttons(7).Image = 5
     .Buttons(9).Image = 9
     .Buttons(10).Image = 10
     .Buttons(12).Image = 6
     .Buttons(13).Image = 8
     .Buttons(15).Image = 7
     .Buttons(16).Image = 11
     .Buttons(17).Image = 12
     .Buttons(19).Image = 13
     .Buttons(21).Image = 14
     .Buttons(23).Image = 15
  End With
  
  With MMControl1
    .Notify = False                    'MCI完成后是否发生DONE事件
    .Wait = True                      '指定 Multimedia 控件是否等到下一命令执行完毕，才将控制权还给应用程序
    .Shareable = False               '是否共享设备资源
    .DeviceType = "MPEGVideo"           '初始化媒体设备为CD媒体设备
    .Visible = False               '控件不可视
    .Command = "Open"                    '打开设备
  End With
  If meuMyMusic(1).Caption <> "无可用音乐" Then
    MMControl1.FileName = meuMyMusic(1).Caption
    MMControl1.AutoEnable = True
    MMControl1.Command = "Open"
    MMControl1.Command = "Play"
    For x = 0 To 24
       Label8(x).Enabled = False
    Next x
    Label8(0).Enabled = True
  Else
    For x = 0 To 24
       Label8(x).Enabled = False
    Next x
  End If
  MMControl1.UpdateInterval = 1000
  Label1(0).Caption = ""
  Label2.Caption = ""
  Label3.Caption = ""
  Label4.Caption = ""
  Label5.Caption = ""
 'Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
 Label1(0).Caption = "当前状态:就绪"
 If meuMyMusic(1).Caption = "无可用音乐" Then
    Label2.Caption = "曲目总数:0"
 Else
    Label2.Caption = "曲目总数:1"
 End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

  If Button = vbRightButton Then                                '如果按下了鼠标又键
  
     Form1.PopupMenu meuRight, , x + 120, Y                        '又键菜单
     
  End If
  
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
   Form1.MouseIcon = Image1.Picture
End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
    MMControl1.Command = "Stop"                          '停止设备
    MMControl1.Command = "Close"                         '关闭设备
    Set Form1 = Nothing
  End
End Sub



Private Sub Label8_Click(index As Integer)
  On Error Resume Next
  For x = 0 To 24
     Label8(x).BorderStyle = 0
  Next x
  Label8(index).BorderStyle = 1
  If meuMusic.Visible = True Then
     VarVCD = index
     With MMControl1
       .Command = "Stop"
       .Command = "Close"
       .FileName = meuQuMu(index).Caption
       .UpdateInterval = 1000
       .Command = "Open"
       .Command = "Play"
       Label3.Caption = "正在播放: " & index + 1
     End With
     For x = 0 To 40
        meuQuMu(x).Checked = False
     Next x
     meuQuMu(index).Checked = True
  ElseIf meuPlayFile.Visible = True Then
     VarMore = index + 1
     With MMControl1
       .Command = "Stop"
       .Command = "Close"
       .FileName = meu(index + 1).Caption
       .UpdateInterval = 1000
       .Command = "Open"
       .Command = "Play"
       Label3.Caption = "正在播放: " & index + 1
     End With
     For x = 0 To 50
        meu(x).Checked = False
     Next x
     meu(index + 1).Checked = True
  ElseIf meuPlayList.Visible = True Then
     VarM3u = index
     With MMControl1
       .Command = "Stop"
       .Command = "Close"
       .FileName = meu2(index).Caption
       .UpdateInterval = 1000
       .Command = "Open"
       .Command = "Play"
       Label3.Caption = "正在播放: " & index + 1
     End With
     For x = 0 To 40
        meu2(x).Checked = False
     Next x
     meu2(index).Checked = True
  ElseIf meuCDQuMu.Visible = True Then
     
  End If
End Sub

Private Sub Label8_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  'If Button = vbLeftButton Then
    'For X = 0 To 24
     'Label8(X).BackColor = &HFFFFFF
    'Next X
     'Label8(Index).BackColor = &HC000&
  'End If
End Sub

Private Sub Label8_MouseMove(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  For x = 0 To 24
     Label8(x).BackColor = &H8000&
  Next x
  Label8(index).BackColor = &H80FF&
End Sub

Private Sub meu_Click(index As Integer)

 On Error Resume Next
 Slider1.Enabled = True
 MMControl1.Command = "Stop"
 MMControl1.Command = "Close"
 MMControl1.FileName = meu(index).Caption
 For chec = 0 To 50
    meu(chec).Checked = False
 Next chec
 meu(index).Checked = True
 VarMore = index
 MMControl1.Command = "Open"
 MMControl1.Command = "Play"
 MMControl1.UpdateInterval = 1000
 'Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
End Sub

Private Sub meu2_Click(index As Integer)
  On Error Resume Next
  Slider1.Enabled = True
  MMControl1.UpdateInterval = 1000                           '//单击播放
  MMControl1.Command = "Stop"
  MMControl1.Command = "Close"
  MMControl1.FileName = meu2(index).Caption
  For chec = 0 To 40
     meu2(chec).Checked = False
  Next chec
  meu2(index).Checked = True
  VarM3u = index
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  'Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
  MMControl1.UpdateInterval = 1000
End Sub

Private Sub meuAbout_Click()                    '显示关于对话框

  Dialog.Show
  
End Sub

Private Sub meuAgain_Click()              '重新播放

 On Error Resume Next
  Slider1.Value = 0
  Slider1.Enabled = True
  MMControl1.From = 0
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
End Sub

Private Sub meuAll_Click()                         '窗体永远再前
   meuAll.Checked = Not meuAll.Checked
   If meuAll.Checked = True Then
      ' 打开 TopMost 属性.
      SetWindowPos hwnd, conHwndTopmost, 250, 150, 480, 165, conSwpNoActivate Or conSwpShowWindow
   Else
      ' 关闭 TopMost 属性.
      SetWindowPos hwnd, conHwndNoTopmost, 250, 150, 480, 165, conSwpNoActivate Or conSwpShowWindow
   End If
   
End Sub

Private Sub meuAllPlay_Click()
  On Error Resume Next
  Dim i As Integer
  i = 0
  meuCDQuMu.Visible = False
  meuMusic.Visible = False
  meuPlayList.Visible = False
  meuPlayFile.Visible = True
  VarMore = 0
  For x% = 1 To 40
    Unload meu(x)
  Next x
  For x% = 0 To 24
     Label8(x).Enabled = False
  Next x
  Open App.Path & "\temp\music.m3u" For Input As #1
      Do While Not EOF(1)
         i = i + 1
         Line Input #1, nextline
         Load meu(i)
         Label8(i - 1).Enabled = True
         meu(i).Checked = False
         meu(i).Caption = nextline
      Loop
  Close #1
  Form1.Label2.Caption = "总曲目数:" & i
  MMControl1.Command = "Close"
  MMControl1.FileName = meu(1).Caption
  meu(1).Checked = True
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
  If MMControl1.Mode <> 526 Then
      MsgBox "未装声卡或驱动程序未正确安装或未加载" & Chr(10) + Chr(13) & "或者文件被转移", vbInformation + vbOKOnly, "提示"
    End If
  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
  Picture1.Picture = LoadPicture(CommonDialog2.FileName)
  Form1.Picture = LoadPicture(CommonDialog2.FileName)
  
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 24
     Label8(x).Enabled = False
  Next x
  If MMControl1.Mode <> 526 Then
      MsgBox "未装声卡或驱动程序未正确安装或加载", vbInformation + vbOKOnly, "提示"
    End If
  For x = 0 To Val(MMControl1.Tracks)
     Load meuCDQ(x)
     Label8(x).Enabled = True
  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"
      .FileName = firstCD & ":\" & meuCDQ(index).Caption
      .Command = "Open"
      .Command = "Play"
      .UpdateInterval = 1000
      For i = 0 To 30
        meuCDQ(i).Checked = False
      Next i
        Slider1.Enabled = True
        meuCDQ(index).Checked = True
      'Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
    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