[BASS] SoundSense

[JohnJohnsonSHERMAN]

Dans le cadre d'un petit projet d'égaliseur autonome qu'on avait commencé, moi et Shadow, suite a l'idée qu'on avait débattu sur le topic de mon Oscillo, j'ai réalisé un petit égaliseur graphique (quoique, visualisateur de fréquences est plus adapté puisqu'il n'égalise rien du tout pour l'instant), en utilisant la lib BASS, un concurrent de Fmod, et qui a l'avantage d'utiliser un module WASAPI, présent nativement sur Vista et suivants, et qui permet d'obtenir des données des entrées/sorties audio du pc (micros, haut parleurs, etc...). Celtic avait déja présenté cette lib ici.

Bon voila la bête :

https://www.dropbox.com/s/q3u0xm6bcjco0 ... t.PNG?dl=0

L'interface comporte deux graphes : le premier est l'analyse FFT du son, vous pouvez choisir le mode de visualisation du spectre avec le combobox éponyme, le second est un oscilloscope affichant l'onde sonore (samples), le tout en temps réel. Vous pouvez aussi choisir le périphérique a afficher (que ce soit un haut parleur ou un micro)(si bug avec vos micros, tenez-m'en au courant).
Il y a une fonction d'enregistrement prévue mais pas encore au point, donc non fonctionnel. Quand au réglage automatique du volume ce n'est pas non plus encore au point...
C'est une version béta, fait a l'arrache et pas fini, mais bon...
Voici le code :

Code : Tout sélectionner

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

UsePNGImageDecoder()

Enumeration Gadgets
  #Main
  #Equalizer
  #Wave
  #ListDevices
  #Frame_0
  #Frame_1
  #Frame_2
  #Frame_3
  #Mode
  #Rec_dir
  #parcourir
  #StartStop
  #Rec_StartStop
EndEnumeration

Enumeration EqualizerModes ;Modes pour l'égaliseur graphique
  #Average                 ;Moyenne de valeurs de la plage de FFT
  #Peaks                   ;Pics d'intensité du FFT uniquement
  #LgstScaled              ;Non fonctionnel. FFT pondéré par fonction logistique (bass cut)
  #LogScaled               ;Non fonctionnel. FFT pondéré par fonction logaritmique (idem, plus dur)
  #DBScaled                ;non fonctionnel. FFT exprimé en Décibels. Moins significatif mais plus proche du réel.
  #LogScaledFrequency      ;Fréquences suivant une échelle logaritmique, plus détaillé pour les basses. (D'aprés un code de Celtic)
EndEnumeration

Device.BASS_WASAPI_DEVICEINFO
CurrentDev.BASS_WASAPI_DEVICEINFO
Global Dim Spectre.f(1024), levels.l, Dim Wave.f(4000),Dim WaveBuf.f(1000),Dim TempWave.f(4000);,Dim Wave3.f(1000),Dim Wave4.f(1000)

Global FFT_Type = #LogScaledFrequency

Procedure ToastLogo(File.s,Time.l,Alpha.b=255)
  Logo = LoadImage(#PB_Any,File)
  Protected width,height,ElapsedTime,StartTime
  width = ImageWidth(Logo)
  height = ImageHeight(Logo)
  toast = OpenWindow(#PB_Any ,0,0,width,height,"Lancement...",#PB_Window_ScreenCentered | #PB_Window_BorderLess | #PB_Window_Invisible)
  ImageGadget(0,0,0,width,height,ImageID(Logo),#PB_Image_Raised)
  ;SetWindowsTransparency(WindowID(toast),1)
  HideWindow(toast,#False)
  For i=1 To Alpha
    ;SetWindowsTransparency(WindowID(toast),i)
    Delay(5)
  Next
  StartTime=ElapsedMilliseconds()
  Repeat
    WaitWindowEvent(10)
    ElapsedTime=ElapsedMilliseconds()-StartTime
  Until ElapsedTime >=Time
  For i=Alpha To 1 Step -5
    ;SetWindowsTransparency(WindowID(toast),i)
    Delay(5)
  Next
  CloseWindow(toast)
  FreeImage(Logo)
EndProcedure

Procedure.f GetScaledValue(RawValue.f,c.f,b.f=9.54e-4,a.f=17.7)
  Protected ScaledValue.f,ScaleOffset.f
  ScaledValue=Sqr(RawValue)* c *3-4
  If ScaledValue > c
    ScaledValue = c
  EndIf
  ProcedureReturn ScaledValue
EndProcedure

Macro VolumeBox(x,y,Width, Height, ScValue, Color, BkColor, bUseGradient=0, EndGradientColor=0)
  Box(x,y,Width, Height, Color)
  Box(x+1, y+1, Width-2, Height-2, BkColor)
  For yval = y+(Height-1) To y+Height - (ScValue*(Height/100)) Step -2
    LineXY(x+2,yval,x+(Width-3),yval,Color)
  Next
EndMacro

Procedure LeftWord(value.l)
  ProcedureReturn value & $FFFF
EndProcedure

Procedure RightWord(value.l)
  ProcedureReturn value >> 16 & $FFFF
EndProcedure

Procedure WASAPI_Callback(*buffer, length.l, user.i)
  ;Calback
  ProcedureReturn length
EndProcedure

Procedure Spectrum(param)
  Protected.f val,average,topval,Llevel, Rlevel,y1,y2
  Repeat
    ;Analyseur de spectre (equalizer) avec 16 barres (moyenne 64 valeurs)
    StartDrawing(CanvasOutput(#Equalizer))
    Box(0,0,600,400,RGB(0,20,0))
    If FFT_Type = #Average ;Mode moyennes
      For i=0 To 15
        val=0
        For k=(i*64)+2 To (i+1)*64
          val = val + Spectre(k-1)
        Next
        average=(val/64)
        VolumeBox(i*20+40,10,14,100,GetScaledValue(average,100),RGB(0,200,0),RGB(0,30,0))
      Next
    ElseIf FFT_Type = #Peaks ;Mode pics d'impulsion
      For i=0 To 15
        val=0
        For k=(i*64)+1 To (i+1)*64
          If Spectre(k-1) > val
            val=Spectre(k-1)
          EndIf
          If val > topval
            ;Debug val
            topval = val;TopVal : 1 echelle logistique f(x)=c/1+a*e^-bx Valeurs calculées par régression : a=17.707 ; b=9.57.10^-4 ; c=100. c : valeur palier, d(x) (dérivée moy sur pente ascendante) = (b/4)*c.
          EndIf 
          If i=0
            val=val/2
          EndIf
          
        Next
        VolumeBox(i*20+40,10,14,100,GetScaledValue(val,100),RGB(0,200,0),RGB(0,30,0))
      Next
    ElseIf FFT_Type = #LogScaledFrequency; Mode echelle logaritmique (d'aprés code de Celtic)
      Protected y.l,b0.l,x.l,peak.f,b1.l
      peak=0
      b0=0
      b1=0
      For x=0 To 15
        peak = 0
        b1 = Pow(2,x * 10.0 / 15)
        If (b1 <= b0): b1 = b0 + 1:EndIf
        If (b1 > 1023) :b1 = 1023:EndIf
        For b0=b0 To b1-1
          If (peak < Spectre(b0))
            peak = Spectre(b0)
          EndIf
        Next
        VolumeBox(x*20+40,10,14,100,GetScaledValue(peak,100),RGB(0,200,0),RGB(0,30,0))
      Next
    EndIf
    Llevel=LeftWord(levels)
    Rlevel=RightWord(levels)
    ;Debug Llevel
    ;Debug (Llevel/32768)*100
    VolumeBox(10,10,20,130,((Llevel/32768)*100),RGB(0,200,0),RGB(0,30,0))
    VolumeBox(370,10,20,130,((Rlevel/32768)*100),RGB(0,200,0),RGB(0,30,0))
    StopDrawing()
    StartDrawing(CanvasOutput(#Wave))
    Box(0,0,400,150,RGB(0,30,0))
    ratio=400/1024
    ;y2=0
    For i=0 To 400 Step 1
      y1=Wave(i*4)*75
      LineXY((i-2),y2+75,i,y1+75,RGB(0,200,0))
      y2=y1
    Next
    StopDrawing()
    Delay(25)
  ForEver
  
EndProcedure

;-Code principal

ToastLogo("SoundSenseLogo2.png",2000,200)

OpenWindow(#Main, 0, 0, 440, 470, "SoundSense 1.0", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
CanvasGadget(#Equalizer, 20, 20, 400, 150, #PB_Canvas_Border)
CanvasGadget(#Wave, 20, 180, 400, 150, #PB_Canvas_Border)
ComboBoxGadget(#ListDevices, 20, 370, 180, 25)
FrameGadget(#Frame_0, 10, 0, 420, 340, "Visualisations")
FrameGadget(#Frame_1, 10, 350, 200, 50, "Entrée son")
FrameGadget(#Frame_2, 220, 350, 210, 50, "Modes de visualisation")
FrameGadget(#Frame_3, 130, 410, 300, 50, "Enregistrement")
ComboBoxGadget(#Mode, 230, 370, 190, 25)
StringGadget(#Rec_dir, 180, 430, 200, 25, "")
GadgetToolTip(#Rec_dir, "Emplacement de l'enregistrement")
ButtonGadget(#parcourir, 390, 430, 30, 25, "...")
GadgetToolTip(#parcourir, "Parcourir")
ButtonGadget(#StartStop, 15, 420, 100, 30, "Démarrer", #PB_Button_Toggle)
GadgetToolTip(#StartStop, "Lancer/arrêter les mesures.")
ButtonImageGadget(#Rec_StartStop, 140, 430, 30, 25, 0,#PB_Button_Toggle)

AddGadgetItem(#Mode,-1,"Moyennes de fréquences")
AddGadgetItem(#Mode,-1,"Valeurs de crête")
AddGadgetItem(#Mode,-1,"Echelle de fréquences logaritmique")
AddWindowTimer(0,1,20)

DefaultDevice = -1 ;En l'absence de micro, le systéme par défaut est sélectionné
i=0
Debug "Devices :"
While BASS_WASAPI_GetDeviceInfo(i,@Device)
  If Device\flags&#BASS_DEVICE_ENABLED And Device\flags&#BASS_DEVICE_INPUT
    Name$ = PeekS(Device\name,-1,#PB_Ascii)
    Debug "["+Str(i)+"] "+Name$
    AddGadgetItem(#ListDevices,-1,Name$)
    SetGadgetItemData(#ListDevices,CountGadgetItems(#ListDevices)-1,i)
    If Device\type = #BASS_DEVICE_TYPE_MICROPHONE;Sélectionne automatiquement le premier micro détecté.
      DefaultDevice = i
    EndIf
    
  EndIf
  i+1
Wend

recordState = 0

BASS_SetConfig(#BASS_CONFIG_UPDATETHREADS, 0)
BASS_Init(0,44100,0,0,0)
For i=0 To CountGadgetItems(#ListDevices)-1
  Dev = GetGadgetItemData(#ListDevices,i)
  BASS_WASAPI_Init(Dev,44100,0,#BASS_WASAPI_BUFFER | #BASS_WASAPI_AUTOFORMAT,1,0.1,@WASAPI_Callback(),0)
  Debug BASS_ErrorGetCode()
  Debug "Device initialized : "+Str(Dev)
Next


Debug BASS_WASAPI_GetDevice()


CreateThread(@Spectrum(),1)

Repeat
  event=WaitWindowEvent()
  Select event
    Case #PB_Event_Timer
      If EventTimer() = 1
        BASS_WASAPI_GetData(Spectre(),#BASS_DATA_FFT2048);| #BASS_DATA_FFT_NOWINDOW | #BASS_DATA_FFT_REMOVEDC)
        levels=BASS_WASAPI_GetLevel()
        availdata=BASS_WASAPI_GetData(Wave(),#BASS_DATA_AVAILABLE)
        BASS_WASAPI_GetData(Wave(),8000 | #BASS_DATA_FLOAT);Seules 2000 données seront retournées
      EndIf
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #StartStop
          If recordState = 0
            BASS_WASAPI_Start()
            SetGadgetText(#StartStop,"Arrêter")
            recordState=1
          Else
            BASS_WASAPI_Stop(0)
            SetGadgetText(#StartStop,"Démarrer")
            recordState=0
          EndIf
          
        Case #ListDevices
          DeviceID = GetGadgetItemData(#ListDevices,GetGadgetState(#ListDevices))
          Debug DeviceID
          BASS_WASAPI_SetDevice(DeviceID)
          BASS_ErrorGetCode()
          If BASS_WASAPI_GetDevice()
            BASS_WASAPI_GetDeviceInfo(BASS_WASAPI_GetDevice(),@CurrentDev)
            ; Debug PeekS(CurrentDev\name,-1,#PB_Ascii) + "["+Str(DeviceID)+"]"
            Debug CurrentDev\id
          Else
            Debug "No device"
          EndIf
        Case #Mode
          Select GetGadgetState(#Mode)
            Case 0
              FFT_Type = #Average
            Case 1
              FFT_Type = #Peaks
            Case 2
              FFT_Type = #LogScaledFrequency
          EndSelect
          
      EndSelect
  EndSelect
  StopDrawing()
Until event = #PB_Event_CloseWindow
BASS_Free()

Et comme d'hab avec mes soft de son,le zip qui contient tout ce dont vous avez besoin.

Voila c'est tout pour l'instant

[Micoute]

Si ça t'intéresse, j'avais déjà fait quelque chose d'analogue.

Code : Tout sélectionner

XIncludeFile "D:\Programmation\Prg perso\Include\BarreGraphiqueGadget.pbi"

Global X, Y, Lgr, Ht, ag, ad

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   

Enumeration Fenetre
  #Fenetre
EndEnumeration

Enumeration Gadgets
  #Txt_Dispositif
  #Txt_L
  #Txt_R
  #Txt_Auteur
  #Gauche
  #Droite
  #Dispositif
  #Btn_Demarrer
  #Chk
  #VU
EndEnumeration

Global nameapp$="VuMètre"
X = 10 : Y = 50 : Lgr = 128 : Ht = 10
Declare InitBarres(X, Y, Lgr, Ht)


OpenWindow(#Fenetre, 0, 0, X+(Lgr*3)+30, Y+(Ht*28), nameapp$, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
InitBarres(X, Y, Lgr, Ht)
ComboBoxGadget(#dispositif, 70, 15, 270, 20)
ButtonGadget(#Btn_Demarrer, 350, 13, 60, 25, "Démarrer")
TextGadget(#Txt_Dispositif, X, 17, 50, 25, "Dispositif")
TextGadget(#Txt_L, X, Y+(Ht*23), Lgr, 25, "Canal gauche", #PB_Text_Center)
TextGadget(#Txt_R, (X+Lgr)*2, Y+(Ht*23), Lgr, 25, "Canal droite", #PB_Text_Center)
CheckBoxGadget(#Chk, X, Y+(Ht*24)+5, 120, 25, "Premier plan")
HyperLinkGadget(#Txt_Auteur, 320, Y+(Ht*25)+5, 180, 25, "Par Micoute", 0)
SetGadgetColor(#Txt_Auteur, #PB_Gadget_FrontColor,RGB(0,0,255))

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(#Dispositif, -1, DevName)
        SetGadgetState(#Dispositif, 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(#Fenetre, 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(#Btn_Demarrer,"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(#Fenetre, 1)
  SetWindowTitle(#Fenetre, nameapp$)   
  SetGadgetText(#Btn_Demarrer,"Démarrer")
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
    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)
  
  DefinirBarreGraphique(ag,left_channel) 
  
  DefinirBarreGraphique(ad,Right_channel) 
  
  If errorp
    Debug "Error N : "+Str(errorp)+" Code : "+Str(Errcode)
    _De_InitInputDevice()
  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 #Btn_Demarrer
          If DeviceiD = -1
            DevName$ = GetGadgetText(#Dispositif)
            If DevName$ <> #Null$
              zdev=Get_Set_Device_SPEAKERS(DevName$)
              If zdev<> -1
                DeviceiD =zdev
                SetGadgetText(#Btn_Demarrer,"Arrêter")
                _InitInputDevice()
              EndIf
            EndIf
          Else
            _De_InitInputDevice()
          EndIf
          
        Case #Chk
          If GetGadgetState(#Chk) <> #PB_Checkbox_Checked
            StickyWindow(#Fenetre, 0) 
          Else
            StickyWindow(#Fenetre, 1) 
          EndIf
          
      EndSelect
      
  EndSelect
ForEver

End

Procedure InitBarres(X, Y, Lgr, Ht)
  ag=BarreGraphique(X, Y,Lgr+70,Ht*22,2,10000,20000,30000,$FF00,$FFFF,$FF,0)
  
  ad=BarreGraphique(((X+Lgr)*2+5)-70,Y,Lgr+70,Ht*22,2,10000,20000,30000,$FF00,$FFFF,$FF,0)
EndProcedure


Delay(2000)

[Micoute]

Le fichier BarreGraphiqueGadget.pbi à inclure.

Code : Tout sélectionner

;->BarreGraphiqueGadget Crée une barre graphique pour montrer le niveau sonore, ou le débit du réseau.

Structure BarreGraphique 
  x.l 
  y.l 
  largeur.l 
  hauteur.l 
  moyen.f 
  Haut.f 
  maxi.f 
  Image.l 
  Gadget.l 
  Valeur.f 
  couleur1.l 
  couleur2.l 
  couleur3.l 
  CouleurFond.l
  Direction.l 
EndStructure 

;BarreGraphiqueGadget.pbi
Declare BarreGraphique(x,y,largeur,hauteur,Direction,moyen.f,Haut.f,maxi.f,couleur1,couleur2,couleur3,CouleurFond) ; Crée un gadget barre graphique.
Declare DefinirBarreGraphique(Id,Valeur.f) ; Définir la valeur de la barre graphique
Declare ObtenirBarreGraphique(Id) ; Obtient la valeur de la barre graphique
Declare EvenementBarreGraphique(Id) ; Renvoie 1 si vous cliquez sur un gadget barre graphique

Procedure BarreGraphique(x,y,largeur,hauteur,Direction,moyen.f,Haut.f,maxi.f,couleur1,couleur2,couleur3,CouleurFond) ; Crée un gadget barre graphique.
  ;// x,y,largeur,hauteur définissent la taille et l'emplacement du gadget dans la fenêtre
  ;// maxi définit le niveau maxi du gadget
  ;// CouleurFond définit la couleur de fond du gadget
  ;// Direction : 0 à droite / 1 à gauche / 2 en haut / 3 en bas
  ;// Valeur < moyen la couleur est couleur1
  ;// Valeur > moyen la couleur est couleur2
  ;// Valeur > Haut  la couleur est couleur3
  
  ; Initialise la liste chaînée au premier appel 
  Static Init 
  If Init=0 
    Global NewList ListeBarreGraphique.BarreGraphique() 
  EndIf 
  Init=1 
  
  ; Remplir la Structure 
  AddElement(ListeBarreGraphique()) 
  ListeBarreGraphique()\x=x 
  ListeBarreGraphique()\y=y 
  ListeBarreGraphique()\largeur=largeur 
  ListeBarreGraphique()\hauteur=hauteur 
  ListeBarreGraphique()\moyen=moyen 
  ListeBarreGraphique()\Haut=Haut 
  ListeBarreGraphique()\maxi=maxi 
  ListeBarreGraphique()\couleur1=couleur1 
  ListeBarreGraphique()\couleur2=couleur2 
  ListeBarreGraphique()\couleur3=couleur3 
  ListeBarreGraphique()\CouleurFond=CouleurFond
  ListeBarreGraphique()\Direction=Direction 
  ListeBarreGraphique()\Image=CreateImage(#PB_Any,largeur,hauteur) 
  
  StartDrawing(ImageOutput(ListeBarreGraphique()\Image))
  Box(0,0,ListeBarreGraphique()\largeur,ListeBarreGraphique()\hauteur,CouleurFond)
  StopDrawing()
  
  ; créer le gadget & montrer l'image 
  ListeBarreGraphique()\Gadget=ImageGadget(#PB_Any,x,y,largeur,hauteur,ImageID(ListeBarreGraphique()\Image),#PB_Image_Border) 
  
  ; Renvoyer l'id du gadget
  ProcedureReturn ListIndex(ListeBarreGraphique()) 
  
EndProcedure 

Procedure DefinirBarreGraphique(Id,Valeur.f) ; Définir la valeur de la barre graphique
  
  ;// La couleur est automatique ( définie avec couleur1 couleur2 couleur3 et niveau moyen / Haut )
  
  SelectElement(ListeBarreGraphique(),Id) 
  
  ListeBarreGraphique()\Valeur=Valeur 
  
  ; Rouge
  couleur=ListeBarreGraphique()\couleur1 
  
  ; Jaune
  If Valeur > ListeBarreGraphique()\moyen 
    couleur=ListeBarreGraphique()\couleur2 
  EndIf 
  
  ; Vert
  If Valeur > ListeBarreGraphique()\Haut 
    couleur=ListeBarreGraphique()\couleur3 
  EndIf 
  
  ; Dessin
  StartDrawing(ImageOutput(ListeBarreGraphique()\Image)) 
  Box(0,0,ListeBarreGraphique()\largeur,ListeBarreGraphique()\hauteur,ListeBarreGraphique()\CouleurFond) 
  
  Select ListeBarreGraphique()\Direction 
    Case 0 
      Ptr.f= ( Valeur / ListeBarreGraphique()\maxi )*ListeBarreGraphique()\largeur 
      Box(0,0,Ptr,ListeBarreGraphique()\hauteur,couleur) 
    Case 1 
      Ptr.f= ( Valeur / ListeBarreGraphique()\maxi )*ListeBarreGraphique()\largeur 
      Box(ListeBarreGraphique()\largeur,0,-(Ptr),ListeBarreGraphique()\hauteur,couleur) 
    Case 2 
      Ptr.f= ( Valeur / ListeBarreGraphique()\maxi )*ListeBarreGraphique()\hauteur 
      Box(0,ListeBarreGraphique()\hauteur,ListeBarreGraphique()\largeur,-(Ptr),couleur) 
    Case 3 
      Ptr.f= ( Valeur / ListeBarreGraphique()\maxi )*ListeBarreGraphique()\hauteur 
      Box(0,0,ListeBarreGraphique()\largeur,Ptr,couleur) 
  EndSelect 
  StopDrawing() 
  
  SetGadgetState(ListeBarreGraphique()\Gadget,ImageID(ListeBarreGraphique()\Image)) 
  
EndProcedure 

Procedure ObtenirBarreGraphique(Id) ; Obtient la valeur de la barre graphique
  SelectElement(ListeBarreGraphique(),Id) 
  ProcedureReturn ListeBarreGraphique()\Valeur 
EndProcedure 

Procedure EvenementBarreGraphique(Id) ; Renvoie 1 si vous cliquez sur un gadget barre graphique
  
  ;// If EventGadget() = EvenementBarreGraphique(1) : votre code ici : EndIf
  
  SelectElement(ListeBarreGraphique(),Id) 
  ProcedureReturn ListeBarreGraphique()\Gadget 
EndProcedure 

[JohnJohnsonSHERMAN]

Pas mal du tout, merci de ce code Micoute ! Il réagit bien a mes périphériques Mais le mien il a plus de barres ! J'ai vu que tu avais fait des recherches pour gérer le volume du pc aussi, est-ce que tu aurais des pistes pour modifier le volume systéme (genre via une api ou quelquechose comme ca?)? Je n'ai rien trouvé qui permette de modifier le volume général du systéme , c'est pourtant le but ultime de ce projet... Si quelqun a une idée.. merci d'avance !

[Micoute]

Normal que le tien ait plus de barres, puisque le mien en a juste une pour chaque canal et nom pas pour chaque fréquence, mais c'est juste une base, j'en ai fait de plus complexes.

Pour le réglage automatique du son, je l'ai fait de façon plus électronique, car j'ai construit deux préamplis en contre-réaction, branchés à l'entrée de l'ampli, ce qui fait que plus le son est fort et plus il est atténué, on peut faire la même chose pour les graves et les aigues.

[JohnJohnsonSHERMAN]

Oui en effet on peut aussi le faire avec du matos externe... aprés c'est sans doute plus simple de le faire via une commande quelconque genre une api, mais je n'ai aucune connaissance dans ce domaine...
Effectivement ton code ne présente que deux indicateurs de volume contrairement au mien. J'aime bien les deux vu-métres a couleur variable

Par contre... ce code ressemble assez a celui-ci(de Celtic) Comme ni l'un ni l'autre ne se cite, lequel a copité l'autre? Eh oui, rien ne lui échappe a ce Sherman, sauf l'évidence

Ca me rapelle que tout cela était lié a cette discussion au sujet d'un égaliseur autonome que tu avais lancé, que Celtic avait partagé du code dessus, et que Shadow avait vu avant de me communiquer l'idée quand j'ai fait l'Oscillo, idée que j'ait reprise et qui nous conduit a ce présent sujet... On tourne en rond sur ce forum

A ce propos, sur cette page, il y avait des codes de Dobro, mais je n'en vois aucun? Une idée de ce qu'ils sont devenus?

[Zorro]

A ce propos, sur cette page, il y avait des codes de Dobro, mais je n'en vois aucun? Une idée de ce qu'ils sont devenus?

ben a l'epoque ils etaient sous pseudo Spock
et comme quelqu'un a réussi a se faire passer pour moi aupres de Fred , et a demandé a faire fermer le compte Spock
et retirer tout les messages ....

ben tout les messages de Spock , ont disparus du forum !

oui ça parait incroyable dis comme ça , mais pourtant ça a eu lieu ! ....
de plus G-rom en son temp nous avait prouvé qu'il avait trouvé un moyen d'ecrire en se faisant passer pour quelqu'un d'autre ....
je pense que l'astuce a du etre reprise ....
pour ces codes, je ne crois pas en avoir gardé une trace...

[JohnJohnsonSHERMAN]

Dommage... je poiraute pour savoir comment modifier le volume systéme... comme Micoute sur son sujet a cette epoque en fait...

[falsam]

de plus G-rom en son temp nous avait prouvé qu'il avait trouvé un moyen d'ecrire en se faisant passer pour quelqu'un d'autre ....

Oui parce qu'il était modérateur global. Les autres modo comme moi, ar-s, taz, etc ... ne peuvent pas faire ça et encore moins un utilisateur du forum.

De même que créer un autre compte Spock, n'est pas possible si ce compte existe déja.

[djes]

J'ai trouvé (mais pas testé) ça : http://www.purebasic.fr/english/viewtop ... ead#unread

[JohnJohnsonSHERMAN]

@falsam et Dobro dans leur magnifique HS :

N'empêche que certains se créent plusieurs comptes avec des noms différents, ca embrouille... Je ne vise personne, n'est -ce pas Dob... euh personne?

@djes : je jette un oeil tout de suite

[Zorro]

@falsam et Dobro dans leur magnifique HS :

je ne sus pas HS , tu poses la question :

A ce propos, sur cette page, il y avait des codes de Dobro, mais je n'en vois aucun? Une idée de ce qu'ils sont devenus?

j'y réponds ! , je ne suis pas Hors sujet

[Patrick88]

c'est peut-être ce code...
changer la ligne -> MediaSetVolume(15) ; de 0 a 255

Code : Tout sélectionner

EnableExplicit

#CLSCTX_INPROC_SERVER  = $01
#CLSCTX_INPROC_HANDLER = $02
#CLSCTX_LOCAL_SERVER   = $04
#CLSCTX_REMOTE_SERVER  = $10

#CLSCTX_ALL    = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
#CLSCTX_INPROC = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER
#CLSCTX_SERVER = #CLSCTX_INPROC_SERVER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER

Interface IMMDeviceEnumerator Extends IUnknown
  EnumAudioEndpoints(dataFlow, dwStateMask, *ppDevices);
  GetDefaultAudioEndpoint(dataFlow, role, ppEndpoint);
  GetDevice(pwstrId, ppDevice);
  RegisterEndpointNotificationCallback(pClient);
  UnregisterEndpointNotificationCallback(pClient);
EndInterface

Interface IAudioEndpointVolume Extends IUnknown
  RegisterControlChangeNotify( *pNotify)
  UnregisterControlChangeNotify( *pNotify)
  GetChannelCount( *pnChannelCount)
  SetMasterVolumeLevel( fLevelDB.f)
  SetMasterVolumeLevelScalar( fLevel.f,pguidEventContext)
  GetMasterVolumeLevel(*pfLevelDB)
  GetMasterVolumeLevelScalar(*pfLevel)
  SetChannelVolumeLevel(nChannel,fLevelDB.f,pguidEventContext)
  SetChannelVolumeLevelScalar( nChannel,fLevel.f,pguidEventContext)
  GetChannelVolumeLevel( nChannel,*pfLevelDB.f)
  GetChannelVolumeLevelScalar( nChannel,*pfLevel.f)
  SetMute( bMute, pguidEventContext)
  GetMute( *pbMute)
  GetVolumeStepInfo( *pnStep, *pnStepCount)
  VolumeStepUp( pguidEventContext)
  VolumeStepDown( pguidEventContext)
  QueryHardwareSupport( *pdwHardwareSupportMask)
  GetVolumeRange( *pflVolumeMindB, *pflVolumeMaxdB, *pflVolumeIncrementdB)
EndInterface

Interface IMMDevice Extends IUnknown
  Activate(iid, dwClsCtx, pActivationParams, ppInterface);
  OpenPropertyStore( stgmAccess, ppProperties);
  GetId(ppstrId);
  GetState(pdwState);
EndInterface


Declare  getendpointvolume(*endpointvolume)
Declare  freeendpointvolume(*endpointvolume.iaudioendpointvolume)
Declare  mediagetvolume()
Declare  mediasetvolume(vol)

MediaSetVolume(15) ; de 0 a 255







Procedure GetEndPointVolume(*endpointvolume)
  Protected deviceEnumerator.IMMDeviceEnumerator
  Protected hr, defaultDevice.IMMDevice

  CoInitialize_(#Null)

  hr = CoCreateInstance_(?uuidof_MMDeviceEnumerator, #Null, #CLSCTX_INPROC_SERVER, ?uuidof_IMMDeviceEnumerator,@deviceEnumerator);#CLSCTX_ALL

  hr = deviceEnumerator\GetDefaultAudioEndpoint(0, 1, @defaultDevice)
  deviceEnumerator\Release()

  hr = defaultDevice\Activate(?uuidof_IAudioEndpointVolume, #CLSCTX_INPROC_SERVER, #Null, *endpointVolume);
  defaultDevice\release()

  ProcedureReturn *endpointvolume
EndProcedure

Procedure FreeEndPointVolume(*endpointvolume.IAudioEndpointVolume)
  *endpointvolume\release()
  CoUninitialize_()
EndProcedure

Procedure MediaGetVolume()
  Protected Volume.IAudioEndpointVolume
  Protected volf.f

  GetEndPointVolume(@Volume)
  Volume\GetMasterVolumeLevelScalar(@volf)
  volf = Round(volf * 100, #PB_Round_Nearest)
  FreeEndPointVolume(Volume)
  ProcedureReturn Int(volf)
EndProcedure

Procedure MediaSetVolume(vol)
  Protected Volume.IAudioEndpointVolume
  Protected volf.f
  If vol < 0 : vol = 0 : EndIf
  If vol > 100 : vol = 100 : EndIf
  GetEndPointVolume(@Volume)
  volf = vol / 100
  Volume\SetMasterVolumeLevelScalar(volf, #Null)
  FreeEndPointVolume(Volume)
EndProcedure

DataSection
  uuidof_IAudioEndpointVolume:
  Data.l $5CDF2C82
  Data.w $841E,$4546
  Data.b $97,$22,$0C,$F7,$40,$78,$22,$9A

  uuidof_MMDeviceEnumerator:
  Data.l $BCDE0395
  Data.w $E52F,$467C
  Data.b $8E,$3D,$C4,$57,$92,$91,$69,$2E

  uuidof_IMMDeviceEnumerator:
  Data.l $A95664D2
  Data.w $9614
  Data.w $4F35
  Data.b $A7,$46,$DE,$8D,$B6,$36,$17,$E6

EndDataSection
; IDE Options = PureBasic 5.41 LTS (Windows - x64)
; CursorPosition = 57
; Folding = -
; EnableUnicode
; EnableThread
; EnableXP
; CompileSourceDirectory

[Micoute]

J'ai trouvé (mais pas testé) ça : http://www.purebasic.fr/english/viewtop ... ead#unread

Et ça fonctionne même très bien, mais il ne faut pas que les amplitudes de son soient trop élevés, car ça règle juste le niveau général !

[Zorro]

code complet pour contrôler le mixer

http://forums.purebasic.com/english/vie ... 4a11ebbdd9