capter le son des enceintes ..Bass.dll

[celtic88]

après ce topic la
http://www.purebasic.fr/french/viewtopi ... 3&start=30
J'ai décidé de faire ce code juste pour le plaisir et Peut être qu'il soit utile pour les membres

bon ce code permet de capter et affiche les EQu de Son et en fin l'enregistrer au format WAV

les dll utiliser son :
bass.dll
basswasapi.dll
bassmix.dll

vous pouvez télécharger le pack complet avec leur inclu par ici
http://www.mediafire.com/download/b36z2 ... ss_api.rar

amusez vous bien!!

image:


le code :

Code : Tout sélectionner

;////////////////////////////////////
;          Author Celtic88(c)
;          Example for learning
;///////////////////////////////////

EnableExplicit

IncludeFile "bass.pbi"
IncludeFile "basswasapi.pbi"
IncludeFile "bassmix.pbi"
IncludeFile "Wav_structure.pbi"

Structure _ffT
  _ffT.f[1024]
EndStructure

Global BUFSTEP.l= 200000
Global *recPtr
Global DeviceiD.l=-1
Global instream.l
Global inmixer.l
Global reclen.l
Global Rate.l=48000
Global SaveRec.b=0

Global wf.WAVEFORMATEX_Ex 
With wf
  \riff\wrBlockTypeRiff = $46464952         ; "RIFF"
  \riff\wrBlockSize = 0                      ; after recording
  \riff\wrBlockTypeWave = $45564157         ; "WAVE"
  
  \wfBlockTypeFmt = $20746D66               ; "fmt "
  \wfBlockSize = 16
  \wFormatTag = 1
  \nChannels = 2
  \wBitsPerSample = 16
  \nSamplesPerSec = Rate
  \nBlockAlign = \nChannels * \wBitsPerSample / 8
  \nAvgBytesPerSec = \nSamplesPerSec * \nBlockAlign
  
  \Data\wdBlockTypeData = $61746164          ; "data"
  \Data\wdBlockSize = 0                       ; after recording
EndWith	

#StartGadgetIndex=17

Global nameapp$="Tomorrowland Mix Bêta"
OpenWindow(0, 0, 0, 610, 280, nameapp$, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ProgressBarGadget(0, 10, 50, 40, 170, 0, 32768, #PB_ProgressBar_Vertical)
Define zz.b
For zz=1 To 16
  ProgressBarGadget(zz, 70+(30*(zz-1)), 60, 20, 150, 0, 255, #PB_ProgressBar_Vertical)
Next
ProgressBarGadget(zz, 559, 50, 40, 170, 0, 32768, #PB_ProgressBar_Vertical)
CheckBoxGadget(zz+1, 427, 13, 50, 25, "Record")
ButtonGadget(zz+9, 488, 13, 90, 25, "Enregistrer ...")
HyperLinkGadget(zz+2, 460, 250, 180, 25, "Par Celtic1888 PureBasic(c)", 0)
SetGadgetColor(zz+2, #PB_Gadget_FrontColor,RGB(0,0,255))
ComboBoxGadget(zz+3, 70, 15, 270, 20)
ButtonGadget(zz+4, 350, 13, 60, 25, "Démarrer")
TextGadget(zz+5, 12, 17, 50, 25, "Dispositif")
TextGadget(zz+6, 20, 225, 20, 25, "L", #PB_Text_Center)
TextGadget(zz+7, 570, 225, 20, 25, "R", #PB_Text_Center)
CheckBoxGadget(zz+8, 10, 245, 120, 25, "Premier plan")

Debug Hex(BASS_WASAPI_GetVersion())

Procedure Get_Set_Device_SPEAKERS(FindDev.s="Null")
  Protected Errcode.l,ok.l,info.BASS_WASAPI_DEVICEINFO ,FindDeviceiD.l=-1,DevName.s
  For ok=0 To 99
    If Not BASS_WASAPI_GetDeviceInfo(ok,@info) 
      Errcode=BASS_ErrorGetCode()
      If Errcode And Errcode<> #BASS_ERROR_DEVICE
        Debug "Error N : 1 Code : "+Str(Errcode)
      EndIf
    Break : EndIf
    If info\flags & #BASS_DEVICE_ENABLED And info\flags &  #BASS_DEVICE_INPUT ;And info\type &  #BASS_WASAPI_TYPE_SPEAKERS
      DevName = PeekS(info\name,-1,#PB_Ascii)
      If FindDev = "Null" 
        AddGadgetItem(#StartGadgetIndex+3, -1, DevName)
        SetGadgetState(#StartGadgetIndex+3, 0)
      ElseIf FindDev = DevName
        FindDeviceiD=ok
        Break
      EndIf
    EndIf
  Next
  ProcedureReturn FindDeviceiD
EndProcedure
Procedure Start_BASS_Recsp()
  BASS_SetConfig(#BASS_CONFIG_UPDATETHREADS, 0)
  If Not BASS_Init(0,Rate,0,0,0)
    Debug "Error N : 2 Code : "+Str(BASS_ErrorGetCode())
    End
  EndIf
EndProcedure
Procedure LoWord(value.l)
  ProcedureReturn value & $FFFF
EndProcedure
Procedure HiWord(value.l)
  ProcedureReturn value >> 16 & $FFFF
EndProcedure

Procedure _CallBack_WASAPIPROC(*buffer, length.l, user.i)
  Protected *temp,c.l
  If SaveRec
    BASS_StreamPutData(instream,*buffer,length)
    *temp=AllocateMemory(50000)
    
    Repeat
      c = BASS_ChannelGetData(inmixer, *temp, 50000)
      
      If c > 0 
        
        ; increase buffer size if needed
        If (Mod(reclen , BUFSTEP) + c >= BUFSTEP) 
          *recPtr = ReAllocateMemory(*recPtr, ((reclen + c) / BUFSTEP + 1) * BUFSTEP)
          If (*recPtr = 0) 
            Debug "Out of memory!"
            End
          EndIf
        EndIf
        ; buffer the data
        CopyMemory(*temp, *recPtr + reclen,c)
        reclen + c
      Else
        Break
      EndIf
    ForEver
    
    FreeMemory(*temp)
  EndIf
  ProcedureReturn length
EndProcedure

Procedure _InitInputDevice()
  Protected errorp.l,Errcode.l
  
  If BASS_WASAPI_Init(DeviceiD,0,0,#BASS_WASAPI_BUFFER,1,0.1,@_CallBack_WASAPIPROC(),0)
    
    *recPtr =AllocateMemory(BUFSTEP)
    If (*recPtr = 0) 
      Debug "Out of memory!"
      End
    EndIf
    reclen=SizeOf(WAVEFORMATEX_Ex)
    ; copy header to memory
    CopyMemory(wf, *recPtr, reclen)   ; "RIFF" \\ "WAVEfmt " \\ "data"
    
    Protected wi.BASS_WASAPI_INFO ;
    BASS_WASAPI_GetInfo(@wi)
    instream=BASS_StreamCreate(wi\freq,wi\chans,#BASS_SAMPLE_FLOAT|#BASS_STREAM_DECODE,#STREAMPROC_PUSH,0);
    If instream
      inmixer = BASS_Mixer_StreamCreate(Rate, wi\chans, #BASS_STREAM_DECODE)
      If inmixer
        BASS_Mixer_StreamAddChannel(inmixer, instream, 0)
        
        If BASS_WASAPI_Start()
          AddWindowTimer(0, 1, 1)
          ProcedureReturn 1
        Else
          Errcode=BASS_ErrorGetCode()
          errorp=4
        EndIf
        BASS_StreamFree(inmixer)
        inmixer = 0
      Else
        Errcode=BASS_ErrorGetCode()
        errorp=8
      EndIf     
      BASS_StreamFree(instream)
      instream= 0
    Else
      Errcode=BASS_ErrorGetCode()
      errorp=7
    EndIf    
    BASS_WASAPI_Free()
  Else
    Errcode=BASS_ErrorGetCode()
    errorp=3
  EndIf
  
  If *recPtr
    FreeMemory(*recPtr)
    *recPtr=0
    reclen=0
  EndIf
  
  If errorp
    Debug "Error N : "+Str(errorp)+" Code : "+Str(Errcode)
    SetGadgetText(#StartGadgetIndex+4,"Démarrer")
    DeviceiD = -1
  EndIf
EndProcedure

Procedure _De_InitInputDevice()
  If Not BASS_WASAPI_IsStarted()
    ProcedureReturn
  EndIf
  
  BASS_WASAPI_Stop(1)
  BASS_WASAPI_Free()
  BASS_StreamFree(instream)
  BASS_StreamFree(inmixer)
  If *recPtr
    FreeMemory(*recPtr)
  EndIf  
  *recPtr=0
  reclen=0
  instream=0
  inmixer=0
  SaveRec=0  
  
  DeviceiD = -1 
  RemoveWindowTimer(0, 1)
  SetWindowTitle(0, nameapp$)   
  SetGadgetText(#StartGadgetIndex+4,"Démarrer")
  SetGadgetState(#StartGadgetIndex+1,#PB_Checkbox_Unchecked)
  Protected zz.b
  For zz=0 To 17
    SetGadgetState(zz, 0)
  Next  
EndProcedure

Procedure __Equalizer()
  If DeviceiD = -1
    ProcedureReturn
  EndIf
  Protected errorp.l,Errcode.l,_fft._fft
  
  If BASS_WASAPI_GetData(@_fft, #BASS_DATA_FFT2048) <> -1
    
    Protected _lines.l=16,y.l,b0.l,x.l,peak.f,b1.l,mm.f
    For x=0 To _lines-1
      
      peak = 0
      b1 = Pow(2,x * 10.0 / (_lines - 1))
      If (b1 > 1023) :b1 = 1023:EndIf
      If (b1 <= b0): b1 = b0 + 1:EndIf
      For b0=b0 To b1-1
        mm = _fft\_fft[1 + b0]
        If (peak < mm)
          peak = mm
        EndIf
      Next
      y = Sqr(peak)* 3 * 255 - 4
      If (y > 255) :y = 255:EndIf;
      If (y < 0) :y = 0:EndIf;
      
      SetGadgetState(x+1, y)
    Next
    
  Else
    Errcode=BASS_ErrorGetCode()
    errorp=6           
  EndIf
  
  Protected GetLevel.l=BASS_WASAPI_GetLevel()
  If GetLevel = -1
    Errcode=BASS_ErrorGetCode()
    errorp=5
  EndIf
  
  Protected left_channel.l = LoWord(GetLevel)
  Protected Right_channel.l = HiWord(GetLevel)
  SetGadgetState(0, left_channel)
  SetGadgetState(#StartGadgetIndex, Right_channel)
  
  If SaveRec=1
    SetWindowTitle(0, nameapp$+ " [Rec "+BASS_ChannelGetPosition(inmixer, #BASS_POS_BYTE)+" byte]") 
  EndIf
  
  If errorp
    Debug "Error N : "+Str(errorp)+" Code : "+Str(Errcode)
    _De_InitInputDevice()
  EndIf
EndProcedure

Procedure _Wav_WriteToDisk()
  If reclen
    Protected Fichier$ = SaveFileRequester("Choisissez le nome...", GetCurrentDirectory() , "Wav (*.wav)", 0)
    If Fichier$=""
      ProcedureReturn
    EndIf
    PokeL(*recPtr + 4,reclen - 8)
    PokeL(*recPtr + 40,reclen - 44)
    If CreateFile(0,Fichier$)
      WriteData(0,*recPtr,reclen)
      CloseFile(0)
    EndIf
  EndIf
EndProcedure

Get_Set_Device_SPEAKERS()
Start_BASS_Recsp()

Define Event.l,DevName$,zdev.l
Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_CloseWindow
      _De_InitInputDevice()
      BASS_Free()
      Break
      
    Case #PB_Event_Timer
      __Equalizer()
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #StartGadgetIndex+4
          If DeviceiD = -1
            DevName$ = GetGadgetText(#StartGadgetIndex+3)
            If DevName$ <> #NULL$
              zdev=Get_Set_Device_SPEAKERS(DevName$)
              If zdev<> -1
                DeviceiD =zdev
                SetGadgetText(#StartGadgetIndex+4,"Arrêter")
                _InitInputDevice()
              EndIf
            EndIf
          Else
            _De_InitInputDevice()
          EndIf
          
        Case #StartGadgetIndex+1
          If DeviceiD <> -1
            If GetGadgetState(#StartGadgetIndex+1) <> #PB_Checkbox_Checked
              SaveRec=0
              SetWindowTitle(0, nameapp$) 
            Else
              SaveRec=1
            EndIf
          Else
            SetGadgetState(#StartGadgetIndex+1,#PB_Checkbox_Unchecked)
          EndIf
          
        Case #StartGadgetIndex+8
          If GetGadgetState(#StartGadgetIndex+8) <> #PB_Checkbox_Checked
            StickyWindow(0, 0) 
          Else
            StickyWindow(0, 1) 
          EndIf         
        Case #StartGadgetIndex+9         
          _Wav_WriteToDisk()
          
      EndSelect
      
  EndSelect
ForEver

End

[Kwai chang caine]

Ouaaaah !!! décidément j'adore quant tu t'ennuie !!!
Marche niquel avec W7 et v5.23

Juste un petit bug, si je lance ton code et que je clic sur un dossier quelconque de l'explorateur, un ronflement apparait et continue dans ton equalizer
Autrement super boulot, comme dab
Encore merci

[Shadow]

Salut, bien que je ne comprenne rien au code
c'est du très bon travail.

Ceci me parais long comme code pour faire ce genre de chose.
c'est parce que PB ne gère pas ça, c'est pour ça, faut tous crée sois même.

Bon travail celtic88

[Ar-S]

Je viens de tester vite fait, c'est prometteur.
L'enregistrement fonctionne mais il y a un soucis de sampling. Le wav se met bien en 48khz mais l'enregistrement est accéléré. Comme si la prise de son se faisait en 22Khz mais qu'à la sauvegarde il resample le son en 48khz ce qui accélère le son et le monte dans les aigus. On se retrouve avec la voix de tic et tac

---edit---

Je viens de voir dans le bass.pbi qu'on est limité de 11khz à 44khz pour le "formats field of BASS_RECORDINFO"
Donc déjà il y a forcément une pine lorsqu'on sauve et qu'il converti le sample en 48khz

[Ar-S]

J'essayerai, mais la différence de "pitch" entre 44 et 48 ne justifierait pas, à mon avis, une telle distorsion.
Je verrai via ma tour, là je suis sur le portable en bas, condamné à couiner (entorse genoux gauche, put... de travaux).