Audio recorder on visual basic
25 AUTOMATIC SYSTEM AUDIO RECORDER ON VISUAL BASIC Dushanbe, 2009 Main Interface
Source Code Option Explicit 'Copyright: E. de Vries 'e-mail: eeltje@geocities.com 'This code can be used as freeware Const AppName = "AudioRecorder" Private Sub cmdSave_Click () Dim sName As String If WaveMidiFileName = "" Then sName = "Radio_from_" & CStr (WaveRecordingStartTime) & "_to_" & CStr (WaveRecordingStopTime) sName = Replace (sName, ": ", "-") sName = Replace (sName, " ", "_") sName = Replace (sName, "/", "-") Else sName = WaveMidiFileName sName = Replace (sName, "MID", "wav") End If CommonDialog1. FileName = sName CommonDialog1. CancelError = True On Error GoTo ErrHandler1 CommonDialog1. Filter = "WAV file (*. wav*) |*. wav" CommonDialog1. Flags = &H2 Or &H400 CommonDialog1. ShowSave sName = CommonDialog1. FileName WaveSaveAs (sName) Exit Sub ErrHandler1: End Sub Private Sub cmdRecord_Click () Dim settings As String Dim Alignment As Integer Alignment = Channels * Resolution / 8 settings = "set capture alignment " & CStr (Alignment) & " bitspersample " & CStr (Resolution) & " samplespersec " & CStr (Rate) & " channels " & CStr (Channels) & " bytespersec " & CStr (Alignment * Rate) WaveReset WaveSet WaveRecord WaveRecordingStartTime = Now cmdStop. Enabled = True 'Enable the STOP BUTTON cmdPlay. Enabled = False 'Disable the "PLAY" button cmdSave. Enabled = False 'Disable the "SAVE AS" button cmdRecord. Enabled = False 'Disable the "RECORD" button End Sub Private Sub cmdSettings_Click () Dim strWhat As String ' show the user entry form modally strWhat = MsgBox ("If you continue your data will be lost!", vbOKCancel) If strWhat = vbCancel Then Exit Sub End If Slider1. Max = 10 Slider1. Value = 0 Slider1. Refresh cmdRecord. Enabled = True cmdStop. Enabled = False cmdPlay. Enabled = False cmdSave. Enabled = False WaveReset Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025")) Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1")) Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16")) WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: \Radio. wav") WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True") WaveRecordingImmediate = True WaveRecordingReady = False WaveRecording = False WavePlaying = False 'Be sure to change the Value property of the appropriate button!! 'if you change the default values! WaveSet frmSettings. optRecordImmediate. Value = True frmSettings. Show vbModal End Sub Private Sub cmdStop_Click () WaveStop cmdSave. Enabled = True 'Enable the "SAVE AS" button cmdPlay. Enabled = True 'Enable the "PLAY" button cmdStop. Enabled = False 'Disable the "STOP" button If WavePosition = 0 Then Slider1. Max = 10 Else If WaveRecordingImmediate And (Not WavePlaying) Then Slider1. Max = WavePosition If (Not WaveRecordingImmediate) And WaveRecording Then Slider1. Max = WavePosition End If If WaveRecording Then WaveRecordingReady = True WaveRecordingStopTime = Now WaveRecording = False WavePlaying = False frmSettings. optRecordProgrammed. Value = False frmSettings. optRecordImmediate. Value = True frmSettings. lblTimes. Visible = False End Sub Private Sub cmdPlay_Click () WavePlayFrom (Slider1. Value) WavePlaying = True cmdStop. Enabled = True cmdPlay. Enabled = False End Sub Private Sub cmdWeb_Click () Dim ret& ret& = ShellExecute (Me. hwnd, "Open", "http://home. wxs. nl/~eeltjevr/", "", App. Path, 1) End Sub Private Sub cmdReset_Click () Slider1. Max = 10 Slider1. Value = 0 Slider1. Refresh cmdRecord. Enabled = True cmdStop. Enabled = False cmdPlay. Enabled = False cmdSave. Enabled = False WaveReset Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025")) Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1")) Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16")) WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: \Radio. wav") WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True") WaveRecordingImmediate = True WaveRecordingReady = False WaveRecording = False WavePlaying = False WaveMidiFileName = "" 'Be sure to change the Value property of the appropriate button!! 'if you change the default values! WaveSet If WaveRenameNecessary Then Name WaveShortFileName As WaveLongFileName WaveRenameNecessary = False WaveShortFileName = "" End If End Sub Private Sub Form_Load () WaveReset Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025")) Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1")) Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16")) WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: \Radio. wav") WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True") WaveRecordingImmediate = True WaveRecordingReady = False WaveRecording = False WavePlaying = False 'Be sure to change the Value property of the appropriate button!! 'if you change the default values! WaveSet WaveRecordingStartTime = Now + TimeSerial (0, 15, 0) WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0) WaveMidiFileName = "" WaveRenameNecessary = False End Sub Private Sub Form_Unload (Cancel As Integer) WaveClose Call SaveSetting ("AudioRecorder", "StartUp", "Rate", CStr (Rate)) Call SaveSetting ("AudioRecorder", "StartUp", "Channels", CStr (Channels)) Call SaveSetting ("AudioRecorder", "StartUp", "Resolution", CStr (Resolution)) Call SaveSetting ("AudioRecorder", "StartUp", "WaveFileName", WaveFileName) Call SaveSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", CStr (WaveAutomaticSave)) If WaveRenameNecessary Then Name WaveShortFileName As WaveLongFileName WaveRenameNecessary = False WaveShortFileName = "" End If End End Sub Private Sub Timer2_Timer () Dim RecordingTimes As String Dim msg As String RecordingTimes = "Start time: " & WaveRecordingStartTime & vbCrLf _ & "Stop time: " & WaveRecordingStopTime WaveStatistics If Not WaveRecordingImmediate Then WaveStatisticsMsg = WaveStatisticsMsg & "Programmed recording" If WaveAutomaticSave Then WaveStatisticsMsg = WaveStatisticsMsg & " (automatic save)" Else WaveStatisticsMsg = WaveStatisticsMsg & " (manual save)" End If WaveStatisticsMsg = WaveStatisticsMsg & vbCrLf & vbCrLf & RecordingTimes End If StatisticsLabel. Caption = WaveStatisticsMsg WaveStatus If WaveStatusMsg <> AudioRecorder. Caption Then AudioRecorder. Caption = WaveStatusMsg If InStr (AudioRecorder. Caption, "stopped") > 0 Then cmdStop. Enabled = False cmdPlay. Enabled = True End If If RecordingTimes <> frmSettings. lblTimes. Caption Then frmSettings. lblTimes. Caption = RecordingTimes If (Now > WaveRecordingStartTime) _ And (Not WaveRecordingReady) _ And (Not WaveRecordingImmediate) _ And (Not WaveRecording) Then WaveReset WaveSet WaveRecord WaveRecording = True cmdStop. Enabled = True 'Enable the STOP BUTTON cmdPlay. Enabled = False 'Disable the "PLAY" button cmdSave. Enabled = False 'Disable the "SAVE AS" button cmdRecord. Enabled = False 'Disable the "RECORD" button End If If (Now > WaveRecordingStopTime) And (Not WaveRecordingReady) And (Not WaveRecordingImmediate) Then WaveStop cmdSave. Enabled = True 'Enable the "SAVE AS" button cmdPlay. Enabled = True 'Enable the "PLAY" button cmdStop. Enabled = False 'Disable the "STOP" button If WavePosition > 0 Then Slider1. Max = WavePosition Else Slider1. Max = 10 End If WaveRecording = False WaveRecordingReady = True If WaveAutomaticSave Then WaveFileName = "Radio_from_" & CStr (WaveRecordingStartTime) & "_to_" & CStr (WaveRecordingStopTime) WaveFileName = Replace (WaveFileName, ": ", ". ") WaveFileName = Replace (WaveFileName, " ", "_") WaveFileName = WaveFileName & ". wav" WaveSaveAs (WaveFileName) msg = "Recording has been saved" & vbCrLf msg = msg & "Filename: " & WaveFileName MsgBox (msg) Else msg = "Recording is ready" & vbCrLf msg = msg & "Don't forget to save recording..." MsgBox (msg) End If frmSettings. optRecordProgrammed. Value = False frmSettings. optRecordImmediate. Value = True End If End Sub Option Explicit Private Sub cmdFileName_Click () WaveFileName = InputBox ("Filename: ", "Filename for automatic saving", WaveFileName) End Sub Private Sub cmdMidi_Click () CommonDialog2. CancelError = True On Error GoTo ErrHandler1 CommonDialog2. Filter = "Midi file (*. mid*) |*. mid" CommonDialog2. Flags = &H2 Or &H400 CommonDialog2. ShowOpen WaveMidiFileName = CommonDialog2. FileName WaveMidiFileName = GetShortName (WaveMidiFileName) ErrHandler1: End Sub Private Sub cmdOke_Click () Unload Me End Sub Private Sub cmdStartTime_Click () Dim wrst As String wrst = WaveRecordingStartTime wrst = InputBox ("Enter start time recording", "Start time", wrst) If wrst = "" Then Exit Sub
Страницы: 1, 2
|