标题: CD播放器 [打印本页] 作者: bigfeng 时间: 2015-4-2 19:37 标题: CD播放器 Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim Nowfen As Integer, Nowmiao As Integer
Dim M_stop As Boolean
Private Sub Combo1_Click()
MMControl1.UpdateInterval = 0
MMControl1.Command = "stop"
MMControl1.TimeFormat = 10
MMControl1.Track = Val(Combo1.Text)
MMControl1.From = MMControl1.TrackPosition
Slider1.Value = 0
Slider1.Min = 0
MMControl1.TimeFormat = 0
If MMControl1.TrackLength < 1000 Then
Slider1.Max = 1
Else
Slider1.Max = MMControl1.TrackLength \ 1000
End If
Fen = MMControl1.TrackLength \ 60000
Lnow.Caption = "00:00"
Lsum.Caption = Format$(Fen * 100 + (MMControl1.TrackLength \ 1000 - Fen * 60), "00:00")
Lend.Caption = Lsum.Caption
MMControl1.TimeFormat = 10
MMControl1.Command = "play"
MMControl1.TimeFormat = 0
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Form1.Reload
End Sub
Private Sub Form_Activate()
M_stop = False
Form1.Reload
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
MMControl1.Command = "Close"
End
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
MMControl1.Command = "stop"
MMControl1.Command = "close"
End Sub
Private Sub MMControl1_PauseClick(Cancel As Integer)
MMControl1.UpdateInterval = 0
Combo1.Enabled = True
End Sub
Private Sub MMControl1_PlayClick(Cancel As Integer)
MMControl1.UpdateInterval = 1000
Combo1.Enabled = False
End Sub
Private Sub MMControl1_StatusUpdate()
If Nowmiao = 59 Then
Nowmiao = 0
Nowfen = Nowfen + 1
Else
Nowmiao = Nowmiao + 1
End If
Slider1.Value = Slider1.Value + 1
If Slider1.Value >= Slider1.Max Then
MMControl1.TimeFormat = 10
MMControl1.Track = Val(Combo1.Text) + 1
MMControl1.TimeFormat = 0
MMControl1.From = MMControl1.TrackPosition
Slider1.Value = 0
Slider1.Min = 0
Combo1.Text = Combo1.List(Val(Combo1.Text))
If MMControl1.TrackLength < 1000 Then
Slider1.Max = 1
Else
Slider1.Max = MMControl1.TrackLength \ 1000
End If
Fen = MMControl1.TrackLength \ 60000
Lnow.Caption = "00:00"
Lsum.Caption = Format$(Fen * 100 + (MMControl1.TrackLength \ 1000 - Fen * 60), "00:00")
Lend.Caption = Lsum.Caption
Nowfen = 0
Nowmiao = 0
Exit Sub
End If
Lnow.Caption = Format$(Nowfen * 100 + Nowmiao, "00:00")
If Nowmiao = 59 Then
Nowmiao = 0
Nowfen = Nowfen + 1
Else
Nowmiao = Nowmiao + 1
End If
Slider1.Value = Slider1.Value + 1
Lnow.Caption = Format$(Nowfen * 100 + Nowmiao, "00:00")
If Lnow.Caption >= Lsum.Caption Then
Lnow.Caption = Lsum.Caption
MMControl1.UpdateInterval = 0
End If
End Sub
Private Sub Slider1_Change()
If M_stop Then Exit Sub
MMControl1.UpdateInterval = 1000
MMControl1.From = Slider1.Value * 1000
MMControl1.Command = "play"
Nowfen = Slider1.Value \ 60
Nowmiao = Slider1.Value - Nowfen * 60
End Sub
Public Sub Reload()
Dim Drivename As String, I As Integer, A As Integer
Nowfen = 0
Nowmiao = 0
MMControl1.Command = "Close"
Drivename = ""
' 查找CD-ROM的驱动器号
For I = 65 To 75
If GetDriveType(Chr$(I) & ":") = 5 Then
Drivename = Chr$(I) & ":"
Exit For
End If
Next
If Drivename = "" Then
A = MsgBox("找不到 CD-ROM ！", 0 + 16, "提示信息")
MMControl1.Command = "Close"
End
End If
On Error GoTo err
File1.Path = Drivename + "\"
On Error GoTo 0
File1.Pattern = "*.cda"
If File1.ListCount > 0 Then
Label2.Caption = " CD 唱片"
MMControl1.DeviceType = "cdaudio"
MMControl1.Command = "open"
If MMControl1.Mode = 524 Then
A = MsgBox("驱动程序安装错误，无法播放 CD 唱片 ！", 0 + 16, "提示信息")
MMControl1.Command = "Close"
End
End If
MMControl1.TimeFormat = 0
MMControl1.UpdateInterval = 0
If File1.ListCount > 1 Then
For I = 0 To File1.ListCount - 1
Combo1.AddItem Format$(Str$(I + 1), "00"), I
Combo1.Enabled = True
Next I
Combo1.Text = "01"
Else
Combo1.AddItem "01", 0
Combo1.Enabled = True
End If
Slider1.Value = 0
Slider1.Min = 0
If MMControl1.TrackLength < 1000 Then
Slider1.Max = 1
Else
Slider1.Max = MMControl1.TrackLength \ 1000
End If
Fen = MMControl1.TrackLength \ 60000
Lnow.Caption = "00:00"
Lsum.Caption = Format$(Fen * 100 + (MMControl1.TrackLength \ 1000 - Fen * 60), "00:00")
Lend.Caption = Lsum.Caption
Exit Sub
End If
err:
Label2.Caption = "不正确的碟片"
A = MsgBox("未插入正确的碟片！", 0 + 1 + 16, "提示信息")
If A = 2 Then
MMControl1.Command = "Close"
End
End If
Resume
End Sub
