cdplay.frm

VB源码,是初学者的福因.让你很快掌握VB编程

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "CD播放程序"
   ClientHeight    =   2445
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   2445
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdVolume 
      Caption         =   "音量"
      Height          =   375
      Left            =   3600
      TabIndex        =   13
      Top             =   1680
      Width           =   735
   End
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   4200
      Top             =   240
   End
   Begin VB.CommandButton cmdNext 
      Caption         =   "下一曲"
      Height          =   375
      Left            =   2760
      TabIndex        =   12
      Top             =   1680
      Width           =   735
   End
   Begin VB.CommandButton cmdPrev 
      Caption         =   "上一曲"
      Height          =   375
      Left            =   1920
      TabIndex        =   11
      Top             =   1680
      Width           =   735
   End
   Begin VB.CommandButton cmdDoorClose 
      Caption         =   "关门"
      Height          =   375
      Left            =   1080
      TabIndex        =   10
      Top             =   1680
      Width           =   735
   End
   Begin VB.CommandButton cmdEject 
      Caption         =   "退出"
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   1680
      Width           =   735
   End
   Begin VB.CommandButton cmdPlay 
      Caption         =   "播放"
      Height          =   375
      Left            =   1080
      TabIndex        =   8
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdPause 
      Caption         =   "暂停"
      Height          =   375
      Left            =   1920
      TabIndex        =   7
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdOpen 
      Caption         =   "开启"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdReset 
      Caption         =   "重置"
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      Top             =   1200
      Width           =   735
   End
   Begin VB.TextBox txtLength 
      Height          =   270
      Left            =   960
      TabIndex        =   1
      Top             =   240
      Width           =   3135
   End
   Begin VB.TextBox txtCurrent 
      Height          =   270
      Left            =   960
      TabIndex        =   0
      Top             =   645
      Width           =   3135
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "总长度"
      Height          =   180
      Left            =   240
      TabIndex        =   3
      Top             =   288
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "目前:"
      Height          =   180
      Left            =   240
      TabIndex        =   2
      Top             =   696
      Width           =   456
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdClose_Click()
    mciSendString "stop MyMedia", vbNullString, 0, 0
    mciSendString "close MyMedia", vbNullString, 0, 0
End Sub

Private Sub cmdDoorClose_Click()
    mciSendString "set MyMedia door closed", vbNullString, 0, 0
End Sub

Private Sub cmdEject_Click()
    mciSendString "set MyMedia door open", vbNullString, 0, 0
End Sub

Private Sub cmdNext_Click()
    Dim S As String, Tracks As Integer, CurTrack As Integer
    
    S = String(256, Chr(0))
    mciSendString "status MyMedia number of tracks", S, Len(S), 0
    Tracks = Val(S)

    mciSendString "status MyMedia current track", S, Len(S), 0
    CurTrack = Val(S)
    
    If CurTrack < Tracks Then
        mciSendString "status MyMedia position track " & CurTrack + 1, S, Len(S), 0
        mciSendString "play MyMedia from " & Left(S, 8), vbNullString, 0, 0
    End If
End Sub

Private Sub cmdOpen_Click()
    Dim ret As Long, S As String
    
    mciSendString "close MyMedia", vbNullString, 0, 0
    ret = mciSendString("open cdaudio alias MyMedia", vbNullString, 0, 0)
    
    If ret = 0 Then
        Dim Length As String, Tracks As Integer
        
        S = String(256, Chr(0))
        mciSendString "status MyMedia length", S, Len(S), 0
        Length = Left(S, 8)
        
        mciSendString "status MyMedia number of tracks", S, Len(S), 0
        Tracks = Val(S)
        
        txtLength.Text = "[" & Tracks & "] " & Length
    Else
        S = String(256, Chr(0))
        mciGetErrorString ret, S, Len(S)
        MsgBox Left(S, InStr(S, Chr(0)) - 1)
    End If
End Sub

Private Sub cmdPause_Click()
    mciSendString "pause MyMedia", vbNullString, 0, 0
End Sub

Private Sub cmdPlay_Click()
    mciSendString "play MyMedia", vbNullString, 0, 0
End Sub

Private Sub cmdPrev_Click()
    Dim S As String, CurTrack As Integer
    
    S = String(256, Chr(0))
    mciSendString "status MyMedia current track", S, Len(S), 0
    CurTrack = Val(S)
    
    If CurTrack > 1 Then
        mciSendString "status MyMedia position track " & CurTrack - 1, S, Len(S), 0
        mciSendString "play MyMedia from " & Left(S, 8), vbNullString, 0, 0
    End If
End Sub

Private Sub cmdReset_Click()
    mciSendString "pause MyMedia", vbNullString, 0, 0
    mciSendString "seek MyMedia to start", vbNullString, 0, 0
End Sub

Private Sub cmdVolume_Click()
    Shell "Sndvol32.exe", vbNormalFocus
End Sub

Private Sub Form_Load()
    Dim S As String
    
    S = String(256, Chr(0))
    mciSendString "status cdaudio number of tracks", S, Len(S), 0
    If Val(S) <> 0 Then cmdOpen_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cmdClose_Click
End Sub

Private Sub Timer1_Timer()
    Dim S As String, ret As Long, pos As String, track As Integer
    
    S = String(256, 0)
    mciSendString "status MyMedia position", S, Len(S), 0
    pos = Left(S, 8)
    
    mciSendString "status MyMedia current track", S, Len(S), 0
    track = Val(S)
    
    txtCurrent = "[" & track & "] " & pos
End Sub