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;
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
