Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

pintercom.bas

Uploader:MitgliedThePuppetMaster
Datum/Zeit:21.08.2017 23:32:47

'(c) By.: Martin Wiemann (freebasic@deltalabs.de)



'###################################################################################################################################################
#include "bass.bi"
#include "bassmix.bi"



'###################################################################################################################################################
Const Const_SoundCardDevName as String = "C-Media USB Audio Device: USB Audio"      'Name of the USB-Soundcards for the Intercom
Const Const_MaxDevices as UByte = 8                                                 'Number of max USB-Soundcards to search for
Const Const_LocalEcho as Integer = 0                                                'Set to 1 if the Speaker will hear itself



'###################################################################################################################################################
Dim TDeviceT as BASS_DEVICEINFO
Dim X as Integer
Dim Y as Integer
Dim TName as Const ZString Ptr

Type DevInTyp
    V_DevID         as Integer
    V_DevKey        as String
    V_Chan          as HRECORD
    V_Spliter       as HSTREAM
    V_Split(1 to Const_MaxDevices)  as HSTREAM
End Type
Dim TDevInD(1 to Const_MaxDevices) as DevInTyp
Dim TDevInC as Integer



'###################################################################################################################################################
Type DevOutTyp
    V_DevID         as Integer
    V_DevKey        as String
    V_Chan          as HRECORD
    V_Mixer         as HSTREAM
End Type
Dim TDevOutD(1 to Const_MaxDevices) as DevOutTyp
Dim TDevOutC as Integer



'###################################################################################################################################################
Dim TFreq as Integer = 44100
Dim TChans as Integer = 1



'###################################################################################################################################################
Print "SEARCH Outputs..."
X = 0
Do
    X += 1
    If BASS_GetDeviceInfo(X, @TDeviceT) <> 1 Then Exit Do
    Print "Checking:" & X & " (" & *TDeviceT.name & ")(" & *TDeviceT.driver & ")"
    If *TDeviceT.name = Const_SoundCardDevName Then
        Print "FOUND!"
        TDevOutC += 1
        With TDevOutD(TDevOutC)
            .V_DevID = X
            .V_DevKey = *TDeviceT.driver
            If BASS_Init(X, 44100, 0, 0, 0) <> 1 Then Print "Can't BASS_Init:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            If BASS_SetDevice(.V_DevID) <> 1 Then Print "Can't BASS_SetDevice:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            If BASS_SetConfig(BASS_CONFIG_BUFFER, 50) <> 1 Then Print "Can't BASS_SetConfig(BASS_CONFIG_BUFFER):" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            If BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 5) <> 1 Then Print "Can't BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD):" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            If BASS_SetVolume(1) <> 1 Then Print "Can't BASS_SetVolume:" & TDevOutC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            .V_Mixer = BASS_Mixer_StreamCreate(TFreq, TChans, BASS_MIXER_NONSTOP)
            BASS_ChannelSetDevice(.V_Mixer, .V_DevID)
        End With
        If TDevOutC >= Const_MaxDevices Then Exit Do
    End If
Loop

'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "SEARCH Inputs..."
X = -1
Do
    X += 1
    If BASS_RecordGetDeviceInfo(X, @TDeviceT) <> 1 Then Exit Do
    Print "Checking:" & X & " (" & *TDeviceT.name & ")(" & *TDeviceT.driver & ")"
    If *TDeviceT.name = Const_SoundCardDevName Then
        Print "FOUND!"
        TDevInC += 1
        With TDevInD(TDevInC)
            .V_DevID = X
            .V_DevKey = *TDeviceT.driver
            If BASS_RecordInit(X) <> 1 Then Print "Can't BASS_RecordInit:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            If BASS_RecordSetDevice(.V_DevID) <> 1 Then Print "Can't BASS_RecordSetDevice:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            Y = -1
            Do
                Y += 1
                TName = BASS_RecordGetInputName(Y)
                If TName = 0 Then Exit Do
                Print "IN: " & *TName
                If *TName = "Mic" Then
                    If BASS_RecordSetInput(Y, BASS_INPUT_ON, 1) <> 1 Then Print "Can't BASS_RecordSetInput:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
                Else
                    If BASS_RecordSetInput(Y, BASS_INPUT_OFF, 0) <> 1 Then Print "Can't BASS_RecordSetInput:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
                End If
            Loop
            .V_Chan = BASS_RecordStart(TFreq, TChans, 0, 0, 0)
            If .V_Chan = 0 Then Print "Can't BASS_RecordStart:" & TDevInC: Print "ERR:" & BASS_ErrorGetCode(): End -1
            For Y = 1 to TDevOutC
                If (Const_LocalEcho = 1) or (TDevInD(TDevInC).V_DevKey <> TDevOutD(Y).V_DevKey) Then
                    .V_Split(Y) = BASS_Split_StreamCreate(.V_Chan, BASS_STREAM_DECODE, 0)
                    If .V_Split(Y) = 0 Then Print "Can't BASS_Split_StreamCreate:" & TDevInC & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
                    Print "SPLIT:" & .V_Split(Y)
                End If
            Next
        End With
        If TDevInC >= Const_MaxDevices Then Exit Do
    End If
Loop

'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "DEV-Out:" & TDevOutC
Print "DEV-In:" & TDevInC

'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "Linking Inputs to Outputs..."
For X = 1 to TDevOutC
    For Y = 1 to TDevInC
        If (Const_LocalEcho = 1) or TDevOutD(X).V_DevKey <> TDevInD(Y).V_DevKey Then
            If BASS_Mixer_StreamAddChannel(TDevOutD(X).V_Mixer, TDevInD(Y).V_Split(X), BASS_MIXER_NORAMPIN) <> 1 Then Print "Can't BASS_Mixer_StreamAddChannel:" & X & "-" & Y: Print "ERR:" & BASS_ErrorGetCode(): End -1
        End If
    Next
    BASS_ChannelPlay(TDevOutD(X).V_Mixer, 0)
Next

'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "PIntercom ready!"
Do Until InKey() = chr(27)
    Sleep 10, 1
Loop

'---------------------------------------------------------------------------------------------------------------------------------------------------
Print "Stopping PIntercom..."
For X = 1 to TDevInC
    BASS_StreamFree(TDevInD(X).V_Chan)
    BASS_RecordSetDevice(TDevInD(X).V_DevID)
    BASS_RecordFree()
Next
For X = 1 to TDevOutC
    BASS_SetDevice(TDevOutD(X).V_DevID)
    BASS_Free()
Next

'---------------------------------------------------------------------------------------------------------------------------------------------------
End