PureBasic

Code : Tout sélectionner

InitCommonControlsEx_(a.INITCOMMONCONTROLSEX)

Import "User32.lib"
  
  ; Nous utilisons le pseudotype 'p-unicode' pour les paramètres chaîne, car
  ; MessageBoxW() est une fonction unicode seulement. Le compilateur va
  ; automatiquement convertir les chaînes en unicode quand nécessaire.
  ;
  MessageBoxW(Fenetre.i, Corps$, Titre$, Options.i = 0)
  ;MessageBoxW(Fenetre.l, Corps.p-unicode, Titre.p-unicode, Options.l=0) ; fonctionne
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 
    BoiteDeMessage(Fenetre.i, Corps$, Titre$, Options.i) As "MessageBoxW" 
  CompilerElse 
    BoiteDeMessage(Fenetre.i, Corps$, Titre$, Options.i) As "_MessageBoxW@16"
    BoiteDeMessage2(Fenetre.l, Corps.p-unicode, Titre.p-unicode, Options.l ) As "_MessageBoxW@16"  
  CompilerEndIf 
  
EndImport

; Cela fonctionnera correctement en mode ascii et en mode unicode, même si l'API est uniquement
; unicode car le compilateur s'occupera lui-même de la conversion.
;
MessageBoxW(0, "Salut", "le Monde") 
BoiteDeMessage(0, "Salut 2", "le Monde 2",0)
BoiteDeMessage2(0, "Salut 3", "le Monde 3",0)

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