PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

[DONE]Sound output for externel Device

https://www.purebasic.fr/english/viewtopic.php?t=79723

Page 1 of 2

[DONE]Sound output for externel Device

Posted: Thu Aug 25, 2022 11:59 pm
by tft
I have a DUKABLE sound device for my USB port. I would now like to play an Ogg, MP3 or wave file over it. Anyone know how that works? I have to find the list of sound devices first, then select the right one and initiate a stream with an API command. But unfortunately I have no plan for something like that.

THX TFT

Re: [Help]Sound output for externel Device

Posted: Fri Aug 26, 2022 2:44 pm
by Mijikai
I tried but i failed :|

Not sure what is wrong, here is the code so far (Windows OS):

Code: Select all

EnableExplicit

Procedure.i audioDeviceQuery(*Device.Integer = #Null)
  Structure WAVEOUT_DEVICE_STRUCT
    id.i
    name.s
    string.s
  EndStructure
  Static NewList lst.WAVEOUT_DEVICE_STRUCT()
  Protected devices.i,id.i,siz.i,dc.WAVEOUTCAPS
  If *Device
    If ListSize(lst()) And *Device
      If NextElement(lst())
        *Device\i = @lst()
        ProcedureReturn #True
      EndIf  
      ResetList(lst())
    EndIf
    ProcedureReturn #False
  Else
    ClearList(lst())
    devices = waveOutGetNumDevs_()
    If devices
      devices - 1
      For id = 0 To devices
        If AddElement(lst())
          If waveOutGetDevCaps_(id,@dc,SizeOf(WAVEOUTCAPS)) = #MMSYSERR_NOERROR
            lst()\id = id
            lst()\name = PeekS(@dc\szPname)
            If waveOutMessage_(id,#DRV_RESERVED + 13,@siz,#Null) = #MMSYSERR_NOERROR;DRV_QUERYDEVICEINTERFACESIZE DRV_RESERVED + 13 ;https://docs.microsoft.com/en-us/previous-versions/windows/hardware/drivers/ff536364(v=vs.85) 
              lst()\string = Space(siz)
              If waveOutMessage_(id,#DRV_RESERVED + 12,@lst()\string,siz) <> #MMSYSERR_NOERROR;DRV_QUERYDEVICEINTERFACE DRV_RESERVED + 12 
                lst()\string = #Null$  
              EndIf  
            EndIf
          Else
            DeleteElement(lst())  
          EndIf
        EndIf
      Next
      ResetList(lst())
      ProcedureReturn ListSize(lst())
    EndIf
  EndIf
EndProcedure

Procedure.i audioDeviceSet(Id.i);<- does not work !?
  ProcedureReturn Bool(waveOutMessage_(#WAVE_MAPPER,$2000 + 22,Id,#Null) = #MMSYSERR_NOERROR);DRVM_MAPPER = $2000 / DRVM_MAPPER_PREFERRED_SET = DRVM_MAPPER + 22;https://docs.microsoft.com/en-us/previous-versions/aa909789(v=msdn.10)
EndProcedure

Procedure.i audioDeviceGet(*Id.Integer);<- does not work !?
  ProcedureReturn Bool(waveOutMessage_(#WAVE_MAPPER,$2000 + 21,*Id,#Null) = #MMSYSERR_NOERROR);DRVM_MAPPER = $2000 / DRVM_MAPPER_PREFERRED_GET = DRVM_MAPPER + 21
EndProcedure

Procedure.i Main()
  Protected *device.WAVEOUT_DEVICE_STRUCT
  If audioDeviceQuery();<- get all available output devices
    While audioDeviceQuery(@*device);<- get the device info
      Debug *device\id
      Debug *device\name
      Debug *device\string
    Wend
    If audioDeviceGet(@*device)
      Debug *device
    EndIf
  EndIf
  ProcedureReturn #Null
EndProcedure

Main()

End
[/code - pb]

Re: [Help]Sound output for externel Device

Posted: Fri Aug 26, 2022 4:29 pm
by morosh
found here in the forum, long time ago, not my work:

Code: Select all

Global MyOutDevs.WAVEOUTCAPS
Global MyInDevs.WAVEINCAPS

; Output device selection
NumOutDevs = waveOutGetNumDevs_()
If NumOutDevs
	For n = 0 To NumOutDevs - 1
		If waveOutGetDevCaps_(n,@MyOutDevs,SizeOf(WAVEOUTCAPS)) = 0
			Debug "out"+Str(n)+" : "+PeekS(@MyOutDevs\szPname)
		EndIf
	Next
EndIf

; Input device selection
NumInDevs = waveInGetNumDevs_()
If NumInDevs
	For n = 0 To NumInDevs - 1
		If waveInGetDevCaps_(n,@MyInDevs,SizeOf(WAVEINCAPS)) = 0
			Debug "in"+Str(n)+" : "+PeekS(@MyInDevs\szPname)
		EndIf
	Next
EndIf
HTH

Re: [Help]Sound output for externel Device

Posted: Fri Aug 26, 2022 5:08 pm
by tft
Hallo @Mijikai

Das ist schon mal ein Anfang. Aber leider funktioniert das so ja nicht.
Außerdem sieht es so aus. Als ob damit das Windows Device generell
gewechselt werden würde. Ich möchte aber System unabhängig
einen Sound auf einem der Device ausgeben.

That's a start. But unfortunately it doesn't work that way.
Besides, it looks like this. As if thereby the Windows device in general
would be changed. But I want system independent
output a sound on one of the devices.

THX

Hallo @ morosh

Warum ist der Device Name nur 31 Byte lang?
Also als Liste schon mal nicht schlecht.
Aber wie gebe ich jetzt damit einen Sound aus?
Die PureBasic eigenen Befehle sind da ja nicht
wirklich hilfreich.

Why is the device name only 31 bytes long?
So as a list, not bad.
But how do I output a sound with it now?
The PureBasic own commands are not there
really helpful.

THX

Re: [Help]Sound output for externel Device

Posted: Sat Aug 27, 2022 10:03 am
by morosh
I found two old snippets, unfortunately both not working, if someone could help here, I'm also interested:

#1:

Code: Select all

EnableExplicit

Structure SOUND_DEVICE_LIST
  szName.s
  iDevID.i
  nChannels.i
  iMfgrID.i
  iProdID.i
  szInterface.s
EndStructure


Structure RIFF_HEADER
  tag.c[4]
  iSize.l
  *pData.String
EndStructure

Structure PRIFF_HEADER
  *lpRIFF.RIFF_HEADER
EndStructure


Structure SOUND_STRUCT
  *pRawSound
  dwRawDataSize.l
  List pRiffs.PRIFF_HEADER()
  bIsLoop.b
  bIsPlaying.b
  wavefmt.WAVEFORMATEX
  whdr.WAVEHDR
  hwo.i
  nAudioDevice.i
  iMonitorThread.i
  iSignalByte.i
  iSemaphore.i
EndStructure

Global NewList active_sounds.SOUND_STRUCT()
Global SoundMgrMutex = CreateMutex()
Global defWaveOutput = #WAVE_MAPPER

Declare Get_Sound_Devices( List sd.SOUND_DEVICE_LIST() )

Procedure is_sound( *soundNumber )
  Define retVal.l
  retVal = #False
  LockMutex(SoundMgrMutex)
  ForEach active_sounds()
    If @active_sounds() = *soundNumber
      retVal = #True
      Break
    EndIf
  Next
  UnlockMutex(SoundMgrMutex)
  ProcedureReturn retVal
EndProcedure

Procedure Prep_Sound( *lpSoundStruct.SOUND_STRUCT )
  Define retVal.l, *ptr, ok_to_stop.b, *lpRIFF.RIFF_HEADER
  retVal = #False
  *ptr = *lpSoundStruct\pRawSound + 12
  While Not(ok_to_stop)
    *lpRIFF = *ptr
    Select PeekS(@*lpRIFF\tag[0], 4,#PB_Ascii)  ; changed by morosh
      Case "fmt "
        CopyStructure(@*lpRIFF\pData, @*lpSoundStruct\wavefmt, WAVEFORMATEX)
        *lpSoundStruct\wavefmt\cbSize = SizeOf(WAVEFORMATEX)
      Case "data"
        AddElement(*lpSoundStruct\pRiffs())
        *lpSoundStruct\pRiffs()\lpRIFF = *lpRIFF
      Case ""
        ok_to_stop = #True
    EndSelecta
    *ptr = @*lpRIFF\pData + *lpRIFF\iSize
  Wend
  If ListSize(*lpSoundStruct\pRiffs()) > 0
    retVal = #True
  EndIf
  ProcedureReturn retVal
EndProcedure

Procedure Load_Sound( szFileName.s )
  Define *retVal, myFile.l, myLof.l
  *retVal = 0
  myFile = OpenFile(#PB_Any, szFileName)
  If Not(IsFile(myFile))
    ProcedureReturn *retVal
  EndIf
  myLof = Lof(myFile)
  If mylof = 0
    CloseFile(myFile)
    ProcedureReturn *retVal
  EndIf
  LockMutex(SoundMgrMutex)
  AddElement(active_sounds())
  active_sounds()\pRawSound = AllocateMemory(mylof)
  ReadData(myFile, active_sounds()\pRawSound, mylof)
  CloseFile(myFile)
  If Not(Prep_Sound(@active_sounds()))
    FreeMemory(active_sounds()\pRawSound)
    DeleteElement(active_sounds())
  Else
    active_sounds()\nAudioDevice = defWaveOutput
    *retVal = @active_sounds()
  EndIf
  UnlockMutex(SoundMgrMutex)
  ProcedureReturn *retVal
EndProcedure

Procedure Set_Default_Audio_Device( nDefaultDevice ) ; Returns previous audio device, or NULL on failure.
  Define retVal.l
  retVal = defWaveOutput
  defWaveOutput = nDefaultDevice
  ProcedureReturn retVal
EndProcedure

 
Procedure Is_Sound_Device_Good( nSoundDevice )
  Define retVal.l
  retVal = #False
  NewList sd.SOUND_DEVICE_LIST()
  If Get_Sound_Devices(sd()) > 0
    ForEach sd()
      If sd()\iDevID = nSoundDevice
        retVal = #True
        Break
      EndIf
    Next
  EndIf
  ProcedureReturn retVal
EndProcedure


Procedure Catch_Sound( *lpAddr )
EndProcedure

Procedure Free_Sound( *soundNumber )
  If is_sound(*soundNumber)
    LockMutex(SoundMgrMutex)
    ChangeCurrentElement(active_sounds(), *soundNumber)
    FreeMemory(active_sounds()\pRawSound)
    ClearList(active_sounds()\pRiffs())
    If active_sounds()\bIsLoop = #True
      active_sounds()\iSignalByte = -1
      SignalSemaphore(active_sounds()\iSemaphore)
    EndIf
    While IsThread(active_sounds()\iMonitorThread)
      Delay(100)
    Wend
    DeleteElement(active_sounds())
    UnlockMutex(SoundMgrMutex)
  Else
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure


Procedure Wave_Output_CallBack( hwo, uMsg, *lpSoundStruct.SOUND_STRUCT, dwParam1, dwParam2 )
  Static whdr.WAVEHDR

  Select uMsg
    Case #WOM_OPEN
    Case #WOM_DONE
      If *lpSoundStruct\bIsPlaying = #True
        If *lpSoundStruct\bIsLoop = #True
          *lpSoundStruct\iSignalByte = 1
          SignalSemaphore(*lpSoundStruct\iSemaphore)
        EndIf
      EndIf
    Case #WOM_CLOSE
      *lpSoundStruct\bIsPlaying = #False
     
     
  EndSelect
 
EndProcedure

Procedure Is_Sound_Playing( *soundNumber )
  Define *lpSoundStruct.SOUND_STRUCT, retVal.l
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  retVal = *lpSoundStruct\bIsPlaying
  ProcedureReturn retVal
EndProcedure


Procedure stop_sound( *soundNumber )
  Define *lpSoundStruct.SOUND_STRUCT
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  *lpSoundStruct\bIsPlaying = #False
  waveOutReset_(*lpSoundStruct\hwo)
  waveOutClose_(*lpSoundStruct\hwo)
  If *lpSoundStruct\bIsLoop = #True
    *lpSoundStruct\iSignalByte = -1
    SignalSemaphore(*lpSoundStruct\iSemaphore)
  EndIf
  While IsThread(*lpSoundStruct\iMonitorThread)
    Delay(100)
  Wend
  ProcedureReturn 0
EndProcedure

Procedure Monitor_Sound_Thread( *lpSoundStruct.SOUND_STRUCT )
  While *lpSoundStruct\iSignalByte <> -1
    WaitSemaphore(*lpSoundStruct\iSemaphore)
    Select *lpSoundStruct\iSignalByte
      Case 1
        Debug "Repeat sound!"
      Case -1
       
        Break
    EndSelect
  Wend
  ProcedureReturn #Null
EndProcedure


Procedure Play_Sound( *soundNumber, bLoopSound = #False, nSoundDevice = -1 ) ;Returns -1 for bad sound device.
  Define retVal.l, *lpSoundStruct.SOUND_STRUCT, mmResult.l
  retVal = #False
  If Not(is_sound(*soundNumber))
    ProcedureReturn retVal
  EndIf
  *lpSoundStruct = *soundNumber
  ChangeCurrentElement(active_sounds(), *soundNumber)
  If nSoundDevice = -1
    nSoundDevice = *lpSoundStruct\nAudioDevice
  EndIf
 
  If (nSoundDevice = #WAVE_MAPPER Or Is_Sound_Device_Good(nSoundDevice))
    mmResult = waveOutOpen_(@*lpSoundStruct\hwo, nSoundDevice, @*lpSoundStruct\wavefmt, @Wave_Output_CallBack(), *soundNumber, #CALLBACK_FUNCTION)
    If mmResult = #MMSYSERR_NOERROR
      If bLoopSound = #True
        *lpSoundStruct\bIsLoop = #True
        *lpSoundStruct\iSignalByte = 0
        *lpSoundStruct\iSemaphore = CreateSemaphore(0)
        *lpSoundStruct\iMonitorThread = CreateThread(@Monitor_Sound_Thread(), *lpSoundStruct)
      EndIf
     
      If FirstElement(*lpSoundStruct\pRiffs())
        *lpSoundStruct\whdr\dwBufferLength = *lpSoundStruct\pRiffs()\lpRIFF\iSize
        *lpSoundStruct\whdr\lpData = @*lpSoundStruct\pRiffs()\lpRIFF\pData
        waveOutPrepareHeader_(*lpSoundStruct\hwo, @*lpSoundStruct\whdr, SizeOf(WAVEHDR))
        waveOutWrite_(*lpSoundStruct\hwo, @*lpSoundStruct\whdr, SizeOf(WAVEHDR))
        *lpSoundStruct\bIsPlaying = #True
      EndIf
      retVal = #True
    Else
      Debug "Failed!"
    EndIf
  Else
    retVal = -1
  EndIf
  ProcedureReturn retVal
EndProcedure

Enumeration
  #VOLUME_MUTE = 0
  #VOLUME_LOW = 50
  #VOLUME_MID = $7FFF
  #VOLUME_HIGH = 200
  #VOLUME_LOUD = $FFFF
EndEnumeration


Procedure Get_Sound_Devices( List sd.SOUND_DEVICE_LIST() )
  Define numDevs.l, i.l, woc.WAVEOUTCAPS, mySize.l, myValue.s, myString.s, j.l, mychar.b
  numDevs = waveOutGetNumDevs_()
  ClearList(sd())
  If numDevs > 0
    For i = 0 To (numDevs - 1)
      If waveOutGetDevCaps_(i, @woc, SizeOf(WAVEOUTCAPS)) = #MMSYSERR_NOERROR
        AddElement(sd())
        sd()\szName = PeekS(@woc\szPname[0])
        sd()\iDevID = i
        sd()\nChannels = woc\wChannels
        sd()\iMfgrID = woc\wMid
        sd()\iProdID = woc\wPid
        mySize = 400
        myValue = Space(mySize)
        myString = ""
        If waveOutMessage_(i, #DRV_RESERVED + 12, @myValue, mySize) = #MMSYSERR_NOERROR
         
          ;- Change unicode string to Ascii
         
          For j = 0 To 399
            mychar = PeekB(@myValue + j)
            If mychar = 0
              If PeekB(@myValue + j + 1) = 0
                Break
              EndIf
            Else
              myString.s + Chr(mychar)
            EndIf
          Next
         
        EndIf
        sd()\szInterface = myString
      EndIf
    Next
  EndIf
  ProcedureReturn ListSize(sd())
EndProcedure
 

Procedure set_sound_volume( *soundNumber, volume )
  Define *lpSoundStruct.SOUND_STRUCT, iVolume.l
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  iVolume = 0
  waveOutGetVolume_(*lpSoundStruct\hwo, @iVolume)
  waveOutSetVolume_(*lpSoundStruct\hwo, volume)
  ProcedureReturn iVolume
EndProcedure

Define mySound.l, dwEvent.l

mySound = Load_Sound("E:\my_data\sound\polmor.wav")   ; put your file here
If is_sound(mySound)
  OpenWindow(1, 0, 0, 500, 500, "Waiting", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  ButtonGadget(1, 10, 10, 100, 20, "Stop")
  NewList sdevs.SOUND_DEVICE_LIST()
  Play_Sound(mySound, #True, 0)
  set_sound_volume(mySound, #VOLUME_LOUD)
  Repeat
    dwEvent = WaitWindowEvent()
    Select dwEvent
      Case #PB_Event_Gadget
        If EventGadget() = 1
          If EventType() = #PB_EventType_LeftClick
            If Is_Sound_Playing(mySound)
              stop_sound(mySound)
            EndIf
          EndIf
        EndIf
    EndSelect
   
  Until dwEvent = #PB_Event_CloseWindow
  CloseWindow(1)
  If Is_Sound_Playing(mySound)
    stop_sound(mySound)
  EndIf
 
  Free_Sound(mySound)
Else
  Debug "Sound Bad!"
EndIf
#2:

Code: Select all

EnableExplicit
;/
    ;/ Object     Audio player 1.0 (a)
    ;/
    ;/ Date       August 2004
    ;/ Author     Philippe Carpentier
    ;/ Contact    flype@altern.org
    ;/ Info       MS Windows only - winmm.lib - mmsystem.h
    ;/
    ;  Bug fixes by chris319 on September 2, 2007
    ;  04/02/2010 : DrGolf for PB 4.50
    ;  01/20/2011 : Vitor_Boss® -- Fixed clamping
    ;  6/8/2012 -- revised again by chris319 on PB 4.61
    ;   modified
    
;Structure WAVEFORMATEX -- NOT NEEDED IN PB 4.10 -- chris319
;  wFormatTag.w
;  nChannels.w
;  nSamplesPerSec.l
;  nAvgBytesPerSec.l
;  nBlockAlign.w
;  wBitsPerSample.w
;  cbSize.w
;EndStructure


#MONO = 1
#STEREO = 2
#Button =0

Global QuitRec.l
Global lBuf.l, nBuf.l, nDev.l, fname.s, format.WAVEFORMATEX,  hWindow.l, FileId.l 
Global size.l, buffer.l, output.l, wave.l, played.l ,playing.b
Global Dim outHdr.WAVEHDR(16)

Declare PLAY_Stop()
Declare PLAY_Start()
Declare PLAY_GetDevices()
Declare PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
Declare FILE_Close()
Declare FILE_Open()
Declare FILE_wav2raw(fname.s)

Declare GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)

Procedure.s chtostr(ch.a)
Protected tmp.s{3}, ch1.a

ch1=((ch & $F0) >> 4)+48
If ch1 > 57
  ch1+7
EndIf
PokeB(@tmp,ch1)

ch1=(ch & $0F)+48
If ch1 > 57
  ch1+7
EndIf
PokeB(@tmp+1,ch1)
PokeB(@tmp+2,0)
;Debug tmp
ProcedureReturn tmp
EndProcedure

Procedure.s getfiledatastr(nof.a, offset.u, len.a)
Protected tmp.s{100}, ch.a, i.a

tmp=""
FileSeek(nof,offset)
For i=1 To len
  ReadData(nof, @ch, 1)
  tmp=tmp+Chr(ch)
Next
tmp="$"+tmp
;Debug "tmp="+tmp+"="+Val(tmp)
ProcedureReturn tmp
EndProcedure

Procedure.l getfiledatanum(nof.a, offset.u, len.a)
Protected tmp.s{100}, ch.a, i.a

tmp=""
FileSeek(nof,offset)
For i=1 To len
  ReadData(nof, @ch, 1)
    tmp=chtostr(ch)+tmp
Next
tmp="$"+tmp
;Debug "tmp="+tmp+"="+Val(tmp)
ProcedureReturn Val(tmp)
EndProcedure

Procedure PLAY_Start()
Define i.a

format\wFormatTag = getfiledatanum(0,20,2)
format\nChannels = getfiledatanum(0,22,2)
format\nSamplesPerSec = getfiledatanum(0,24,4)
format\wBitsPerSample = getfiledatanum(0,34,2)
  
FileSeek(0,58)
PLAY_Stop()
format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8
format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign
format\cbSize = 0
 
If waveOutOpen_(@wave,nDev,@format,hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT) = #MMSYSERR_NOERROR
  For i = 0 To nBuf - 1
    outHdr(i)\lpData = AllocateMemory(lBuf)
    outHdr(i)\dwBufferLength = lBuf
    waveOutPrepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
    waveOutWrite_(wave,outHdr(i),SizeOf(WAVEHDR))
  Next

  If waveOutReset_(wave) <> #MMSYSERR_NOERROR
    MessageRequester("Error","waveOutStart_(wave)",#MB_ICONERROR)
    QuitRec=1
  EndIf
Else
  MessageRequester("Error","waveOutOpen_ failed",#MB_ICONERROR)
  QuitRec=1  
EndIf 
EndProcedure
    ;
Procedure PLAY_Stop()
  Define i.a
  
  If wave
  waveOutReset_(wave)
 ; waveOutStop_(wave)
  For i = 0 To nBuf - 1
    If outHdr(i)
      waveOutUnprepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
    EndIf
  Next
  waveOutClose_(wave)
EndIf
EndProcedure
    ;
Procedure PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
;  Define *hWave.WAVEHDR
  
;*hWave=lpWaveHdr
buffer=*hWave\lpData
size=*hWave\dwBufferLength

If playing = #True
  ReadData(FileId, buffer,size)
  played + size
EndIf

waveOutWrite_(hwaveOut,*hWave,SizeOf(WAVEHDR))
;Beep_(100,100)
EndProcedure
    ;
Procedure PLAY_GetDevices()
  Define MMNumDevice.l, MMDeviceId.l, MMResult.l, Caps.waveOutCAPS
  
  MMNumDevice = waveOutGetNumDevs_()
  If MMNumDevice
    For MMDeviceId=#WAVE_MAPPER To MMNumDevice-1
      MMResult.l = waveOutGetDevCaps_(MMDeviceId,@Caps,SizeOf(waveOutCAPS))
      If MMResult = #MMSYSERR_NOERROR
         Debug Str(MMDeviceId) + "  " + PeekS(@Caps\szPname,#MAXPNAMELEN)
        ; AddGadgetItem(gadId,-1,PeekS(@Caps\szPname,#MAXPNAMELEN))
      EndIf
    Next
  EndIf
EndProcedure
 
Procedure FILE_Open()
FILE_wav2raw(fname)
  
played  = #Null ; -- MOVED HERE BY chris319
FileId=ReadFile(0,fname)
If FileId
  playing=#True
Else
  MessageRequester("Error","Can't create file",#MB_ICONERROR)
EndIf 
EndProcedure

Procedure FILE_Close()
If playing
  playing = #False
  CloseFile(FileId)
  Delay(1000)
EndIf
EndProcedure

Procedure FILE_wav2raw(fname.s)
Define inId.l, outId.l, pBuf.l, subchunk2size.l, chunksize.l, f$, x$, b.w, c.w, h.l
inId = ReadFile(#PB_Any,fname)

If inId = #Null
  MessageRequester("Error", "Unable to open file",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

lBuf.l = Lof(inId)
If lBuf = #Null
  MessageRequester("Error", "lbuf=0",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

pBuf = AllocateMemory(lBuf)
If pBuf = #Null
  MessageRequester("Error", "Unable to allocate buffer",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

ReadData(inId, pBuf,lBuf)
CloseFile(inId)

f$ = GetFilePart(fname)
x$ = GetPathPart(fname)+Left(f$,Len(f$)-Len(GetExtensionPart(fname))-1)+".raw"

outId = CreateFile(#PB_Any,x$)
If outId = #Null
  MessageRequester("Error", "Unable to create file",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf
WriteData(outId, pBuf+58,lBuf-58)

CloseFile(outId)
FreeMemory(pBuf) ;chris319
ProcedureReturn #True
EndProcedure
        ;
Procedure GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
  Define Result.l
  
Result = #PB_ProcessPureBasicEvents
Select Msg
  Case #WM_KEYDOWN
    If GetAsyncKeyState_(#VK_ESCAPE)
      QuitRec = 1
    EndIf
  Case #MM_WOM_DONE
    PLAY_Write(wParam,lParam)

  Case #WM_COMMAND
    Select wParam & $FFFF
      Case #Button      
        FILE_Open() : PLAY_Start()
      Case #Button+1    
        FILE_Close() : QuitRec=1
  EndSelect
EndSelect
ProcedureReturn Result     
EndProcedure
    ;
    ;- REC MAIN
;;;;;;;;;;;;;;;;;;;;;;;;;;;GUI_init ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QuitRec = 0
fname = "E:\my_data\sound\polmor.wav"
nDev = 0
nBuf = 8
lBuf = 2048

hWindow=OpenWindow(0,0,0,500,400,"Player",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
LoadFont(0, "Arial", 12)
ButtonGadget(#Button, 50,50,100,20,"Start")
ButtonGadget(#Button+1, 200,50,100,20,"Stop")
SetGadgetFont(#Button, FontID(0)) 
SetGadgetFont(#Button+1, FontID(0)) 

PLAY_GetDevices()
SetWindowCallback(@GUI_CallBack())
playing = #False

FILE_Open()
PLAY_Start()
Repeat
Until WaitWindowEvent() = #WM_CLOSE Or QuitRec
PLAY_Stop()

;  Devices
;-1  Microsoft Sound Mapper
;0  Speakers (Realtek High Definiti
;1  Realtek Digital Output (Realtek
;2  Speakers (Bluetooth AV Audio)
;3  Speakers (Bluetooth SCO Audio)
between time, string size has changed, may be it's related

Re: [Help]Sound output for externel Device

Posted: Sat Aug 27, 2022 1:43 pm
by tft
THX

i am working hard ........ to run it.

Re: [Help]Sound output for externel Device

Posted: Sat Aug 27, 2022 3:15 pm
by morosh
After investigating for a while, I succeed running the first snippet, but couldn't test it on multiple device as I've only the default speakers, could you test please?

Code: Select all

EnableExplicit

Structure SOUND_DEVICE_LIST
  szName.s
  iDevID.i
  nChannels.i
  iMfgrID.i
  iProdID.i
  szInterface.s
EndStructure


Structure RIFF_HEADER
  tag.b[4]    ;  changed by morosh
  iSize.l
  *pData.String
EndStructure

Structure PRIFF_HEADER
  *lpRIFF.RIFF_HEADER
EndStructure


Structure SOUND_STRUCT
  *pRawSound
  dwRawDataSize.l
  List pRiffs.PRIFF_HEADER()
  bIsLoop.b
  bIsPlaying.b
  wavefmt.WAVEFORMATEX
  whdr.WAVEHDR
  hwo.i
  nAudioDevice.i
  iMonitorThread.i
  iSignalByte.i
  iSemaphore.i
EndStructure

Global NewList active_sounds.SOUND_STRUCT()
Global SoundMgrMutex = CreateMutex()
Global defWaveOutput = #WAVE_MAPPER

Declare Get_Sound_Devices( List sd.SOUND_DEVICE_LIST() )

Procedure is_sound( *soundNumber )
  Define retVal.l
  retVal = #False
  LockMutex(SoundMgrMutex)
  ForEach active_sounds()
    If @active_sounds() = *soundNumber
      retVal = #True
      Break
    EndIf
  Next
  UnlockMutex(SoundMgrMutex)
  ProcedureReturn retVal
EndProcedure

Procedure Prep_Sound( *lpSoundStruct.SOUND_STRUCT )
  Define retVal.l, *ptr, ok_to_stop.b, *lpRIFF.RIFF_HEADER
  retVal = #False
  *ptr = *lpSoundStruct\pRawSound + 12
  While Not(ok_to_stop)
    *lpRIFF = *ptr
    ;ShowMemoryViewer(*ptr, 100)
    Select PeekS(@*lpRIFF\tag[0], 4,#PB_Ascii)  ; changed by morosh
      Case "fmt "
        CopyStructure(@*lpRIFF\pData, @*lpSoundStruct\wavefmt, WAVEFORMATEX)
        *lpSoundStruct\wavefmt\cbSize = SizeOf(WAVEFORMATEX)
      Case "data"
        AddElement(*lpSoundStruct\pRiffs())
        *lpSoundStruct\pRiffs()\lpRIFF = *lpRIFF
        ;Case ""    ;  changed by morosh
      Default
        ok_to_stop = #True
    EndSelect
    *ptr = @*lpRIFF\pData + *lpRIFF\iSize
  Wend
  If ListSize(*lpSoundStruct\pRiffs()) > 0
    retVal = #True
  EndIf
  ProcedureReturn retVal
EndProcedure

Procedure Load_Sound( szFileName.s )
  Define *retVal, myFile.l, myLof.l
  *retVal = 0
  myFile = OpenFile(#PB_Any, szFileName)
  If Not(IsFile(myFile))
    ProcedureReturn *retVal
  EndIf
  myLof = Lof(myFile)
  If mylof = 0
    CloseFile(myFile)
    ProcedureReturn *retVal
  EndIf
  LockMutex(SoundMgrMutex)
  AddElement(active_sounds())
  active_sounds()\pRawSound = AllocateMemory(mylof)
  ReadData(myFile, active_sounds()\pRawSound, mylof)
  CloseFile(myFile)
  If Not(Prep_Sound(@active_sounds()))
    FreeMemory(active_sounds()\pRawSound)
    DeleteElement(active_sounds())
  Else
    active_sounds()\nAudioDevice = defWaveOutput
    *retVal = @active_sounds()
  EndIf
  UnlockMutex(SoundMgrMutex)
  ProcedureReturn *retVal
EndProcedure

Procedure Set_Default_Audio_Device( nDefaultDevice ) ; Returns previous audio device, or NULL on failure.
  Define retVal.l
  retVal = defWaveOutput
  defWaveOutput = nDefaultDevice
  ProcedureReturn retVal
EndProcedure


Procedure Is_Sound_Device_Good( nSoundDevice )
  Define retVal.l
  retVal = #False
  NewList sd.SOUND_DEVICE_LIST()
  If Get_Sound_Devices(sd()) > 0
    ForEach sd()
      If sd()\iDevID = nSoundDevice
        retVal = #True
        Break
      EndIf
    Next
  EndIf
  ProcedureReturn retVal
EndProcedure


Procedure Catch_Sound( *lpAddr )
EndProcedure

Procedure Free_Sound( *soundNumber )
  If is_sound(*soundNumber)
    LockMutex(SoundMgrMutex)
    ChangeCurrentElement(active_sounds(), *soundNumber)
    FreeMemory(active_sounds()\pRawSound)
    ClearList(active_sounds()\pRiffs())
    If active_sounds()\bIsLoop = #True
      active_sounds()\iSignalByte = -1
      SignalSemaphore(active_sounds()\iSemaphore)
    EndIf
    While IsThread(active_sounds()\iMonitorThread)
      Delay(100)
    Wend
    DeleteElement(active_sounds())
    UnlockMutex(SoundMgrMutex)
  Else
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure


Procedure Wave_Output_CallBack( hwo, uMsg, *lpSoundStruct.SOUND_STRUCT, dwParam1, dwParam2 )
  Static whdr.WAVEHDR
  
  Select uMsg
    Case #WOM_OPEN
    Case #WOM_DONE
      If *lpSoundStruct\bIsPlaying = #True
        If *lpSoundStruct\bIsLoop = #True
          *lpSoundStruct\iSignalByte = 1
          SignalSemaphore(*lpSoundStruct\iSemaphore)
        EndIf
      EndIf
    Case #WOM_CLOSE
      *lpSoundStruct\bIsPlaying = #False
      
      
  EndSelect
  
EndProcedure

Procedure Is_Sound_Playing( *soundNumber )
  Define *lpSoundStruct.SOUND_STRUCT, retVal.l
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  retVal = *lpSoundStruct\bIsPlaying
  ProcedureReturn retVal
EndProcedure


Procedure stop_sound( *soundNumber )
  Define *lpSoundStruct.SOUND_STRUCT
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  *lpSoundStruct\bIsPlaying = #False
  waveOutReset_(*lpSoundStruct\hwo)
  waveOutClose_(*lpSoundStruct\hwo)
  If *lpSoundStruct\bIsLoop = #True
    *lpSoundStruct\iSignalByte = -1
    SignalSemaphore(*lpSoundStruct\iSemaphore)
  EndIf
  While IsThread(*lpSoundStruct\iMonitorThread)
    Delay(100)
  Wend
  ProcedureReturn 0
EndProcedure

Procedure Monitor_Sound_Thread( *lpSoundStruct.SOUND_STRUCT )
  While *lpSoundStruct\iSignalByte <> -1
    WaitSemaphore(*lpSoundStruct\iSemaphore)
    Select *lpSoundStruct\iSignalByte
      Case 1
        Debug "Repeat sound!"
      Case -1
        
        Break
    EndSelect
  Wend
  ProcedureReturn #Null
EndProcedure


Procedure Play_Sound( *soundNumber, bLoopSound = #False, nSoundDevice = -1 ) ;Returns -1 for bad sound device.
  Define retVal.l, *lpSoundStruct.SOUND_STRUCT, mmResult.l
  retVal = #False
  If Not(is_sound(*soundNumber))
    ProcedureReturn retVal
  EndIf
  *lpSoundStruct = *soundNumber
  ChangeCurrentElement(active_sounds(), *soundNumber)
  If nSoundDevice = -1
    nSoundDevice = *lpSoundStruct\nAudioDevice
  EndIf
  
  If (nSoundDevice = #WAVE_MAPPER Or Is_Sound_Device_Good(nSoundDevice))
    mmResult = waveOutOpen_(@*lpSoundStruct\hwo, nSoundDevice, @*lpSoundStruct\wavefmt, @Wave_Output_CallBack(), *soundNumber, #CALLBACK_FUNCTION)
    If mmResult = #MMSYSERR_NOERROR
      If bLoopSound = #True
        *lpSoundStruct\bIsLoop = #True
        *lpSoundStruct\iSignalByte = 0
        *lpSoundStruct\iSemaphore = CreateSemaphore(0)
        *lpSoundStruct\iMonitorThread = CreateThread(@Monitor_Sound_Thread(), *lpSoundStruct)
      EndIf
      
      If FirstElement(*lpSoundStruct\pRiffs())
        *lpSoundStruct\whdr\dwBufferLength = *lpSoundStruct\pRiffs()\lpRIFF\iSize
        *lpSoundStruct\whdr\lpData = @*lpSoundStruct\pRiffs()\lpRIFF\pData
        waveOutPrepareHeader_(*lpSoundStruct\hwo, @*lpSoundStruct\whdr, SizeOf(WAVEHDR))
        waveOutWrite_(*lpSoundStruct\hwo, @*lpSoundStruct\whdr, SizeOf(WAVEHDR))
        *lpSoundStruct\bIsPlaying = #True
      EndIf
      retVal = #True
    Else
      Debug "Failed!"
    EndIf
  Else
    retVal = -1
  EndIf
  ProcedureReturn retVal
EndProcedure

Enumeration
  #VOLUME_MUTE = 0
  #VOLUME_LOW = 50
  #VOLUME_MID = $7FFF
  #VOLUME_HIGH = 200
  #VOLUME_LOUD = $FFFF
EndEnumeration


Procedure Get_Sound_Devices( List sd.SOUND_DEVICE_LIST() )
  Define numDevs.l, i.l, woc.WAVEOUTCAPS, mySize.l, myValue.s, myString.s, j.l, mychar.b
  numDevs = waveOutGetNumDevs_()
  ClearList(sd())
  If numDevs > 0
    For i = 0 To (numDevs - 1)
      If waveOutGetDevCaps_(i, @woc, SizeOf(WAVEOUTCAPS)) = #MMSYSERR_NOERROR
        AddElement(sd())
        sd()\szName = PeekS(@woc\szPname[0])
        Debug Str(i)+ " : " +sd()\szName
        sd()\iDevID = i
        sd()\nChannels = woc\wChannels
        sd()\iMfgrID = woc\wMid
        sd()\iProdID = woc\wPid
        mySize = 400
        myValue = Space(mySize)
        myString = ""
        If waveOutMessage_(i, #DRV_RESERVED + 12, @myValue, mySize) = #MMSYSERR_NOERROR
          
          ;- Change unicode string to Ascii
          
          For j = 0 To 399
            mychar = PeekB(@myValue + j)
            If mychar = 0
              If PeekB(@myValue + j + 1) = 0
                Break
              EndIf
            Else
              myString.s + Chr(mychar)
            EndIf
          Next
          
        EndIf
        sd()\szInterface = myString
      EndIf
    Next
  EndIf
  ProcedureReturn ListSize(sd())
EndProcedure


Procedure set_sound_volume( *soundNumber, volume )
  Define *lpSoundStruct.SOUND_STRUCT, iVolume.l
  If Not(is_sound(*soundNumber))
    ProcedureReturn #False
  EndIf
  *lpSoundStruct = *soundNumber
  iVolume = 0
  waveOutGetVolume_(*lpSoundStruct\hwo, @iVolume)
  waveOutSetVolume_(*lpSoundStruct\hwo, volume)
  ProcedureReturn iVolume
EndProcedure

Define mySound.l, dwEvent.l

mySound = Load_Sound("E:\my_data\sound\polmor.wav")   ; put your file here
If is_sound(mySound)
  OpenWindow(1, 0, 0, 500, 500, "Waiting", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  ButtonGadget(1, 10, 10, 100, 20, "Stop")
  ButtonGadget(2, 150, 10, 100, 20, "Play")
  NewList sdevs.SOUND_DEVICE_LIST()
  Play_Sound(mySound, #True, 0)
  set_sound_volume(mySound, #VOLUME_LOUD)
  Repeat
    dwEvent = WaitWindowEvent()
    Select dwEvent
      Case #PB_Event_Gadget
        If EventGadget() = 1
          If Is_Sound_Playing(mySound)
            stop_sound(mySound)
          EndIf
        ElseIf EventGadget() = 2
          Play_Sound(mySound, #True, 0)
        EndIf
    EndSelect
    
  Until dwEvent = #PB_Event_CloseWindow
  CloseWindow(1)
  If Is_Sound_Playing(mySound)
    stop_sound(mySound)
  EndIf
  
  Free_Sound(mySound)
Else
  Debug "Sound Bad!"
EndIf

Re: [Help]Sound output for externel Device

Posted: Sat Aug 27, 2022 3:44 pm
by tft
hallo,

i am modify this

Code: Select all

Define file.s = OpenFileRequester("Load .Wav", "", ".wav", 1 )
mySound = Load_Sound(file.s)   ; put your file here
and the standart output ist work. I am testing it with the ather devices.

Re: [Help]Sound output for externel Device

Posted: Sat Aug 27, 2022 3:50 pm
by tft
Hallo ...

it works fine already. Unfortunately, the sound is only played in stereo with the standard device.

THX TFT

Re: [Help]Sound output for externel Device

Posted: Sun Aug 28, 2022 3:50 pm
by morosh
I succeed also to run the second snippet, if anyone interested:

Code: Select all

EnableExplicit
;/
    ;/ Object     Audio player 1.0 (a)
    ;/
    ;/ Date       August 2004
    ;/ Author     Philippe Carpentier
    ;/ Contact    flype@altern.org
    ;/ Info       MS Windows only - winmm.lib - mmsystem.h
    ;/
    ;  Bug fixes by chris319 on September 2, 2007
    ;  04/02/2010 : DrGolf for PB 4.50
    ;  01/20/2011 : Vitor_Boss® -- Fixed clamping
    ;  6/8/2012 -- revised again by chris319 on PB 4.61
    ;  28/8/2022 : modified by morosh
    ;   modified
    
;Structure WAVEFORMATEX -- NOT NEEDED IN PB 4.10 -- chris319
;  wFormatTag.w
;  nChannels.w
;  nSamplesPerSec.l
;  nAvgBytesPerSec.l
;  nBlockAlign.w
;  wBitsPerSample.w
;  cbSize.w
;EndStructure


#MONO = 1
#STEREO = 2
#Button =0

Global QuitRec.l
Global lBuf.l, nBuf.l, nDev.l, fname.s, format.WAVEFORMATEX,  hWindow.l, FileId.l 
Global size.l, buffer.l, output.l, wave.l, played.l ,playing.b
Global Dim outHdr.WAVEHDR(16)

Declare PLAY_Stop()
Declare PLAY_Start()
Declare PLAY_GetDevices()
Declare PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
Declare FILE_Close()
Declare FILE_Open()
Declare FILE_wav2raw(fname.s)

Declare GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)

Procedure.l getfiledatanum(nof.a, offset.u, len.a)
Protected tmpl.l=0, ch.a, i.a

FileSeek(nof,offset)
For i=1 To len
  ReadData(nof, @ch, 1)
  tmpl+ch*Pow(256,i-1)
Next
ProcedureReturn tmpl
EndProcedure

Procedure PLAY_Start()
Define i.a

format\wFormatTag = getfiledatanum(0,20,2)
format\nChannels = getfiledatanum(0,22,2)
format\nSamplesPerSec = getfiledatanum(0,24,4)
format\wBitsPerSample = getfiledatanum(0,34,2)
  
FileSeek(0,58)
PLAY_Stop()
format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8
format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign
format\cbSize = 0
 
If waveOutOpen_(@wave,nDev,@format,hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT) = #MMSYSERR_NOERROR
  For i = 0 To nBuf - 1
    outHdr(i)\lpData = AllocateMemory(lBuf)
    outHdr(i)\dwBufferLength = lBuf
    waveOutPrepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
    waveOutWrite_(wave,outHdr(i),SizeOf(WAVEHDR))
  Next

  If waveOutReset_(wave) <> #MMSYSERR_NOERROR
    MessageRequester("Error","waveOutStart_(wave)",#MB_ICONERROR)
    QuitRec=1
  EndIf
Else
  MessageRequester("Error","waveOutOpen_ failed",#MB_ICONERROR)
  QuitRec=1  
EndIf 
EndProcedure
    ;
Procedure PLAY_Stop()
  Define i.a
  
  If wave
  waveOutReset_(wave)
 ; waveOutStop_(wave)
  For i = 0 To nBuf - 1
    If outHdr(i)
      waveOutUnprepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
    EndIf
  Next
  waveOutClose_(wave)
EndIf
EndProcedure
    ;
Procedure PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
;  Define *hWave.WAVEHDR
  
;*hWave=lpWaveHdr
buffer=*hWave\lpData
size=*hWave\dwBufferLength

If playing = #True
  ReadData(0, buffer,size)
  played + size
EndIf

waveOutWrite_(hwaveOut,*hWave,SizeOf(WAVEHDR))
;Beep_(100,100)
EndProcedure
    ;
Procedure PLAY_GetDevices()
  Define MMNumDevice.l, MMDeviceId.l, MMResult.l, Caps.waveOutCAPS
  
  MMNumDevice = waveOutGetNumDevs_()
  If MMNumDevice
    For MMDeviceId=#WAVE_MAPPER To MMNumDevice-1
      MMResult.l = waveOutGetDevCaps_(MMDeviceId,@Caps,SizeOf(waveOutCAPS))
      If MMResult = #MMSYSERR_NOERROR
         Debug Str(MMDeviceId) + "  " + PeekS(@Caps\szPname,#MAXPNAMELEN)
        ; AddGadgetItem(gadId,-1,PeekS(@Caps\szPname,#MAXPNAMELEN))
      EndIf
    Next
  EndIf
EndProcedure
 
Procedure FILE_Open()
If playing = #False
  FILE_wav2raw(fname)
EndIf
played  = #Null ; -- MOVED HERE BY chris319
FileId=ReadFile(0,fname)
If FileId
  playing=#True
Else
  MessageRequester("Error","Can't Read file",#MB_ICONERROR)
EndIf 
EndProcedure

Procedure FILE_Close()
If playing
  playing = #False
  CloseFile(0)
  Delay(1000)
EndIf
EndProcedure

Procedure FILE_wav2raw(fname.s)
Define inId.l, outId.l, pBuf.l, subchunk2size.l, chunksize.l, f$, x$, b.w, c.w, h.l
inId = ReadFile(#PB_Any,fname)

If inId = #Null
  MessageRequester("Error", "Unable to open file",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

lBuf.l = Lof(inId)
If lBuf = #Null
  MessageRequester("Error", "lbuf=0",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

pBuf = AllocateMemory(lBuf)
If pBuf = #Null
  MessageRequester("Error", "Unable to allocate buffer",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf

ReadData(inId, pBuf,lBuf)
CloseFile(inId)

f$ = GetFilePart(fname)
x$ = GetPathPart(fname)+Left(f$,Len(f$)-Len(GetExtensionPart(fname))-1)+".raw"

outId = CreateFile(#PB_Any,x$)
If outId = #Null
  MessageRequester("Error", "Unable to create file",#MB_ICONERROR) ; chris319
  ProcedureReturn #False
EndIf
WriteData(outId, pBuf+58,lBuf-58)

CloseFile(outId)
FreeMemory(pBuf) ;chris319
ProcedureReturn #True
EndProcedure
        ;
Procedure GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
  Define Result.l
  
Result = #PB_ProcessPureBasicEvents
Select Msg
  Case #WM_KEYDOWN
    If GetAsyncKeyState_(#VK_ESCAPE)
      QuitRec = 1
    EndIf
  Case #MM_WOM_DONE
    PLAY_Write(wParam,lParam)

  Case #WM_COMMAND
    Select wParam & $FFFF
      Case #Button      
        FILE_Open() : PLAY_Start()
      Case #Button+1    
        FILE_Close() : QuitRec=1
  EndSelect
EndSelect
ProcedureReturn Result     
EndProcedure
    ;
    ;- REC MAIN
;;;;;;;;;;;;;;;;;;;;;;;;;;;GUI_init ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QuitRec = 0
fname = "E:\my_data\sound\polmor.wav"
nDev = 0
nBuf = 8
lBuf = 2048

hWindow=OpenWindow(0,0,0,500,400,"Player",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
LoadFont(0, "Arial", 12)
ButtonGadget(#Button, 50,50,100,20,"Replay")
ButtonGadget(#Button+1, 200,50,100,20,"Stop")
SetGadgetFont(#Button, FontID(0)) 
SetGadgetFont(#Button+1, FontID(0)) 

PLAY_GetDevices()
SetWindowCallback(@GUI_CallBack())
playing = #False

FILE_Open()
PLAY_Start()
Repeat
Until WaitWindowEvent() = #WM_CLOSE Or QuitRec
PLAY_Stop()
CloseDebugOutput()
;  Devices
;-1  Microsoft Sound Mapper
;0  Speakers (Realtek High Definiti
;1  Realtek Digital Output (Realtek
;2  Speakers (Bluetooth AV Audio)
;3  Speakers (Bluetooth SCO Audio)

Re: [Help]Sound output for externel Device

Posted: Sun Aug 28, 2022 9:51 pm
by tft
it works great. only at stop it seems to crash and not to end. Thank you very much.

TFT

Re: [DONE]Sound output for externel Device

Posted: Fri Dec 09, 2022 1:28 am
by nsstudios
Was looking for a way to set the output device of my program, and tried the solution offered here, but it didn't really work for me (I'm using ogg files, and it seems not to like some of the 44.1 khz 16 bit waves either, plus I need rate manipulation as well).
In case it's useful to someone else, the (hacky?) way I ended up doing it is with Nirsoft's sound volume commandline app.
Not sure how problematic shipping something like this would be for commercial products, but in my case I just needed it for a little streaming automation script no one else has access to.

Code: Select all

RunProgram("svcl.exe", ~"/SetAppDefault \"VB-Audio Virtual Cable\\Device\\CABLE Input\\Render\" all \"myApp.exe\"", GetPathPart(ProgramFilename()), #PB_Program_Hide)
delay(5000)
RunProgram("svcl.exe", ~"/SetAppDefault \"high def*\\Device\\Speakers\\Render\" all \"myApp.exe\"", GetPathPart(ProgramFilename()), #PB_Program_Hide)

Re: [HELP]Sound output for externel Device

Posted: Sat Sep 07, 2024 8:43 pm
by gregreen
I tried everything here but SetWindowCallback(@GUI_CallBack()) generates:

[ERROR] SetWindowCallback(): The Procedure specified in '@ProcedureName()' does not have the required argument or returntype.

In an ideal world I could send audio out(s) to any playback device(s). I'll keep at it, but so far it's a head scratcher. The svcl.exe hack sort of works but there's no easy way to send to multiple outs like if I was trying to listen to Dolby Atmos 8 channel audio out of 8 different speakers.

Re: [DONE]Sound output for externel Device

Posted: Sat Sep 07, 2024 9:52 pm
by ChrisR
There are too many long variables (.l) in the code (they should be integers) to be compatible with PB 6.10 and up.
Use PB6.04 or earlier
Or with 6.10 and up, try deleting all the .l and also

Code: Select all

Procedure.l getfiledatanum(nof.a, offset.u, len.a)
Protected tmpl.l=0, ch.a, i.a
=>

Code: Select all

Procedure getfiledatanum(nof, offset, len)
Protected tmpl=0, ch, i
and change fname = "D:\xxxxxx.wav" with an existing wav file

Re: [DONE]Sound output for externel Device

Posted: Sat Sep 07, 2024 10:39 pm
by gregreen
Thanks for the help. I removed the .l and I now get to:
If waveOutOpen_(@wave,nDev,@format,hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT) = #MMSYSERR_NOERROR

and that fails because it returns 11 instead of 0 (#MMSYSERR_NOERROR=0)

Could that be because it expects a different sample rate, bits per sample, etc.?
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited