CD播放器

bigfeng

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 MMControl1_StopClick(Cancel As Integer)
    MMControl1.UpdateInterval = 0
    M_stop = True
       Combo1.Enabled = True
        MMControl1.Command = "stop"
        MMControl1.TimeFormat = 10
        MMControl1.Track = 1
        MMControl1.TimeFormat = 0
        MMControl1.From = MMControl1.TrackPosition
        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
        Combo1.Text = "01"
  
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

chenyucheng

有窗体吗

汉族

看不懂，不知道是啥。

jokey

沙发。