| |
frmAudioRecorder.frm formu ;
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form AudioRecorder
BorderStyle = 1 'Fixed Single
Caption = "AudioRecorder"
ClientHeight = 3765
ClientLeft = 45
ClientTop = 330
ClientWidth = 7080
Icon = "frmAudioRecorder.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3765
ScaleWidth = 7080
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdSettings
Caption = "Settings"
Height = 495
Left = 5970
TabIndex = 10
ToolTipText = "Change rate, stereo/mono, 8/16 bits and program an automatic recording"
Top = 120
Width = 975
End
Begin MSComctlLib.Slider Slider1
Height = 375
Left = 240
TabIndex = 8
ToolTipText = "You can choose a beginning for playing the recording"
Top = 960
Width = 4575
_ExtentX = 8070
_ExtentY = 661
_Version = 393216
LargeChange = 500
SmallChange = 100
TickStyle = 3
End
Begin VB.CommandButton cmdWeb
Caption = "Web"
Height = 495
Left = 4995
TabIndex = 7
ToolTipText = "Visit the home page of me!! (Maybe a new version is available...)"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdReset
Caption = "Reset"
Height = 495
Left = 120
TabIndex = 4
ToolTipText = "To start a new recording and adjusting all settings"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 495
Left = 4020
TabIndex = 3
ToolTipText = "Save the recording as as WAV file"
Top = 120
Width = 975
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5760
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FileName = " "
Orientation = 2
End
Begin VB.CommandButton cmdPlay
Caption = "Play"
Enabled = 0 'False
Height = 495
Left = 3045
TabIndex = 2
ToolTipText = "Play the recording"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdStop
Caption = "Stop"
Enabled = 0 'False
Height = 495
Left = 2070
TabIndex = 1
ToolTipText = "Stop recording or playing"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdRecord
Caption = "Record"
Height = 495
Left = 1095
TabIndex = 0
ToolTipText = "Start recording immediate"
Top = 120
Width = 975
End
Begin VB.Frame Frame5
Caption = "Starting position for play (in milliseconds)"
Height = 855
Left = 120
TabIndex = 9
Top = 720
Width = 4815
End
Begin VB.Timer Timer2
Interval = 200
Left = 5160
Top = 2400
End
Begin VB.Frame Frame4
Caption = "Statistics"
Height = 1815
Left = 120
TabIndex = 5
Top = 1680
Width = 4815
Begin VB.Label StatisticsLabel
BackColor = &H00000000&
Caption = " "
ForeColor = &H0000FF00&
Height = 1455
Left = 120
TabIndex = 6
ToolTipText = "Information about the recording"
Top = 240
Width = 4575
End
End
End
Attribute VB_Name = "AudioRecorder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
'_______________________________________________
frmSettings.frm formu;
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form AudioRecorder
BorderStyle = 1 'Fixed Single
Caption = "AudioRecorder"
ClientHeight = 3765
ClientLeft = 45
ClientTop = 330
ClientWidth = 7080
Icon = "frmAudioRecorder.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3765
ScaleWidth = 7080
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdSettings
Caption = "Settings"
Height = 495
Left = 5970
TabIndex = 10
ToolTipText = "Change rate, stereo/mono, 8/16 bits and program an automatic recording"
Top = 120
Width = 975
End
Begin MSComctlLib.Slider Slider1
Height = 375
Left = 240
TabIndex = 8
ToolTipText = "You can choose a beginning for playing the recording"
Top = 960
Width = 4575
_ExtentX = 8070
_ExtentY = 661
_Version = 393216
LargeChange = 500
SmallChange = 100
TickStyle = 3
End
Begin VB.CommandButton cmdWeb
Caption = "Web"
Height = 495
Left = 4995
TabIndex = 7
ToolTipText = "Visit the home page of me!! (Maybe a new version is available...)"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdReset
Caption = "Reset"
Height = 495
Left = 120
TabIndex = 4
ToolTipText = "To start a new recording and adjusting all settings"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 495
Left = 4020
TabIndex = 3
ToolTipText = "Save the recording as as WAV file"
Top = 120
Width = 975
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5760
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FileName = " "
Orientation = 2
End
Begin VB.CommandButton cmdPlay
Caption = "Play"
Enabled = 0 'False
Height = 495
Left = 3045
TabIndex = 2
ToolTipText = "Play the recording"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdStop
Caption = "Stop"
Enabled = 0 'False
Height = 495
Left = 2070
TabIndex = 1
ToolTipText = "Stop recording or playing"
Top = 120
Width = 975
End
Begin VB.CommandButton cmdRecord
Caption = "Record"
Height = 495
Left = 1095
TabIndex = 0
ToolTipText = "Start recording immediate"
Top = 120
Width = 975
End
Begin VB.Frame Frame5
Caption = "Starting position for play (in milliseconds)"
Height = 855
Left = 120
TabIndex = 9
Top = 720
Width = 4815
End
Begin VB.Timer Timer2
Interval = 200
Left = 5160
Top = 2400
End
Begin VB.Frame Frame4
Caption = "Statistics"
Height = 1815
Left = 120
TabIndex = 5
Top = 1680
Width = 4815
Begin VB.Label StatisticsLabel
BackColor = &H00000000&
Caption = " "
ForeColor = &H0000FF00&
Height = 1455
Left = 120
TabIndex = 6
ToolTipText = "Information about the recording"
Top = 240
Width = 4575
End
End
End
Attribute VB_Name = "AudioRecorder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
'___________________________________________
modShellExecute.bas modülü
Attribute VB_Name = "modShellExecute"
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
'_________________________________________________
modWave.bas modülü
Attribute VB_Name = "modWave"
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
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function FindFirstFile& Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA)
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Type FILETIME ' 8 Bytes
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA ' 318 Bytes
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved¯ As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Function FileExist(strFileName As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFirst As Long
hFindFirst = FindFirstFile(strFileName, lpFindFileData)
If hFindFirst > 0 Then
FindClose hFindFirst
FileExist = True
Else
FileExist = False
End If
End Function
Public Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetVal As Long, sShortPathName As String, iLen As Integer
'Set up buffer area for API function call return
sShortPathName = Space(255)
iLen = Len(sShortPathName)
'Call the function
lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
If lRetVal = 0 Then 'The file does not exist, first create it!
Open sLongFileName For Random As #1
Close #1
lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
'Now another try!
Kill (sLongFileName)
'Delete file now!
End If
'Strip away unwanted characters.
GetShortName = Left(sShortPathName, lRetVal)
End Function
Private Function Has_Space(sName As String) As Boolean
Dim b As Boolean
Dim i As Long
b = False 'not yet any spaces found
i = InStr(sName, " ")
If i <> 0 Then b = True
Has_Space = b
End Function
Public Sub WaveReset()
Dim rtn As String
Dim i As Long
rtn = Space$(260)
'Close any MCI operations from previous VB programs
i = mciSendString("close all", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Closing all MCI operations failed!")
'Open a new WAV with MCI Command...
i = mciSendString("open new type waveaudio alias capture", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Opening new wave failed!")
End Sub
Public Sub WaveSet()
Dim rtn As String
Dim i As Long
Dim settings As String
Dim Alignment As Integer
rtn = Space$(260)
Alignment = Channels * Resolution / 8
settings = "set capture alignment " & CStr(Alignment) & " bitspersample " & CStr(Resolution) & " samplespersec " & CStr(Rate) & " channels " & CStr(Channels) & " bytespersec " & CStr(Alignment * Rate)
'Samples Per Second that are supported:
'11025 low quality
'22050 medium quality
'44100 high quality (CD music quality)
'Bits per sample is 16 or 8
'Channels are 1 (mono) or 2 (stereo)
i = mciSendString("seek capture to start", rtn, Len(rtn), 0) 'Always start at the beginning
If i <> 0 Then MsgBox ("Starting recording failed!")
'You can use at least the following combinations
' i = mciSendString("set capture alignment 4 bitspersample 16 samplespersec 44100 channels 2 bytespersec 176400", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 16 samplespersec 44100 channels 1 bytespersec 88200", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 4 bitspersample 16 samplespersec 22050 channels 2 bytespersec 88200", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 16 samplespersec 22050 channels 1 bytespersec 44100", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 4 bitspersample 16 samplespersec 11025 channels 2 bytespersec 44100", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 16 samplespersec 11025 channels 1 bytespersec 22050", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 8 samplespersec 11025 channels 2 bytespersec 22050", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 1 bitspersample 8 samplespersec 11025 channels 1 bytespersec 11025", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 8 samplespersec 8000 channels 2 bytespersec 16000", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 1 bitspersample 8 samplespersec 8000 channels 1 bytespersec 8000", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 2 bitspersample 8 samplespersec 6000 channels 2 bytespersec 12000", rtn, Len(rtn), 0)
' i = mciSendString("set capture alignment 1 bitspersample 8 samplespersec 6000 channels 1 bytespersec 6000", rtn, Len(rtn), 0)
i = mciSendString(settings, rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Settings for recording not consistent")
' If the combination is not supported you get an error!
End Sub
Public Sub WaveRecord()
Dim rtn As String
Dim i As Long
Dim msg As String
rtn = Space$(260)
If WaveMidiFileName <> "" Then
If WaveRecordingImmediate Then MsgBox ("Midi file " & WaveMidiFileName & " will be recorded")
i = mciSendString("open " & WaveMidiFileName & " type sequencer alias midi", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Opening midi file failed!")
i = mciSendString("play midi", rtn, Len(rtn), 0) 'Start the recording
If i <> 0 Then MsgBox ("Playing midi file failed!")
End If
i = mciSendString("record capture", rtn, Len(rtn), 0) 'Start the recording
If i <> 0 Then MsgBox ("Recording not possible, please restart your computer...")
End Sub
Public Sub WaveSaveAs(sName As String)
Dim rtn As String
Dim i As Long
'If file already exists then remove it
If FileExist(sName) Then
Kill (sName)
End If
'The mciSendString API call doesn't seem to like'
'long filenames that have spaces in them, so we
'will make another API call to get the short
'filename version.
'This is accomplished by the function GetShortName
'MCI command to save the WAV file
If Has_Space(sName) Then
WaveShortFileName = GetShortName(sName)
WaveLongFileName = sName
WaveRenameNecessary = True
' These are necessary in order to be able to rename file
i = mciSendString("save capture " & WaveShortFileName, rtn, Len(rtn), 0)
Else
i = mciSendString("save capture " & sName, rtn, Len(rtn), 0)
End If
If i <> 0 Then MsgBox ("Saving file failed, file name was: " & sName)
End Sub
Public Sub WaveStop()
Dim rtn As String
Dim i As Long
i = mciSendString("stop capture", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Stopping recording failed!")
If WaveMidiFileName <> "" Then
i = mciSendString("stop midi", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Stopping playing midi file failed!")
End If
End Sub
Public Sub WavePlay()
Dim rtn As String
Dim i As Long
i = mciSendString("play capture from 0", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Start playing failed!")
End Sub
Public Sub WaveStatus()
Dim i As Long
WaveStatusMsg = Space(255)
i = mciSendString("status capture mode", WaveStatusMsg, 255, 0)
If i <> 0 Then MsgBox ("Failure getting wave status...")
WaveStatusMsg = "AudioRecorder: " & WaveStatusMsg
End Sub
Public Sub WaveStatistics()
Dim mssg As String * 255
Dim i As Long
i = mciSendString("set capture time format ms", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting time format in milliseconds failed!")
i = mciSendString("status capture length", mssg, 255, 0)
mssg = CStr(CLng(mssg) / 1000)
If i <> 0 Then MsgBox ("Finding length recording in milliseconds failed!")
WaveStatisticsMsg = "Length recording " & Str(mssg) & " s"
i = mciSendString("set capture time format bytes", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting time format in bytes failed!")
i = mciSendString("status capture length", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding length recording in bytes failed!")
WaveStatisticsMsg = WaveStatisticsMsg & " (" & Str(mssg) & " bytes)" & vbCrLf
i = mciSendString("status capture channels", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding number of channels failed!")
If Str(mssg) = 1 Then
WaveStatisticsMsg = WaveStatisticsMsg & "Mono - "
ElseIf Str(mssg) = 2 Then
WaveStatisticsMsg = WaveStatisticsMsg & "Stereo - "
End If
i = mciSendString("status capture bitspersample", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding resolution failed!")
WaveStatisticsMsg = WaveStatisticsMsg & Str(mssg) & " bits - "
i = mciSendString("status capture samplespersec", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding sample rate failed!")
WaveStatisticsMsg = WaveStatisticsMsg & Str(mssg) & " samples per second " & vbCrLf & vbCrLf
End Sub
Public Sub WaveClose()
Dim rtn As String
Dim i As Long
i = mciSendString("close capture", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Closing MCI failed!")
End Sub
Public Function WavePosition() As Long
Dim rtn As String
Dim i As Long
Dim pos As String
rtn = Space(255)
pos = Space(255)
i = mciSendString("set capture time format ms", rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Setting format in milliseconds failed!")
i = mciSendString("status capture position", pos, 255, 0)
If i <> 0 Then MsgBox ("Finding position failed!")
If i <> 0 Then MsgBox ("Error in position")
WavePosition = CLng(pos)
End Function
Public Sub WavePlayFrom(Position As Long)
Dim rtn As String
Dim i As Long
Dim pos As String
pos = CStr(Position)
i = mciSendString("set capture time format ms", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting format in milliseconds failed!")
i = mciSendString("play capture from " & pos, rtn, Len(rtn), 0)
If i <> 0 Then MsgBox ("Playing from indicated position failed!")
If i <> 0 Then MsgBox ("Play from position doesn't work....")
End Sub
' HER BÖLÜM '________ ŞEKLİNDE AYRILMIŞTIR.
' BU KODLARI NOTEPAD A KOPYALA YAPIŞTIR YAPIN VE
' BELİRTİLEN FORM YADA MODULE ADI İLE FARKLI KAYDET YAPIN.
' YENİ BİR PROJE AÇIN VE YUKARDAKİ İKİ FORM VE İKİ MODULU O PROJEYE EKLEYİN
|
|
