[DONE]Sound output for externel Device

Just starting out? Need help? Post your questions and find answers here.
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

[DONE]Sound output for externel Device

Post 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
Last edited by tft on Sun Aug 28, 2022 9:52 pm, edited 1 time in total.
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: [Help]Sound output for externel Device

Post 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]
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: [Help]Sound output for externel Device

Post 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
PureBasic: Surprisingly simple, diabolically powerful
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

Re: [Help]Sound output for externel Device

Post 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
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: [Help]Sound output for externel Device

Post 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
PureBasic: Surprisingly simple, diabolically powerful
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

Re: [Help]Sound output for externel Device

Post by tft »

THX

i am working hard ........ to run it.
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: [Help]Sound output for externel Device

Post 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
PureBasic: Surprisingly simple, diabolically powerful
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

Re: [Help]Sound output for externel Device

Post 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.
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

Re: [Help]Sound output for externel Device

Post by tft »

Hallo ...

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

THX TFT
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: [Help]Sound output for externel Device

Post 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)

PureBasic: Surprisingly simple, diabolically powerful
User avatar
tft
User
User
Posts: 84
Joined: Mon Dec 29, 2008 9:34 am

Re: [Help]Sound output for externel Device

Post by tft »

it works great. only at stop it seems to crash and not to end. Thank you very much.

TFT
TFT seid 1989
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMagic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak :-)
nsstudios
Enthusiast
Enthusiast
Posts: 274
Joined: Wed Aug 28, 2019 1:01 pm
Location: Serbia
Contact:

Re: [DONE]Sound output for externel Device

Post 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)
Post Reply