⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cd.frm

📁 大量优秀的vb编程
💻 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    =   3060
   ClientLeft      =   228
   ClientTop       =   2700
   ClientWidth     =   5280
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3060
   ScaleWidth      =   5280
   Begin VB.Frame fraCD1 
      BackColor       =   &H00808080&
      Caption         =   "MCI CD Player"
      BeginProperty Font 
         Name            =   "MS Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   3135
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5295
      Begin VB.Frame fraCD4 
         BackColor       =   &H00808080&
         Height          =   612
         Left            =   1560
         TabIndex        =   5
         Top             =   2160
         Width           =   2052
         Begin VB.CommandButton cmdLoad 
            Caption         =   "Load"
            Height          =   255
            Left            =   600
            TabIndex        =   6
            Top             =   240
            Width           =   855
         End
      End
      Begin VB.Frame fraCD2 
         BackColor       =   &H00808080&
         Height          =   1455
         Left            =   240
         TabIndex        =   1
         Top             =   480
         Width           =   4815
         Begin VB.Frame fraCD3 
            BackColor       =   &H00808080&
            Height          =   855
            Left            =   240
            TabIndex        =   2
            Top             =   240
            Width           =   855
            Begin VB.Label lblTrackCaption 
               BackColor       =   &H00808080&
               Caption         =   " Track   "
               Height          =   255
               Left            =   120
               TabIndex        =   4
               Top             =   480
               Width           =   615
            End
            Begin VB.Label lblTrack 
               Alignment       =   2  'Center
               Caption         =   "0"
               Height          =   255
               Left            =   240
               TabIndex        =   3
               Top             =   240
               Width           =   375
            End
         End
         Begin MCI.MMControl mciCDPlayer 
            Height          =   735
            Left            =   1200
            TabIndex        =   7
            Top             =   360
            Width           =   3540
            _ExtentX        =   6244
            _ExtentY        =   1291
            _Version        =   393216
            DeviceType      =   ""
            FileName        =   ""
         End
      End
   End
End
Attribute VB_Name = "frmCD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdLoad_Click()
    ' Open the CD device -- the disc must already be in the drive.
    On Error GoTo MCI_ERROR
    mciCDPlayer.Command = "Open"
    On Error GoTo 0
    
    ' Set the time format.
    mciCDPlayer.TimeFormat = vbMCIFormatTmsf
    
    ' Disable the Load command button, and display the "disc in drive" bitmap.
    cmdLoad.Enabled = False

    
    ' Set the track number to the first track.
    lblTrack.Caption = "1"
    Exit Sub

MCI_ERROR:
    DisplayErrorMessageBox
    Resume MCI_EXIT

MCI_EXIT:
    Unload frmCD
End Sub

Private Sub Form_Load()
    mciCDPlayer.Wait = True
    
    mciCDPlayer.UpdateInterval = 0
    
    ' Set the DeviceType property to a musical CD device.
    mciCDPlayer.DeviceType = "CDAudio"

    ' Set the track number to 0 (default).
    lblTrack.Caption = "0"
End Sub

Private Sub mciCDPlayer_EjectClick(Cancel As Integer)
    ' Enable the Load command button, and display the "disc out of drive" bitmap.
    cmdLoad.Enabled = True
    picCD1.Picture = picCD2.Picture
    mciCDPlayer.UpdateInterval = 0
    
    ' Eject the disc from the CD drive, and close the device.
    On Error GoTo MCI_ERROR2
    mciCDPlayer.Command = "Eject"
    mciCDPlayer.Command = "Close"
    On Error GoTo 0
    
    ' Set the track number back to 0.
    lblTrack.Caption = "0"
    
    ' Set the "play indicator" to off.
    lblIndicator.BackColor = &H404040
    Exit Sub

MCI_ERROR2:
    DisplayErrorMessageBox
    Resume Next
End Sub

Private Sub mciCDPlayer_NextCompleted(ErrorCode As Long)
    ' Set the track number to the new track.
    lblTrack.Caption = Str$(mciCDPlayer.Track)
End Sub

Private Sub mciCDPlayer_PauseClick(Cancel As Integer)
    mciCDPlayer.UpdateInterval = 0
        
    ' Set the "play indicator" to off.
    lblIndicator.BackColor = &H404040
End Sub

Private Sub mciCDPlayer_PlayClick(Cancel As Integer)
    mciCDPlayer.UpdateInterval = 1000
    
    ' Set the track number to the current track.
    lblTrack.Caption = Str$(mciCDPlayer.Track)
End Sub

Private Sub mciCDPlayer_PrevCompleted(ErrorCode As Long)
    ' Set the track number to new track.
    lblTrack.Caption = Str$(mciCDPlayer.Track)
End Sub

Private Sub mciCDPlayer_StatusUpdate()
    ' Set the track number to the current track.
    lblTrack.Caption = Str$(mciCDPlayer.Track)

    ' Determine if the "play indicator" is off or on,
    ' depending on whether the device is currently playing.
 
End Sub

Private Sub mciCDPlayer_StopClick(Cancel As Integer)
    mciCDPlayer.UpdateInterval = 0
    
    ' Set the "play indicator" to off.
    lblIndicator.BackColor = &H404040

    ' Reset the CD to track 1.
    mciCDPlayer.To = mciCDPlayer.Start
    mciCDPlayer.Command = "Seek"
    mciCDPlayer.Track = 1
    lblTrack.Caption = "1"
End Sub

⌨️ 快捷键说明

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