Set Master/Mic Volume

[remi_meier]

Hab ich schnell von hier übertragen:
http://support.microsoft.com/kb/178456/de

Man kann die totale Lautstärke (Summe) und die Mikrofonlautstärke
setzen.

Code: Alles auswählen

EnableExplicit


Structure MIXERCONTROL 
  cbStruct.l 
  dwControlID.l
  dwControlType.l 
  fdwControl.l
  cMultipleItems.l
  szShortName.s{#MIXER_SHORT_NAME_CHARS}
  szName.s{#MIXER_LONG_NAME_CHARS}
  
  lMinimum.l
  lMaximum.l
  dwReserved.l[10] 
EndStructure



Procedure GetVolumeControl(hmixer.l, componentType.l, ctrlType.l, *mxc.MIXERCONTROL)
  Protected mxlc.MIXERLINECONTROLS, mxl.MIXERLINE
  Protected hmem.l, rc.l, ret.l
  
  mxl\cbStruct = SizeOf(mxl)
  mxl\dwComponentType = componentType
  
  rc = mixerGetLineInfo_(hmixer, mxl, #MIXER_GETLINEINFOF_COMPONENTTYPE)
  If #MMSYSERR_NOERROR = rc
    mxlc\cbStruct = SizeOf(mxlc)
    mxlc\dwLineID = mxl\dwLineID
    mxlc\dwControlType = ctrlType
    mxlc\cControls = 1
    mxlc\cbmxctrl = SizeOf(MIXERCONTROL)
    
    hmem = GlobalAlloc_($40, SizeOf(MIXERCONTROL))
    mxlc\pamxctrl = GlobalLock_(hmem)
    *mxc\cbStruct = SizeOf(MIXERCONTROL) ; oder sizeof)*mxc( ??
    
    
    rc = mixerGetLineControls_(hmixer, @mxlc, #MIXER_GETLINECONTROLSF_ONEBYTYPE)
    If rc = #MMSYSERR_NOERROR
      ret = #True
      CopyMemory(mxlc\pamxctrl, *mxc, SizeOf(MIXERCONTROL))
    Else
      ret = #False
    EndIf
    GlobalFree_(hmem)
    ProcedureReturn ret
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetVolumeControl(hmixer.l, *mxc.MIXERCONTROL, volume.l)
  Protected mxcd.MIXERCONTROLDETAILS
  Protected vol.MIXERCONTROLDETAILS_UNSIGNED
  Protected hmem.l, rc.l
  
  mxcd\item = 0
  mxcd\dwControlID = *mxc\dwControlID
  mxcd\cbStruct = SizeOf(mxcd)
  mxcd\cbDetails = SizeOf(vol)
  
  hmem = GlobalAlloc_($40, SizeOf(vol))
  mxcd\paDetails = GlobalLock_(hmem)
  mxcd\cChannels = 1
  vol\dwValue = volume
  
  CopyMemory(@vol, mxcd\paDetails, SizeOf(vol))
  rc = mixerSetControlDetails_(hmixer, @mxcd, #MIXER_SETCONTROLDETAILSF_VALUE)
  GlobalFree_(hmem)
  If #MMSYSERR_NOERROR = rc
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure



Global hmixer.l, volCtrl.MIXERCONTROL, micCtrl.MIXERCONTROL
Global rc.l, ok.l

Procedure Load()
  rc = mixerOpen_(@hmixer, 0, 0, 0, 0)
  If rc <> #MMSYSERR_NOERROR
    MessageRequester("shit", "Could not open the mixer!")
    ProcedureReturn
  EndIf
  
  If GetVolumeControl(hmixer, #MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, #MIXERCONTROL_CONTROLTYPE_VOLUME, @volCtrl)
    Debug "# "+volCtrl\szName+":"
    Debug "Minimum: " + Str(volCtrl\lMinimum)
    Debug "Maximum: " + Str(volCtrl\lMaximum)
  EndIf
  
  If GetVolumeControl(hmixer, #MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, #MIXERCONTROL_CONTROLTYPE_VOLUME, @micCtrl)
    Debug "# "+micCtrl\szName+":"
    Debug "Minimum: " + Str(micCtrl\lMinimum)
    Debug "Maximum: " + Str(micCtrl\lMaximum)
  EndIf
  
  If SetVolumeControl(hmixer, volCtrl, 20)
    Debug "Set to 20"
  EndIf
EndProcedure


Load()

Setzt die Lautstärke auf 20 (kaum hörbar).

[dige]

Hallo Remi, vielen Dank für den Tipp. Allerdings ist bei beim setzen der
Laustärke immer ein kurzes Knackgeräusch zu hören. Ist das vielleicht
nur hier so ( WinXP_SP2, Asus Onboard Sound )?

[bingo]

funktioniert leider nicht mehr unter VISTA , da hier jede anwendung einen "eigenen" regler bekommt . man regelt also hier nur die lautstärke der eigenen anwendung .

unter vista ...
http://msdn2.microsoft.com/en-gb/library/ms679147.aspx

wie das aber in PB zu machen ist , weiss ich leider noch nicht

[edel]

Hab hier kein 'knacken'.

>>Setzt die Lautstärke auf 20 (kaum hörbar).

Hoert da noch jemand was , und was ist max ?

[dige]

funktioniert leider nicht mehr unter VISTA , da hier jede anwendung einen "eigenen" regler bekommt . man regelt also hier nur die lautstärke der eigenen anwendung .

Wird denn zumindest noch die Lautstärke der eigenen Anwendung geändert
oder funktioniert das überhaupt nicht mehr?

@Edel: Lautstärke 0.. $FFFF (max)

[wasser]

habt ihr schon die ersten kopien von VISTA ?

[hardfalcon]

Es gibt auch Vista RC1, die man eine zeit lang bei Microsoft kostenlos runterladen konnte...
Ich glaub, ich hol gleich den Putzlappen...