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
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
Slider1. Max = 10
Slider1. Value = 0
Slider1. Refresh
cmdRecord. Enabled = True
cmdStop. Enabled = False
cmdPlay. Enabled = False
cmdSave. Enabled = False
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!
frmSettings. optRecordImmediate. Value = True
frmSettings. Show vbModal
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
If WaveRecordingImmediate And (Not WavePlaying) Then Slider1. Max = WavePosition
If (Not WaveRecordingImmediate) And WaveRecording Then Slider1. Max = WavePosition
If WaveRecording Then WaveRecordingReady = True
WaveRecordingStopTime = Now
frmSettings. optRecordProgrammed. Value = False
frmSettings. lblTimes. Visible = False
Private Sub cmdPlay_Click ()
WavePlayFrom (Slider1. Value)
WavePlaying = True
cmdStop. Enabled = True
Private Sub cmdWeb_Click ()
Dim ret&
ret& = ShellExecute (Me. hwnd, "Open", "http://home. wxs. nl/~eeltjevr/", "", App. Path,
1)
Private Sub cmdReset_Click ()
WaveMidiFileName = ""
If WaveRenameNecessary Then
Name WaveShortFileName As WaveLongFileName
WaveRenameNecessary = False
WaveShortFileName = ""
Private Sub Form_Load ()
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
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))
End
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)"
WaveStatisticsMsg = WaveStatisticsMsg & " (manual save)"
WaveStatisticsMsg = WaveStatisticsMsg & vbCrLf & vbCrLf & RecordingTimes
StatisticsLabel. Caption = WaveStatisticsMsg
WaveStatus
If WaveStatusMsg <> AudioRecorder. Caption Then AudioRecorder. Caption = WaveStatusMsg
If InStr (AudioRecorder. Caption, "stopped") > 0 Then
cmdPlay. Enabled = True
If RecordingTimes <> frmSettings. lblTimes. Caption Then frmSettings. lblTimes. Caption = RecordingTimes
If (Now > WaveRecordingStartTime) _
And (Not WaveRecordingReady) _
Страницы: 1, 2, 3
