[fpc-pascal] Windows Volume Control

[Marc Weustink]

On 15-1-2022 19:02, James Richters via fpc-pascal 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;