Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-pascal / 2022-01

Windows Volume Control

2 messages · 2 people · –

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

James Richters

Are there functions to check the current volume level and to set the volume with just FPC (not Lazarus) on Windows 10?
All I need is the master system volume, not any of the mixer controls.

James

Reply by email

Marc Weustink
to James Richters
James Richters wrote
Are there functions to check the current volume level and to set the volume with just FPC (not Lazarus) on Windows 10? All I need is the master system volume, not any of the mixer controls.

This is possible. Please be aware that you can have multiple mixers and that the presence of the master volume is defined by the audio driver of the specific device (for a headset you may need to control the wave out).

The following are more or less the routines I use. Other application logic is stripped, so it won't compile, but it should give you an idea. This code is used in a context where we can control multiple mixers, having different left/right volumes (hence the search for a specific name and a volume array)

Marc

function Initialize: Boolean;
var
   n, maxlen, MixerId: Integer;
   woc: TWaveOutCaps;
   Search, Name: String;
   nDest: Integer;
   mmr: MMRESULT;
   mxcaps: TMixerCaps;
   mxl, mxlsrc: TMixerLine;
   mxlc: TMixerLineControls;
   mxc: TMixerControl;
begin
   Result := False;
   // == setup volumes ===========================
   MixerId := -1;
   // only compare the first wic.szPname -1 (==0) len characters,
info.name can be longer
   maxlen := SizeOf(woc.szPname) - 1;
   Search := Trim(Copy(FName, 1, maxlen));
   for n := 0 to Integer(waveOutGetNumDevs) - 1 do
   begin
     waveOutGetDevCaps(n, @woc, SizeOf(woc));
     Name := Trim(woc.szPname);
     if not SameText(Search, Name) then Continue;
     mixerGetID(n, Cardinal(MixerId), MIXER_OBJECTF_WAVEOUT);
     Break;
   end;
   if MixerID = -1 then Exit;
   // === controls ===============================
   mmr := mixerGetDevCaps(MixerID, @mxcaps, SizeOf(mxcaps));
   if mmr  MMSYSERR_NOERROR
   then begin
     Exit;
   end;
   if mxcaps.cDestinations = 0
   then begin
     Exit;
   end;
   mxl.cbStruct := SizeOf(mxl);
   for nDest := 0 to mxcaps.cDestinations - 1 do
   begin
     // loop through the mixer destinations to find a waveout type
     mxl.dwDestination := nDest;
     mxl.dwSource := 0;
     mxl.dwLineID := 0;
     mmr := mixerGetLineInfo(MixerID, @mxl, MIXER_OBJECTF_MIXER or
MIXER_GETLINEINFOF_DESTINATION);
     if mmr  0 then Continue;
     if mxl.Target.dwType  MIXERLINE_TARGETTYPE_WAVEOUT then Continue;
     // -- master Volume --
     if mxl.cControls > 0
     then begin
       mxlc.cbStruct := SizeOf(mxlc);
       mxlc.dwLineID := mxl.dwLineID;
       mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
       mxlc.cControls := 1;
       mxlc.pamxctrl := @mxc;
       mxlc.cbmxctrl := SizeOf(mxc);
       mmr := mixerGetLineControls(MixerID, @mxlc, MIXER_OBJECTF_MIXER
or MIXER_GETLINECONTROLSF_ONEBYTYPE);
       if mmr = MMSYSERR_NOERROR
       then begin
         // set master volume
         SetMixerControlVolume(MixerID, mxc, mxl.cChannels, FMasterVolume);
       end;
     end;
     // -- wave Volume --
     if mxl.cConnections > 0
     then begin
       mxlsrc.cbStruct := SizeOf(mxlsrc);
       mxlsrc.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
       mxlsrc.dwLineID := 0;
       mmr := mixerGetLineInfo(MixerID, @mxlsrc, MIXER_OBJECTF_MIXER or
MIXER_GETLINEINFOF_COMPONENTTYPE);
       if mmr = MMSYSERR_NOERROR
       then begin
         // get wave volume
         mxlc.cbStruct := SizeOf(mxlc);
         mxlc.dwLineID := mxlsrc.dwLineID;
         mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
         mxlc.cControls := 1;
         mxlc.cbmxctrl := SizeOf(mxc);
         mxlc.pamxctrl := @mxc;
         mmr := mixerGetLineControls(MixerID, @mxlc, MIXER_OBJECTF_MIXER
or MIXER_GETLINECONTROLSF_ONEBYTYPE);
         if mmr = MMSYSERR_NOERROR
         then begin
           // set wave volume
           SetMixerControlVolume(MixerID, mxc, mxlsrc.cChannels, FVolume);
         end;
       end;
     end;
     Break;
   end;
end;
procedure SetMixerControlVolume(AMixerID: Integer; AControl:
TMixerControl; AChannels: Cardinal; const AValues: array of Byte);
var
   mxcd: TMixerControlDetails;
   idx, c: integer;
   detailUnsigned: array of MIXERCONTROLDETAILS_UNSIGNED;
begin
   if AControl.cbStruct = 0 then Exit; // no volume
   if AControl.fdwControl and MIXERCONTROL_CONTROLF_UNIFORM  0
   then AChannels := 1;
   SetLength(detailUnsigned, AChannels);
   mxcd.cbStruct := SizeOf(mxcd);
   mxcd.dwControlID := AControl.dwControlID;
   mxcd.cChannels := AChannels;
   mxcd.cMultipleItems := 0;
   mxcd.cbDetails := SizeOf(detailUnsigned[0]);
   mxcd.paDetails := @detailUnsigned[0];
   mixerGetControlDetails(AMixerID, @mxcd, MIXER_GETCONTROLDETAILSF_VALUE);
   idx := 0;
   for c := 0 to AChannels - 1 do
   begin
     if idx < Length(AValues)
     then detailUnsigned[c].dwValue := MulDiv(AControl.Bounds.dwMaximum,
  AValues[idx] , 100)
     else detailUnsigned[c].dwValue := 0;
     if Length(AValues) > 1
     then Inc(idx);
   end;
   mixerSetControlDetails(AMixerID, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
end;

Reply by email