SystemVolume, Volume Mixer [MasterVolume, MasterMute, WaveOut]
(MajorVer < 6)
lazarus / 34-Windows

----------------------------------------------------------------------
RAW · 2017-02-14 22:17

MasterVolume.. SystemVolume on older Windows-Systems for example XP...
(Every Windows-System that uses MMSYSTEM)

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Unit
uTestXPMixer; {$MODE OBJFPC}{$H+} Interface USES  Classes,  SysUtils,
Forms,  Controls, MMSystem, StdCtrls,  Windows,  ExtCtrls;  TYPE 
TwndGUI = Class(TForm)    labMute  : TLabel;   labVolume: TLabel;  
 Button1  : TButton;   Button2  : TButton;    tiMute   : TTimer;  
 Function  SetMixerValue(dwCompType, dwControl: DWORD; wVal: WORD):
MMResult;   Function  GetMixerValue(dwCompType, dwControl: DWORD):
WORD;   Procedure SetMixerMute (dwCompType, dwControl: DWORD; booSet:
Boolean);    Procedure FormKeyDown  (Sender: TObject; Var Key: Word; 
                        Shift : TShiftState);   Procedure tiMuteTimer
 (Sender: TObject);   Procedure Button1Click (Sender: TObject); 
 Procedure Button2Click (Sender: TObject);  End;  VAR  wndGUI:
TwndGUI; Implementation {$R *.LFM}  Function
TwndGUI.GetMixerValue(dwCompType, dwControl: DWORD): WORD;  Var   hMix
  : HMixer;   mxlc   : TMixerLineControls;   mxcd   :
TMixerControlDetails;   mxcd_u : TMixerControlDetails_Unsigned;   mxc
  : TMixerControl;   mxl    : TMixerLine;   iResMix: Integer; Begin 
iResMix:= MixerOpen(@hMix, 0, 0, 0, 0);   If iResMix <>
MMSYSERR_NOERROR  Then   Begin   
//Log('wndGUI.GetMixerValue.OpenMixer', True);    Exit;   End;   Try 
 mxl.dwComponentType:= dwCompType;   mxl.cbStruct       :=
SizeOf(mxl);    iResMix:= MixerGetLineInfo(              hMix, @mxl,
MIXER_GETLINEINFOF_COMPONENTTYPE);    If iResMix <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.GetMixerValue.GetLineInfo', True);  
 Exit;    End;    FillChar(mxlc, SizeOf(mxlc), 0);    mxlc.cbStruct  
 := SizeOf(mxlc);   mxlc.dwLineID     := mxl.dwLineID; 
 mxlc.dwControlType:= dwControl;   mxlc.cControls    := 1; 
 mxlc.cbmxCtrl     := SizeOf(mxc);   mxlc.pamxCtrl     := @mxc;  
 iResMix:= MixerGetLineControls(              hMix, @mxlc,
MIXER_GETLINECONTROLSF_ONEBYTYPE);    If iResMix <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.GetMixerValue.GetLineControls',
True);     Exit;    End;    FillChar(mxcd, SizeOf(mxcd), 0);  
 mxcd.dwControlID   := mxc.dwControlID;   mxcd.cbStruct      :=
SizeOf(mxcd);   mxcd.cMultipleItems:= 0;   mxcd.cbDetails     :=
SizeOf(mxcd_u);   mxcd.paDetails     := @mxcd_u;   mxcd.cChannels    
:= 1;    iResMix:= MixerGetControlDetails(              hMix, @mxcd,
MIXER_GETCONTROLDETAILSF_VALUE);    If iResMix <> MMSYSERR_NOERROR 
 Then //Log('wndGUI.GetMixerValue.GetControlDetails', True)   Else
Result:= mxcd_u.dwValue;  Finally   iResMix:= MixerClose(hMix); 
End; End;  Function TwndGUI.SetMixerValue(                 
dwCompType, dwControl: DWORD; wVal: WORD): MMResult;  Var   hMix  :
HMixer;   mxcd_u: TMixerControlDetails_Unsigned;   mxl   :
TMixerLine;   mxlc  : TMixerLineControls;   mxc   : TMixerControl; 
 mxcd  : TMixerControlDetails; Begin  Result:= MixerOpen(@hMix, 0, 0,
0, 0);   If Result <> MMSYSERR_NOERROR  Then   Begin   
//Log('wndGUI.SetMixerValue.OpenMixer', True);    Exit;   End;   Try 
 FillChar(mxl, SizeOf(TMixerLine), 0);    mxl.cbStruct       :=
SizeOf(TMixerLine);   mxl.dwComponentType:= dwCompType;    Result:=
MixerGetLineInfo(             hMix, @mxl,
MIXER_GETLINEINFOF_COMPONENTTYPE);    If Result <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.SetMixerValue.GetLineInfo', True);  
 Exit;    End;    FillChar(mxc, SizeOf(TMixerControl), 0);  
 mxlc.cbStruct     := SizeOf(TMixerLineControls);   mxlc.dwLineID    
:= mxl.dwLineID;   mxlc.dwControlType:= dwControl;   mxlc.cControls  
 := 1;   mxlc.cbmxCtrl     := SizeOf(TMixerControl);   mxlc.pamxCtrl 
  := @mxc;    Result:= MixerGetLineControls(             hMix, @mxlc,
MIXER_GETLINECONTROLSF_ONEBYTYPE);    If Result <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.SetMixerValue.GetLineControls',
True);     Exit;    End;    FillChar(mxcd,
SizeOf(TMixerControlDetails), 0);    mxcd.cbStruct      :=
SizeOf(TMixerControlDetails);   mxcd.dwControlID   :=
mxc.dwControlID;   mxcd.cChannels     := 1;   mxcd.cMultipleItems:=
0;   mxcd.cbDetails     := SizeOf(TMixerControlDetails_Unsigned); 
 mxcd.paDetails     := @mxcd_u;    mxcd_u.dwValue:= wVal;    Result:=
MixerSetControlDetails(             hMix, @mxcd,
MIXER_SETCONTROLDETAILSF_VALUE);    //If Result <> MMSYSERR_NOERROR 
 //Then Log('wndGUI.SetMixerValue.SetControlDetails', True);  Finally 
 MixerClose(hMix);  End; End;  Procedure
TwndGUI.SetMixerMute(dwCompType, dwControl: DWORD; booSet: Boolean); 
Var   hMix   : HMixer;   mxlc   : TMixerLineControls;   mxcd   :
TMixerControlDetails;   mxcd_b : TMixerControlDetails_Boolean;   mxc 
 : TMixerControl;   mxl    : TMixerLine;   iResMix: Integer; Begin 
iResMix:= MixerOpen(@hMix, 0, 0, 0, 0);   If iResMix <>
MMSYSERR_NOERROR  Then   Begin   
//Log('wndGUI.SetMixerMute.OpenMixer', True);    Exit;   End;   Try 
 mxl.dwComponentType:= dwCompType;   mxl.cbStruct       :=
SizeOf(mxl);    iResMix:= MixerGetLineInfo(              hMix, @mxl,
MIXER_GETLINEINFOF_COMPONENTTYPE);    If iResMix <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.SetMixerMute.GetLineInfo', True);   
 Exit;    End;    FillChar(mxlc, SizeOf(mxlc), 0);    mxlc.cbStruct  
 := SizeOf(mxlc);   mxlc.dwLineID     := mxl.dwLineID; 
 mxlc.dwControlType:= dwControl;   mxlc.cControls    := 1; 
 mxlc.cbmxCtrl     := SizeOf(mxc);   mxlc.pamxCtrl     := @mxc;  
 iResMix:= MixerGetLineControls(              hMix, @mxlc,
MIXER_GETLINECONTROLSF_ONEBYTYPE);    If iResMix <> MMSYSERR_NOERROR 
 Then    Begin     //Log('wndGUI.SetMixerMute.GetLineControls',
True);     Exit;    End;    FillChar(mxcd, SizeOf(mxcd),0);  
 mxcd.cbStruct   := SizeOf(TMIXERCONTROLDETAILS);   mxcd.dwControlID:=
mxc.dwControlID;   mxcd.cChannels  := 1;   mxcd.cbDetails  :=
SizeOf(MIXERCONTROLDETAILS_BOOLEAN);   mxcd.paDetails  := @mxcd_b; 
 mxcd_b.fValue   := Ord(booSet);    iResMix:= MixerSetControlDetails( 
            hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);    //If
iResMix <> MMSYSERR_NOERROR   //Then
Log('wndGUI.SetMixerMute.SetControlDetails', True);  Finally 
 iResMix:= MixerClose(hMix);  End; End;  Procedure
TwndGUI.FormKeyDown(Sender: TObject; Var Key: Word;                  
          Shift : TShiftState);  Var   wVol: WORD; Begin  // MUTE  If
Key = Ord('M')  Then SendMessageW(Handle, $319, Handle, $80000);   //
MIXER  If Key = Ord('V')  Then ShellExecute(0, Nil,
PChar('sndvol32.exe'), '', '', SW_SHOWNORMAL);   // VOLUME DOWN  If
Key = VK_DOWN  Then   Begin    wVol:= GetMixerValue(           
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,           
MIXERCONTROL_CONTROLTYPE_VOLUME);     If (wVol-1000) < 0    Then
wVol:= 0    Else wVol:= wVol-1000;     SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     wVol);   End;   // VOLUME UP  If
Key = VK_UP  Then   Begin    wVol:= GetMixerValue(           
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,           
MIXERCONTROL_CONTROLTYPE_VOLUME);     If (65535-wVol) < 1000    Then
wVol:= 65535    Else wVol:= wVol+1000;     SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     wVol);   End;   // VOLUME 20% 
If (Key = Ord('2'))  Then   Begin    SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     13107);   End;   // VOLUME 70% 
If (Key = Ord('7'))  Then   Begin    SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     45875);   End;   // VOLUME MAX
(AMP MODE)  If Key = VK_F8  Then   Begin    SetMixerMute(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_MUTE,     False);     SetMixerMute(   
 MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,   
 MIXERCONTROL_CONTROLTYPE_MUTE,     False);     SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     65535);     SetMixerValue(   
 MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,   
 MIXERCONTROL_CONTROLTYPE_VOLUME,     65535);   End; End;  Procedure
TwndGUI.tiMuteTimer(Sender: TObject);  Var   wMasterMute : WORD; 
 wWaveOutMute: WORD;   booCheckMute: Boolean; Begin  wMasterMute :=
GetMixerValue(                  MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, 
                MIXERCONTROL_CONTROLTYPE_MUTE);  wWaveOutMute:=
GetMixerValue(                  MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, 
               MIXERCONTROL_CONTROLTYPE_MUTE);    If (wMasterMute = 1)
Or (wWaveOutMute = 1)   Then booCheckMute:= True;    If (wMasterMute =
0) And (wWaveOutMute = 0)   Then booCheckMute:= False;   If
booCheckMute  Then labMute.Caption:= 'MUTE: ON'  Else
labMute.Caption:= 'MUTE: OFF'; End;  Procedure
TwndGUI.Button1Click(Sender: TObject);  Var   wVol: WORD; Begin  //
GetMasterVolume  wVol:= GetMixerValue(         
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,         
MIXERCONTROL_CONTROLTYPE_VOLUME);   labVolume.Caption:= 'MasterVolume:
'+IntToStr(Round(wVol*100/65535)); End;  Procedure
TwndGUI.Button2Click(Sender: TObject);  Var   wVol: WORD; Begin  //
GetWaveOutVolume  wVol:= GetMixerValue(         
MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,         
MIXERCONTROL_CONTROLTYPE_VOLUME);   labVolume.Caption:=
'WaveOutVolume: '+IntToStr(Round(wVol*100/65535)); End; End.