203 lines
6.4 KiB
Text
203 lines
6.4 KiB
Text
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 frmRecTest
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "BASS recording test"
|
|
ClientHeight = 990
|
|
ClientLeft = 600
|
|
ClientTop = 990
|
|
ClientWidth = 4965
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 990
|
|
ScaleWidth = 4965
|
|
StartUpPosition = 2 'CenterScreen
|
|
Begin MSComctlLib.Slider sldInputLevel
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 5
|
|
Top = 720
|
|
Width = 1455
|
|
_ExtentX = 2566
|
|
_ExtentY = 450
|
|
_Version = 393216
|
|
Max = 100
|
|
SelectRange = -1 'True
|
|
TickStyle = 3
|
|
End
|
|
Begin VB.ComboBox cmbInput
|
|
Height = 315
|
|
Left = 120
|
|
Style = 2 'Dropdown List
|
|
TabIndex = 3
|
|
Top = 160
|
|
Width = 1455
|
|
End
|
|
Begin MSComDlg.CommonDialog cmd
|
|
Left = 4440
|
|
Top = 480
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 393216
|
|
End
|
|
Begin VB.Timer tmrRecTest
|
|
Enabled = 0 'False
|
|
Interval = 200
|
|
Left = 3960
|
|
Top = 480
|
|
End
|
|
Begin VB.CommandButton btnSave
|
|
Caption = "Save"
|
|
Enabled = 0 'False
|
|
Height = 300
|
|
Left = 4080
|
|
TabIndex = 2
|
|
Top = 170
|
|
Width = 735
|
|
End
|
|
Begin VB.CommandButton btnPlay
|
|
Caption = "Play"
|
|
Enabled = 0 'False
|
|
Height = 300
|
|
Left = 3120
|
|
TabIndex = 1
|
|
Top = 170
|
|
Width = 855
|
|
End
|
|
Begin VB.CommandButton btnRecord
|
|
Caption = "Record"
|
|
Height = 300
|
|
Left = 1680
|
|
TabIndex = 0
|
|
Top = 170
|
|
Width = 1335
|
|
End
|
|
Begin VB.Label lblPos
|
|
Alignment = 2 'Center
|
|
BorderStyle = 1 'Fixed Single
|
|
Height = 285
|
|
Left = 1680
|
|
TabIndex = 6
|
|
Top = 600
|
|
Width = 3135
|
|
End
|
|
Begin VB.Label lblInputType
|
|
Alignment = 2 'Center
|
|
Height = 195
|
|
Left = 120
|
|
TabIndex = 4
|
|
Top = 480
|
|
Width = 1440
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmRecTest"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
'////////////////////////////////////////////////////////////////////////////////
|
|
' frmRecTest.frm - Copyright (c) 2002-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
|
' [http://www.jobnik.org]
|
|
' [ jobnik@jobnik.org ]
|
|
'
|
|
' Other source: modRecTest.bas
|
|
'
|
|
' BASS Recording example
|
|
' Originally translated from - rectest.c - Example of Ian Luck
|
|
'////////////////////////////////////////////////////////////////////////////////
|
|
|
|
Option Explicit
|
|
|
|
Private Sub Form_Load()
|
|
' change and set the current path, to prevent from VB not finding BASS.DLL
|
|
ChDrive App.Path
|
|
ChDir App.Path
|
|
|
|
' check the correct BASS was loaded
|
|
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
|
|
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
|
|
End
|
|
End If
|
|
|
|
' setup recording and output devices (using default devices)
|
|
If (BASS_RecordInit(-1) = 0) Or (BASS_Init(-1, 44100, 0, Me.hwnd, 0) = 0) Then
|
|
Call Error_("Can't initialize device")
|
|
End
|
|
Else
|
|
' get list of inputs
|
|
Dim c As Integer
|
|
input_ = -1
|
|
While BASS_RecordGetInputName(c)
|
|
cmbInput.AddItem VBStrFromAnsiPtr(BASS_RecordGetInputName(c))
|
|
If (BASS_RecordGetInput(c, ByVal 0) And BASS_INPUT_OFF) = 0 Then
|
|
cmbInput.ListIndex = c ' this 1 is currently "on"
|
|
input_ = c
|
|
Call UpdateInputInfo ' display info
|
|
End If
|
|
c = c + 1
|
|
Wend
|
|
End If
|
|
|
|
tmrRecTest.Enabled = True ' timer to update the position display (200ms)
|
|
|
|
recPtr = 0
|
|
reclen = 0
|
|
BUFSTEP = 200000 ' memory allocation unit
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
' release all BASS stuff
|
|
Call GlobalFree(ByVal recPtr)
|
|
Call BASS_RecordFree
|
|
Call BASS_Free
|
|
End Sub
|
|
|
|
' input selection changed
|
|
Private Sub cmbInput_Click()
|
|
input_ = cmbInput.ListIndex ' get the selection
|
|
' enable the selected input
|
|
Dim i As Integer
|
|
For i = 0 To cmbInput.ListCount - 1
|
|
Call BASS_RecordSetInput(i, BASS_INPUT_OFF, -1) ' 1st disable all inputs, then...
|
|
Next i
|
|
Call BASS_RecordSetInput(input_, BASS_INPUT_ON, -1) ' enable the selected input
|
|
Call UpdateInputInfo
|
|
End Sub
|
|
|
|
Private Sub btnPlay_Click()
|
|
Call BASS_ChannelPlay(chan, BASSFALSE) ' play the recorded data
|
|
End Sub
|
|
|
|
Private Sub btnRecord_Click()
|
|
If (rchan = 0) Then
|
|
Call StartRecording
|
|
Else
|
|
Call StopRecording
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnSave_Click()
|
|
Call WriteToDisk
|
|
End Sub
|
|
|
|
' set input source level
|
|
Private Sub sldInputLevel_Scroll()
|
|
If BASS_RecordSetInput(input_, 0, sldInputLevel.value / 100) = 0 Then ' failed to set input level
|
|
Call BASS_RecordSetInput(-1, 0, sldInputLevel.value / 100) ' try master level instead
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub tmrRecTest_Timer()
|
|
' update the recording/playback counter
|
|
If (rchan) Then ' recording/encoding
|
|
lblPos.Caption = BASS_ChannelGetPosition(rchan, BASS_POS_BYTE)
|
|
ElseIf (chan) Then
|
|
If (BASS_ChannelIsActive(chan)) Then ' playing
|
|
lblPos.Caption = BASS_ChannelGetPosition(chan, BASS_POS_BYTE) & " / " & BASS_ChannelGetLength(chan, BASS_POS_BYTE)
|
|
Else
|
|
lblPos.Caption = BASS_ChannelGetLength(chan, BASS_POS_BYTE)
|
|
End If
|
|
End If
|
|
End Sub
|