【VB开源代码栏目提醒】：网学会员--在 VB开源代码编辑为广大网友搜集整理了：frmcd.frm绩等信息，祝愿广大网友取得需要的信息，参考学习。

    VERSION 5.00
    Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
    Begin VB.Form frmCD 
       BorderStyle     =   1  'Fixed Single
       Caption         =   "CD播放器"
       ClientHeight    =   2970
       ClientLeft      =   225
       ClientTop       =   2700
       ClientWidth     =   4800
       Icon            =   "frmcd.frx":0000
       LinkMode        =   1  'Source
       LinkTopic       =   "Form1"
       LockControls    =   -1  'True
       MaxButton       =   0   'False
       MinButton       =   0   'False
       ScaleHeight     =   2970
       ScaleWidth      =   4800
       StartUpPosition =   2  '屏幕中心
       Begin VB.ListBox lstQmqd 
          Height          =   2040
          Left            =   210
          TabIndex        =   6
          Top             =   405
          Width           =   1590
       End
       Begin VB.CommandButton cmdLoad 
          Caption         =   "载入"
          Height          =   300
          Left            =   165
          TabIndex        =   0
          Top             =   2565
          Width           =   1650
       End
       Begin MCI.MMControl mciCDPlayer 
          Height          =   780
          Left            =   1950
          TabIndex        =   2
          Top             =   390
          Width           =   2685
          _ExtentX        =   4736
          _ExtentY        =   1376
          _Version        =   393216
          BackVisible     =   0   'False
          StepVisible     =   0   'False
          StopVisible     =   0   'False
          RecordVisible   =   0   'False
          DeviceType      =   ""
          FileName        =   ""
       End
       Begin VB.Label Label1 
          AutoSize        =   -1  'True
          Caption         =   "曲目清单:"
          Height          =   180
          Left            =   210
          TabIndex        =   7
          Top             =   150
          Width           =   810
       End
       Begin VB.Label Label3 
          AutoSize        =   -1  'True
          Caption         =   "当前播放位置:"
          Height          =   180
          Left            =   2010
          TabIndex        =   5
          Top             =   2205
          Width           =   1170
       End
       Begin VB.Label lblPosition 
          Alignment       =   2  'Center
          BackColor       =   &H80000007&
          BorderStyle     =   1  'Fixed Single
          BeginProperty Font 
             Name            =   "宋体"
             Size            =   12
             Charset         =   134
             Weight          =   700
             Underline       =   0   'False
             Italic          =   0   'False
             Strikethrough   =   0   'False
          EndProperty
          ForeColor       =   &H0000FFFF&
          Height          =   360
          Left            =   3195
          TabIndex        =   4
          Top             =   2190
          Width           =   1380
       End
       Begin VB.Label Label2 
          AutoSize        =   -1  'True
          Caption         =   "曲目总长度:"
          Height          =   180
          Left            =   2010
          TabIndex        =   3
          Top             =   1650
          Width           =   990
       End
       Begin VB.Label lblLength 
          Alignment       =   2  'Center
          BackColor       =   &H80000008&
          BorderStyle     =   1  'Fixed Single
          BeginProperty Font 
             Name            =   "宋体"
             Size            =   12
             Charset         =   134
             Weight          =   700
             Underline       =   0   'False
             Italic          =   0   'False
             Strikethrough   =   0   'False
          EndProperty
          ForeColor       =   &H0000FFFF&
          Height          =   360
          Left            =   3195
          TabIndex        =   1
          Top             =   1665
          Width           =   1380
       End
    End
    Attribute VB_Name = "frmCD"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option Explicit
    
    Private Sub cmdLoad_Click()
        ' 打开 CD 设备 -- 光盘已经在驱动器中。
        On Error GoTo MCI_ERROR
        mciCDPlayer.Command = "Open"
        On Error GoTo 0
        
        ' 设置时间格式
        mciCDPlayer.TimeFormat = mciFormatMilliseconds
        
        ' 禁用“载入”按钮。
        cmdLoad.Enabled = False
        
        ' 载入曲目。
        Dim i As Long
        Dim strTrack As String * 2
        Dim strTrackLength As String * 5
        lstQmqd.Clear
        For i = 1 To mciCDPlayer.Tracks
            mciCDPlayer.Track = i
            strTrack = i
            strTrackLength = Format((mciCDPlayer.TrackLength \ 1000) \ 60, "00") _
            & ":" & Format((mciCDPlayer.TrackLength \ 1000) Mod 60, "00")
            
            lstQmqd.AddItem strTrack & Space(5) & strTrackLength
        Next
        
        lblLength = Format((mciCDPlayer.Length \ 1000) \ 60, "00") & ":" _
        & Format((mciCDPlayer.Length \ 1000) Mod 60, "00")
        
        Exit Sub
    
    MCI_ERROR:
        DisplayErrorMessageBox
        Resume MCI_EXIT
    
    MCI_EXIT:
        Unload frmCD
    End Sub
    
    Private Sub Form_Load()
        mciCDPlayer.Wait = True
        mciCDPlayer.UpdateInterval = 0
        
        ' 设置 DeviceType 属性为音乐 CD 设备。
        mciCDPlayer.DeviceType = "CDAudio"
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        mciCDPlayer.Command = "Close"
    End Sub
    
    Private Sub mciCDPlayer_EjectClick(Cancel As Integer)
        ' 使“载入”按钮可用。
        cmdLoad.Enabled = True
        
        mciCDPlayer.UpdateInterval = 0
        
        ' 从 CD 设备中退出光盘, 并且关闭此设备。
        On Error GoTo MCI_ERROR2
        mciCDPlayer.Command = "Close"
        On Error GoTo 0
        lblTrack = ""
        Exit Sub
    MCI_ERROR2:
        DisplayErrorMessageBox
        Resume Next
    End Sub
    
    Private Sub mciCDPlayer_NextCompleted(Errorcode As Long)
        mciCDPlayer_StatusUpdate
    End Sub
    
    Private Sub mciCDPlayer_PauseClick(Cancel As Integer)
        mciCDPlayer.UpdateInterval = 0
    End Sub
    
    Private Sub mciCDPlayer_PlayClick(Cancel As Integer)
        mciCDPlayer.UpdateInterval = 1000
    End Sub
    
    Private Sub mciCDPlayer_PrevCompleted(Errorcode As Long)
        mciCDPlayer_StatusUpdate
    End Sub
    
    Private Sub mciCDPlayer_StatusUpdate()
        ' 读取播放位置。
        lblPosition = Format((mciCDPlayer.Position \ 1000) \ 60, "00") _
        & ":" & Format((mciCDPlayer.Position \ 1000) Mod 60, "00")
    End Sub
    
    Sub DisplayErrorMessageBox()
        ' 在这里对所有运行错误进行强制处理。
        Dim Msg As String
        Select Case Err
            Case 30266
                Msg = "加载多媒体设备驱动器错误。"
            Case 30263
                Msg = "设备不能被打开或未知设备。"
            Case 30257
                Msg = "无效设备 id。"
            Case 30304
                Msg = "无效文件名称。"
            Case 30274
                Msg = "