Audio recorder on visual basic (стр. 1 из 2)
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
If Not IsDate (wrst) Then
MsgBox ("The date/time you entered was not valid!")
Else
' String returned from InputBox is a valid time,
' so store it as a date/time value in WaveRecordingStartTime.
If CDate (wrst) < Now Then
MsgBox ("Recording events in the past is not possible... ")
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
Else
WaveRecordingStartTime = CDate (wrst)
End If
If WaveRecordingStopTime < WaveRecordingStartTime Then WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
End If
End Sub
Private Sub cmdStopTime_Click ()
Dim wrst As String
wrst = WaveRecordingStopTime
If wrst < WaveRecordingStartTime Then wrst = WaveRecordingStartTime + TimeSerial (0, 15, 0)
wrst = InputBox ("Enter stop time recording", "Stop time", wrst)
If wrst = "" Then Exit Sub
If Not IsDate (wrst) Then
MsgBox ("The time you entered was not valid!")
Else
' String returned from InputBox is a valid time,
' so store it as a date/time value in WaveRecordingStartTime.
If CDate (wrst) < WaveRecordingStartTime Then
MsgBox ("The stop time has to be later then the start time!")
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 5, 0)
Else
WaveRecordingStopTime = CDate (wrst)
End If
End If
End Sub
Private Sub Form_Load ()
Select Case Rate
Case 44100
optRate44100. Value = True
Case 22050
optRate22050. Value = True
Case 11025
optRate11025. Value = True
Case 8000
optRate8000. Value = True
Case 6000
optRate6000. Value = True
End Select
Select Case Channels
Case 1
optMono. Value = True
Case 2
optStereo. Value = True
End Select
Select Case Resolution
Case 8
opt8bits. Value = True
Case 16
opt16bits. Value = True
End Select
If WaveRecordingImmediate Then
optRecordImmediate. Value = True
Else
optRecordProgrammed. Value = True
End If
If WaveAutomaticSave Then
Option11. Value = True
Else
Option10. Value = True
End If
End Sub
Private Sub optRate11025_Click ()
Rate = 11025
optRate11025. Value = True
End Sub
Private Sub optRate44100_Click ()
Rate = 44100
optRate44100. Value = True
End Sub
Private Sub Option10_Click ()
WaveAutomaticSave = False
End Sub
Private Sub Option11_Click ()
WaveAutomaticSave = True
End Sub
Private Sub optRate22050_Click ()
Rate = 22050
optRate22050. Value = True
End Sub
Private Sub optRate8000_Click ()
Rate = 8000
optRate8000. Value = True
End Sub
Private Sub optRate6000_Click ()
Rate = 6000
optRate6000. Value = True
End Sub
Private Sub optMono_Click ()
Channels = 1
optMono. Value = True
End Sub
Private Sub optStereo_Click ()
Channels = 2
optStereo. Value = True
End Sub
Private Sub opt8bits_Click ()
Resolution = 8
opt8bits. Value = True
End Sub
Private Sub opt16bits_Click ()
Resolution = 16
opt16bits. Value = True
End Sub
Private Sub optRecordImmediate_Click ()
WaveRecordingImmediate = True
frmManualAuto. Visible = False
frmTimes. Visible = False
lblTimes. Visible = False
AudioRecorder. cmdRecord. Enabled = True
End Sub
Private Sub optRecordProgrammed_Click ()
WaveRecordingImmediate = False
frmManualAuto. Visible = True
frmTimes. Visible = True
lblTimes. Visible = True
AudioRecorder. cmdRecord. Enabled = False
If WaveRecordingStartTime < Now Then
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
End If
End Sub
Option Explicit
Public Declare Function ShellExecute Lib "shell32. dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Public Rate As Long
Public Channels As Integer
Public Resolution As Integer
Public WaveStatusMsg As String * 255
Public WaveStatisticsMsg As String
Public WaveRecordingImmediate As Boolean
Public WaveRecordingStartTime As Date
Public WaveRecordingStopTime As Date
Public WaveRecordingReady As Boolean
Public WaveRecording As Boolean
Public WavePlaying As Boolean
Public WaveAutomaticSave As Boolean
Public WaveFileName As String
Public WaveMidiFileName As String
Public WaveLongFileName As String
Public WaveShortFileName As String
Public WaveRenameNecessary As Boolean
'These were the public variables
'=====================================================
Private Declare Function mciSendString Lib "winmm. dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrrtning As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long