📄 super player 9.0.frm

📁 两个VB播放器两个VB播放器两个VB播放器两个VB播放器
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
   For x = 0 To 24
     Label8(x).Enabled = False
   Next x
   For x = 0 To VarVCD - 1
      Load meuQuMu(x)
      meuQuMu(x).Checked = False
      Label8(x).Enabled = True
      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
    MMControl1.FileName = FirstCDDrive & ":\Mpegav\" & meuQuMu(0).Caption    '播放文件
   ' Label7.Caption = "Super Player 9.0  正在播放：" & MMControl1.FileName
     Slider1.Enabled = True
     MMControl1.Command = "Open"
     MMControl1.Command = "Play"
     MMControl1.UpdateInterval = 1000
     Timer1.Enabled = True                                  '设置定时器有效
     meuQuMu(0).Checked = True
     meuPing.Checked = False
     If MMControl1.Mode <> 526 Then
      MsgBox "未装声卡或驱动程序未正确安装或未加载", vbInformation + vbOKOnly, "提示"
    End If
End Sub

Private Sub meuExit_Click()
  On Error Resume Next
  MMControl1.Command = "Stop"                             '停止设备
  MMControl1.Command = "Close"                            '关闭设备
  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
    '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 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
   meuCDQuMu.Visible = False
   Slider1.Enabled = True
   
   For x% = 0 To 40
     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
  For i% = 0 To 24
      Label8(i).Enabled = False
  Next i
  Open CommonDialog1.FileName For Input As #1
     Do While Not EOF(1)                          '将播放列表内内容读入菜单
      For VarM3u = 0 To sum - 1
         Label8(VarM3u).Enabled = True
         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
  If MMControl1.Mode <> 526 Then
     MsgBox "未装声卡或驱动程序未正确安装或未加载", vbInformation + vbOKOnly, "提示"
  End If
 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
  For i = 0 To 24
      Label8(i).Enabled = False
  Next i
  Label8(0).Enabled = True
  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
    If MMControl1.Mode <> 526 Then
      MsgBox "未装声卡或驱动程序未正确安装或未加载", vbInformation + vbOKOnly, "提示"
    End If
    meuCDAudio.Checked = False
    meuDATVideo.Checked = False
    meuPing.Checked = False
    meuSilent.Checked = False
    meuSou.Checked = False
    For i = 0 To 24
      Label8(i).Enabled = False
    Next i
    Label8(0).Enabled = True
End Sub


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

Private Sub meuPing_Click()               '重复播放
    MMControl1.UpdateInterval = 1000
    meuPing.Checked = Not meuPing.Checked
    meuSou.Checked = False
    Slider1.Enabled = True
End Sub

Private Sub meuPlay_Click()
  Slider1.Enabled = True
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"             '打开媒体
  MMControl1.UpdateInterval = 1000
End Sub

Private Sub meuPlayCD_Click()

  meuCDAudio_Click
  
End Sub

Private Sub meuPlayMeu_Click()

  meuOpen_Click
  
End Sub

Private Sub meuPlayVCD_Click()

  meuDATVideo_Click
  
End Sub

Private Sub meuQuMu_Click(index As Integer)
  On Error Resume Next                                               '//单击播放
  Slider1.Enabled = True
  MMControl1.Command = "Stop"
  MMControl1.Command = "Close"
  MMControl1.FileName = FirstCDDrive & ":\Mpegav\" & meuQuMu(index).Caption
  For chec = 0 To 30
    meuQuMu(chec).Checked = False
  Next chec
  meuQuMu(index).Checked = True
  VarVCD = index
  'Label7.Caption = "Super Player 9.0   正在播放：" & MMControl1.FileName
  Slider1.Enabled = True
  MMControl1.Command = "Open"
  MMControl1.Command = "Play"
  MMControl1.UpdateInterval = 1000
  Label3.Caption = "当前曲目:" & VarVCD + 1
End Sub

Private Sub meuRightAgain_Click()

  meuPing_Click
  
End Sub

Private Sub meuRightExit_Click()

  meuExit_Click
  
End Sub

Private Sub meuRightNew_Click()

  meuAgain_Click
  
End Sub

Private Sub meuRightOpen_Click()

  meuOpenCD_Click
  
End Sub

Private Sub meuRightSilent_Click()

   meuRightSilent.Checked = Not meuRightSilent.Checked
   meuSilent_Click
   
End Sub


Private Sub meuShow_Click()
  Form2.Check1.Visible = False
  Form2.Show
End Sub

Private Sub meuSilent_Click()                        '静音设置
  meuSilent.Checked = Not meuSilent.Checked
 If meuSilent.Checked = True Then
   MMControl1.Silent = True
   Toolbar1.Buttons(15).Image = 17
   Toolbar1.Buttons(15).ToolTipText = "打开音量"
 Else
   MMControl1.Silent = False
   Toolbar1.Buttons(15).Image = 7
   Toolbar1.Buttons(15).ToolTipText = "静音"
 End If
End Sub


Private Sub meuSou_Click()
    meuSou.Checked = Not meuSou.Checked
    Slider1.Enabled = True
    meuPing.Checked = False
End Sub

Private Sub meuSound_Click()                            '调整声音，调用声音调整
 On Error GoTo label
  vol = Shell("sndvol32.exe", vbNormalFocus)
    Exit Sub
label: MsgBox "请检查声音控制面板是否在Windows目录下。", vbInformation + vbOKOnly, "提示"
End Sub

Private Sub meuSoundTools_Click()
 
 On Error GoTo errline
   Tools = Shell(App.Path & "\音频转换.exe", vbNormalFocus)
   Exit Sub
errline:  MsgBox "文
上一页 1 2 3 45
💿 文件大小 2026 K
👤 上传用户 qinghuatong
📂 所属分类编辑器/阅读器
🏷️ 相关标签

#播放器
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -