cdrecord.vb

这是一本用Visual Studio.NET进行多媒体编程的读物

            If mciSendString("set capture bitspersample " & lBits, Nothing, 0, 0) Then MsgBox("Error setting capture bitspersample", MsgBoxStyle.Critical) : mciSendString("close capture", Nothing, 0, 0) : cmdCancel_Click(cmdCancel, New System.EventArgs())
        End If

        If lFinish Then
            If mciSendString("open cdaudio alias cd", Nothing, 0, 0) Then
                MsgBox("Error opening cd!", MsgBoxStyle.Critical) : cmdCancel_Click(cmdCancel, New System.EventArgs())
            Else
                mciSendString("set cd time format milliseconds", Nothing, 0, 0)
                mciSendString("record capture overwrite", Nothing, 0, 0)
                If lStart Then
                    lRet = mciSendString("play cd from " & lStart, Nothing, 0, 0)
                Else
                    lRet = mciSendString("play cd", Nothing, 0, 0)
                End If
                If lRet Then MsgBox("Error playing cd!", MsgBoxStyle.Critical) : cmdCancel_Click(cmdCancel, New System.EventArgs())
            End If
        End If

        tmrRecord.Enabled = True
    End Sub

    Private Sub cmdCancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdCancel.Click
        lFinish = 0
        lstRecord.SelectedIndex = lstRecord.Items.Count - 1
    End Sub

    Private Sub cmdFrom_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdFrom.Click
        On Error Resume Next
        If VB6.GetItemString(lstRecord, lstRecord.SelectedIndex) <> "--- Group ---" Then
            'lstTracks.Items.Add(New VB6.ListBoxItem(VB6.GetItemString(lstRecord, lstRecord.SelectedIndex), VB6.GetItemData(lstRecord, lstRecord.SelectedIndex)))
        End If
        lstRecord.Items.Remove(lstRecord.SelectedItem)
    End Sub

    Private Sub cmdRefresh_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdRefresh.Click
        Dim aRet, aTrack As String
        Dim lRet As Integer
        aRet = Space(64)
        aTrack = Space(2)
        lblCDID.Text = ""
        lblNumTracks.Text = ""
        lstTracks.Items.Clear()
        lstRecord.Items.Clear()
        If mciSendString("open cdaudio alias cd", Nothing, 0, 0) = 0 Then
            mciSendString("info cd identity", aRet, 64, 0)
            lblCDID.Text = CString(aRet)
            txtFile.Text = VB6.GetPath & "\CD-" & lblCDID.Text
            mciSendString("status cd number of tracks", aRet, 64, 0)
            lblNumTracks.Text = CString(aRet)
            mciSendString("set cd time format hms", Nothing, 0, 0)
            For lRet = 1 To Val(lblNumTracks.Text)
                mciSendString("status cd length track " & lRet, aRet, 64, 0)
                aTrack = RSet(CStr(lRet), Len(aTrack))
                lstTracks.Items.Add(New VB6.ListBoxItem("Track " & aTrack & " - " & CString(aRet), lRet))
            Next

            ReDim lTrackLengths(Val(lblNumTracks.Text))
            mciSendString("set cd time format milliseconds", Nothing, 0, 0)
            For lRet = 1 To Val(lblNumTracks.Text)
                mciSendString("status cd length track " & lRet, aRet, 64, 0)
                lTrackLengths(lRet) = CInt(CString(aRet))
            Next
            mciSendString("close cd", Nothing, 0, 0)
            lstTracks.Items.Add("--- Group ---")
        End If
    End Sub

    Private Sub cmdStart_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdStart.Click
        If Len(txtFile.Text) = 0 Then MsgBox("You must enter a filename.", MsgBoxStyle.Information) : txtFile.Focus() : Exit Sub
        If InStr(LCase(txtFile.Text), ".wav") Then MsgBox("Don't include the .WAV extension.") : txtFile.Focus() : Exit Sub
        If lstRecord.Items.Count = 0 Then MsgBox("You must select tracks to record.", MsgBoxStyle.Information) : lstTracks.Focus() : Exit Sub

        Dim k As Integer
        Dim bOutOfOrder As Boolean
        bGroups = False
        For k = 0 To lstRecord.Items.Count - 1
            If VB6.GetItemString(lstRecord, k) = "--- Group ---" Then
                bGroups = True
            ElseIf k > 0 Then
                If VB6.GetItemData(lstRecord, k - 1) <> VB6.GetItemData(lstRecord, k) - 1 Then
                    bOutOfOrder = True
                End If
            End If
        Next
        If bGroups And bOutOfOrder Then
            MsgBox("Tracks grouped together must be in sequence.", MsgBoxStyle.Critical)
            Exit Sub
        End If

        lblStatus.Text = ""
        lblStatus.Visible = True
        cmdCancel.Enabled = True
        cbxFormat.Enabled = False
        cmdStart.Enabled = False
        lstTracks.Enabled = False
        cmdRefresh.Enabled = False
        cmdTo.Enabled = False
        cmdFrom.Enabled = False
        lstRecord.Enabled = False
        txtFile.Enabled = False
        lstRecord.SelectedIndex = 0
        StartTrackRecording()
    End Sub

    Private Sub cmdTo_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdTo.Click
        On Error Resume Next
        If VB6.GetItemString(lstTracks, lstTracks.SelectedIndex) = "--- Group ---" Then
            If lstRecord.Items.Count = 0 Then
                MsgBox("You must first add some tracks.", MsgBoxStyle.Information)
                Exit Sub
            ElseIf VB6.GetItemString(lstRecord, lstRecord.Items.Count - 1) = "--- Group ---" Then
                MsgBox("You must first add some more tracks.", MsgBoxStyle.Information)
                Exit Sub
            End If
        End If
        lstRecord.Items.Add(New VB6.ListBoxItem(VB6.GetItemString(lstTracks, lstTracks.SelectedIndex), VB6.GetItemData(lstTracks, lstTracks.SelectedIndex)))
        If VB6.GetItemString(lstTracks, lstTracks.SelectedIndex) <> "--- Group ---" Then
            lstTracks.Items.Remove(lstTracks.SelectedIndex)
        End If
    End Sub

    Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        Dim RetVal As Integer
        cmdRefresh_Click(cmdRefresh, New System.EventArgs())
        RetVal = cbxFormat.Items.Add("8.000kHz, 8bit Mono, 7k/sec")
        RetVal = cbxFormat.Items.Add("8.000kHz, 8bit Stereo, 15k/sec")
        RetVal = cbxFormat.Items.Add("8.000kHz, 16bit Mono, 15k/sec")
        RetVal = cbxFormat.Items.Add("8.000kHz, 16bit Stereo, 31k/sec")

        RetVal = cbxFormat.Items.Add("11.025kHz, 8bit Mono, 10k/sec")
        RetVal = cbxFormat.Items.Add("11.025kHz, 8bit Stereo, 21k/sec")
        RetVal = cbxFormat.Items.Add("11.025kHz, 16bit Mono, 21k/sec")
        RetVal = cbxFormat.Items.Add("11.025kHz, 16bit Stereo, 43k/sec")
        cbxFormat.SelectedIndex = RetVal

        cbxFormat.Items.Add("22.050Hz, 8bit Mono, 21k/sec")
        cbxFormat.Items.Add("22.050Hz, 8bit Stereo, 43k/sec")
        cbxFormat.Items.Add("22.050Hz, 16bit Mono, 43k/sec")
        cbxFormat.Items.Add("22.050Hz, 16bit Stereo, 86k/sec")

        cbxFormat.Items.Add("44.100Hz, 8bit Mono, 43k/sec")
        cbxFormat.Items.Add("44.100Hz, 8bit Stereo, 86k/sec")
        cbxFormat.Items.Add("44.100Hz, 16bit Mono, 86k/sec")
        cbxFormat.Items.Add("44.100Hz, 16bit Stereo, 172k/sec")
    End Sub

    Private Sub Form1_Closing(ByVal eventSender As System.Object, ByVal eventArgs As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        Dim Cancel As Short = eventArgs.Cancel
        If tmrRecord.Enabled Then
            cmdCancel_Click(cmdCancel, New System.EventArgs())
            While tmrRecord.Enabled : System.Windows.Forms.Application.DoEvents() : End While
        End If
        eventArgs.Cancel = Cancel
    End Sub

    Private Sub lstRecord_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lstRecord.DoubleClick
        cmdFrom_Click(cmdFrom, New System.EventArgs())
    End Sub

    Private Sub lstTracks_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lstTracks.DoubleClick
        cmdTo_Click(cmdTo, New System.EventArgs())
    End Sub

    Private Sub tmrRecord_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles tmrRecord.Tick
        Dim aRet As String
        Dim lRet, lTrack As Integer
        aRet = Space(64)
        mciSendString("status cd position", aRet, 64, 0)
        lRet = Val(CString(aRet))
        If lFinish Then
            mciSendString("status cd current track", aRet, 64, 0)
            lTrack = Val(CString(aRet))
            lblStatus.Text = "Track " & lTrack & "  -  " & Int((lRet - lStart) / (lFinish - lStart) * 100) & "%"
        End If
        If lRet >= lFinish Then
            tmrRecord.Enabled = False
            mciSendString("stop capture", Nothing, 0, 0)
            mciSendString("stop cd", Nothing, 0, 0)
            mciSendString("save capture " & aFile, Nothing, 0, 0)
            mciSendString("close capture", Nothing, 0, 0)
            mciSendString("close cd", Nothing, 0, 0)
            If lstRecord.SelectedIndex + 1 < lstRecord.Items.Count Then
                lstRecord.SelectedIndex = lstRecord.SelectedIndex + 1
                StartTrackRecording()
            Else
                If lFinish Then
                    MsgBox("Finished!", MsgBoxStyle.Information)
                Else
                    MsgBox("Canceled!", MsgBoxStyle.Critical)
                End If
                lblStatus.Visible = False
                cmdCancel.Enabled = False
                cbxFormat.Enabled = True
                cmdStart.Enabled = True
                lstTracks.Enabled = True
                cmdRefresh.Enabled = True
                cmdTo.Enabled = True
                cmdFrom.Enabled = True
                lstRecord.Enabled = True
                txtFile.Enabled = True
            End If
        End If
    End Sub

    Private Sub txtFile_Enter(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtFile.Enter
        txtFile.SelectionStart = 0
        txtFile.SelectionLength = Len(txtFile.Text)
    End Sub
End Class