Recent

Author Topic: SystemVolume, Volume Mixer [MasterVolume, MasterMute, WaveOut] (MajorVer < 6)  (Read 2151 times)

RAW

  • Hero Member
  • *****
  • Posts: 755
MasterVolume.. SystemVolume on older Windows-Systems for example XP...
(Every Windows-System that uses MMSYSTEM)

Code: Pascal  [Select]
  1. Unit uTestXPMixer;
  2.  {$MODE OBJFPC}{$H+}
  3.  
  4. Interface
  5.  USES
  6.   Classes,  SysUtils, Forms,
  7.   Controls, MMSystem, StdCtrls,
  8.   Windows,  ExtCtrls;
  9.  
  10.  TYPE
  11.   TwndGUI = Class(TForm)
  12.  
  13.    labMute  : TLabel;
  14.    labVolume: TLabel;
  15.  
  16.    Button1  : TButton;
  17.    Button2  : TButton;
  18.  
  19.    tiMute   : TTimer;
  20.  
  21.    Function  SetMixerValue(dwCompType, dwControl: DWORD; wVal: WORD): MMResult;
  22.    Function  GetMixerValue(dwCompType, dwControl: DWORD): WORD;
  23.    Procedure SetMixerMute (dwCompType, dwControl: DWORD; booSet: Boolean);
  24.  
  25.    Procedure FormKeyDown  (Sender: TObject; Var Key: Word;
  26.                            Shift : TShiftState);
  27.    Procedure tiMuteTimer  (Sender: TObject);
  28.    Procedure Button1Click (Sender: TObject);
  29.    Procedure Button2Click (Sender: TObject);
  30.   End;
  31.  
  32.  VAR
  33.   wndGUI: TwndGUI;
  34.  
  35. Implementation
  36.  {$R *.LFM}
  37.  
  38.  
  39. Function TwndGUI.GetMixerValue(dwCompType, dwControl: DWORD): WORD;
  40.   Var
  41.    hMix   : HMixer;
  42.    mxlc   : TMixerLineControls;
  43.    mxcd   : TMixerControlDetails;
  44.    mxcd_u : TMixerControlDetails_Unsigned;
  45.    mxc    : TMixerControl;
  46.    mxl    : TMixerLine;
  47.    iResMix: Integer;
  48.  Begin
  49.   iResMix:= MixerOpen(@hMix, 0, 0, 0, 0);
  50.  
  51.   If iResMix <> MMSYSERR_NOERROR
  52.   Then
  53.    Begin
  54.     //Log('wndGUI.GetMixerValue.OpenMixer', True);
  55.     Exit;
  56.    End;
  57.  
  58.   Try
  59.    mxl.dwComponentType:= dwCompType;
  60.    mxl.cbStruct       := SizeOf(mxl);
  61.  
  62.    iResMix:= MixerGetLineInfo(
  63.               hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  64.  
  65.    If iResMix <> MMSYSERR_NOERROR
  66.    Then
  67.     Begin
  68.      //Log('wndGUI.GetMixerValue.GetLineInfo', True);
  69.      Exit;
  70.     End;
  71.  
  72.    FillChar(mxlc, SizeOf(mxlc), 0);
  73.  
  74.    mxlc.cbStruct     := SizeOf(mxlc);
  75.    mxlc.dwLineID     := mxl.dwLineID;
  76.    mxlc.dwControlType:= dwControl;
  77.    mxlc.cControls    := 1;
  78.    mxlc.cbmxCtrl     := SizeOf(mxc);
  79.    mxlc.pamxCtrl     := @mxc;
  80.  
  81.    iResMix:= MixerGetLineControls(
  82.               hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
  83.  
  84.    If iResMix <> MMSYSERR_NOERROR
  85.    Then
  86.     Begin
  87.      //Log('wndGUI.GetMixerValue.GetLineControls', True);
  88.      Exit;
  89.     End;
  90.  
  91.    FillChar(mxcd, SizeOf(mxcd), 0);
  92.  
  93.    mxcd.dwControlID   := mxc.dwControlID;
  94.    mxcd.cbStruct      := SizeOf(mxcd);
  95.    mxcd.cMultipleItems:= 0;
  96.    mxcd.cbDetails     := SizeOf(mxcd_u);
  97.    mxcd.paDetails     := @mxcd_u;
  98.    mxcd.cChannels     := 1;
  99.  
  100.    iResMix:= MixerGetControlDetails(
  101.               hMix, @mxcd, MIXER_GETCONTROLDETAILSF_VALUE);
  102.  
  103.    If iResMix <> MMSYSERR_NOERROR
  104.    Then //Log('wndGUI.GetMixerValue.GetControlDetails', True)
  105.    Else Result:= mxcd_u.dwValue;
  106.   Finally
  107.    iResMix:= MixerClose(hMix);
  108.   End;
  109.  End;
  110.  
  111.  
  112. Function TwndGUI.SetMixerValue(
  113.                   dwCompType, dwControl: DWORD; wVal: WORD): MMResult;
  114.   Var
  115.    hMix  : HMixer;
  116.    mxcd_u: TMixerControlDetails_Unsigned;
  117.    mxl   : TMixerLine;
  118.    mxlc  : TMixerLineControls;
  119.    mxc   : TMixerControl;
  120.    mxcd  : TMixerControlDetails;
  121.  Begin
  122.   Result:= MixerOpen(@hMix, 0, 0, 0, 0);
  123.  
  124.   If Result <> MMSYSERR_NOERROR
  125.   Then
  126.    Begin
  127.     //Log('wndGUI.SetMixerValue.OpenMixer', True);
  128.     Exit;
  129.    End;
  130.  
  131.   Try
  132.    FillChar(mxl, SizeOf(TMixerLine), 0);
  133.  
  134.    mxl.cbStruct       := SizeOf(TMixerLine);
  135.    mxl.dwComponentType:= dwCompType;
  136.  
  137.    Result:= MixerGetLineInfo(
  138.              hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  139.  
  140.    If Result <> MMSYSERR_NOERROR
  141.    Then
  142.     Begin
  143.      //Log('wndGUI.SetMixerValue.GetLineInfo', True);
  144.      Exit;
  145.     End;
  146.  
  147.    FillChar(mxc, SizeOf(TMixerControl), 0);
  148.  
  149.    mxlc.cbStruct     := SizeOf(TMixerLineControls);
  150.    mxlc.dwLineID     := mxl.dwLineID;
  151.    mxlc.dwControlType:= dwControl;
  152.    mxlc.cControls    := 1;
  153.    mxlc.cbmxCtrl     := SizeOf(TMixerControl);
  154.    mxlc.pamxCtrl     := @mxc;
  155.  
  156.    Result:= MixerGetLineControls(
  157.              hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
  158.  
  159.    If Result <> MMSYSERR_NOERROR
  160.    Then
  161.     Begin
  162.      //Log('wndGUI.SetMixerValue.GetLineControls', True);
  163.      Exit;
  164.     End;
  165.  
  166.    FillChar(mxcd, SizeOf(TMixerControlDetails), 0);
  167.  
  168.    mxcd.cbStruct      := SizeOf(TMixerControlDetails);
  169.    mxcd.dwControlID   := mxc.dwControlID;
  170.    mxcd.cChannels     := 1;
  171.    mxcd.cMultipleItems:= 0;
  172.    mxcd.cbDetails     := SizeOf(TMixerControlDetails_Unsigned);
  173.    mxcd.paDetails     := @mxcd_u;
  174.  
  175.    mxcd_u.dwValue:= wVal;
  176.  
  177.    Result:= MixerSetControlDetails(
  178.              hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
  179.  
  180.    //If Result <> MMSYSERR_NOERROR
  181.    //Then Log('wndGUI.SetMixerValue.SetControlDetails', True);
  182.   Finally
  183.    MixerClose(hMix);
  184.   End;
  185.  End;
  186.  
  187.  
  188. Procedure TwndGUI.SetMixerMute(dwCompType, dwControl: DWORD; booSet: Boolean);
  189.   Var
  190.    hMix   : HMixer;
  191.    mxlc   : TMixerLineControls;
  192.    mxcd   : TMixerControlDetails;
  193.    mxcd_b : TMixerControlDetails_Boolean;
  194.    mxc    : TMixerControl;
  195.    mxl    : TMixerLine;
  196.    iResMix: Integer;
  197.  Begin
  198.   iResMix:= MixerOpen(@hMix, 0, 0, 0, 0);
  199.  
  200.   If iResMix <> MMSYSERR_NOERROR
  201.   Then
  202.    Begin
  203.     //Log('wndGUI.SetMixerMute.OpenMixer', True);
  204.     Exit;
  205.    End;
  206.  
  207.   Try
  208.    mxl.dwComponentType:= dwCompType;
  209.    mxl.cbStruct       := SizeOf(mxl);
  210.  
  211.    iResMix:= MixerGetLineInfo(
  212.               hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  213.  
  214.    If iResMix <> MMSYSERR_NOERROR
  215.    Then
  216.     Begin
  217.      //Log('wndGUI.SetMixerMute.GetLineInfo', True);
  218.      Exit;
  219.     End;
  220.  
  221.    FillChar(mxlc, SizeOf(mxlc), 0);
  222.  
  223.    mxlc.cbStruct     := SizeOf(mxlc);
  224.    mxlc.dwLineID     := mxl.dwLineID;
  225.    mxlc.dwControlType:= dwControl;
  226.    mxlc.cControls    := 1;
  227.    mxlc.cbmxCtrl     := SizeOf(mxc);
  228.    mxlc.pamxCtrl     := @mxc;
  229.  
  230.    iResMix:= MixerGetLineControls(
  231.               hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
  232.  
  233.    If iResMix <> MMSYSERR_NOERROR
  234.    Then
  235.     Begin
  236.      //Log('wndGUI.SetMixerMute.GetLineControls', True);
  237.      Exit;
  238.     End;
  239.  
  240.    FillChar(mxcd, SizeOf(mxcd),0);
  241.  
  242.    mxcd.cbStruct   := SizeOf(TMIXERCONTROLDETAILS);
  243.    mxcd.dwControlID:= mxc.dwControlID;
  244.    mxcd.cChannels  := 1;
  245.    mxcd.cbDetails  := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
  246.    mxcd.paDetails  := @mxcd_b;
  247.    mxcd_b.fValue   := Ord(booSet);
  248.  
  249.    iResMix:= MixerSetControlDetails(
  250.               hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
  251.  
  252.    //If iResMix <> MMSYSERR_NOERROR
  253.    //Then Log('wndGUI.SetMixerMute.SetControlDetails', True);
  254.   Finally
  255.    iResMix:= MixerClose(hMix);
  256.   End;
  257.  End;
  258.  
  259.  
  260. Procedure TwndGUI.FormKeyDown(Sender: TObject; Var Key: Word;
  261.                               Shift : TShiftState);
  262.   Var
  263.    wVol: WORD;
  264.  Begin
  265.   // MUTE
  266.   If Key = Ord('M')
  267.   Then SendMessageW(Handle, $319, Handle, $80000);
  268.  
  269.   // MIXER
  270.   If Key = Ord('V')
  271.   Then ShellExecute(0, Nil, PChar('sndvol32.exe'), '', '', SW_SHOWNORMAL);
  272.  
  273.   // VOLUME DOWN
  274.   If Key = VK_DOWN
  275.   Then
  276.    Begin
  277.     wVol:= GetMixerValue(
  278.             MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  279.             MIXERCONTROL_CONTROLTYPE_VOLUME);
  280.  
  281.     If (wVol-1000) < 0
  282.     Then wVol:= 0
  283.     Else wVol:= wVol-1000;
  284.  
  285.     SetMixerValue(
  286.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  287.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  288.      wVol);
  289.    End;
  290.  
  291.   // VOLUME UP
  292.   If Key = VK_UP
  293.   Then
  294.    Begin
  295.     wVol:= GetMixerValue(
  296.             MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  297.             MIXERCONTROL_CONTROLTYPE_VOLUME);
  298.  
  299.     If (65535-wVol) < 1000
  300.     Then wVol:= 65535
  301.     Else wVol:= wVol+1000;
  302.  
  303.     SetMixerValue(
  304.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  305.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  306.      wVol);
  307.    End;
  308.  
  309.   // VOLUME 20%
  310.   If (Key = Ord('2'))
  311.   Then
  312.    Begin
  313.     SetMixerValue(
  314.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  315.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  316.      13107);
  317.    End;
  318.  
  319.   // VOLUME 70%
  320.   If (Key = Ord('7'))
  321.   Then
  322.    Begin
  323.     SetMixerValue(
  324.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  325.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  326.      45875);
  327.    End;
  328.  
  329.   // VOLUME MAX (AMP MODE)
  330.   If Key = VK_F8
  331.   Then
  332.    Begin
  333.     SetMixerMute(
  334.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  335.      MIXERCONTROL_CONTROLTYPE_MUTE,
  336.      False);
  337.  
  338.     SetMixerMute(
  339.      MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,
  340.      MIXERCONTROL_CONTROLTYPE_MUTE,
  341.      False);
  342.  
  343.     SetMixerValue(
  344.      MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  345.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  346.      65535);
  347.  
  348.     SetMixerValue(
  349.      MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,
  350.      MIXERCONTROL_CONTROLTYPE_VOLUME,
  351.      65535);
  352.    End;
  353.  End;
  354.  
  355.  
  356. Procedure TwndGUI.tiMuteTimer(Sender: TObject);
  357.   Var
  358.    wMasterMute : WORD;
  359.    wWaveOutMute: WORD;
  360.    booCheckMute: Boolean;
  361.  Begin
  362.   wMasterMute := GetMixerValue(
  363.                   MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  364.                   MIXERCONTROL_CONTROLTYPE_MUTE);
  365.   wWaveOutMute:= GetMixerValue(
  366.                   MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,
  367.                   MIXERCONTROL_CONTROLTYPE_MUTE);
  368.  
  369.    If (wMasterMute = 1) Or (wWaveOutMute = 1)
  370.    Then booCheckMute:= True;
  371.  
  372.    If (wMasterMute = 0) And (wWaveOutMute = 0)
  373.    Then booCheckMute:= False;
  374.  
  375.   If booCheckMute
  376.   Then labMute.Caption:= 'MUTE: ON'
  377.   Else labMute.Caption:= 'MUTE: OFF';
  378.  End;
  379.  
  380.  
  381. Procedure TwndGUI.Button1Click(Sender: TObject);
  382.   Var
  383.    wVol: WORD;
  384.  Begin
  385.   // GetMasterVolume
  386.   wVol:= GetMixerValue(
  387.           MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
  388.           MIXERCONTROL_CONTROLTYPE_VOLUME);
  389.  
  390.   labVolume.Caption:= 'MasterVolume: '+IntToStr(Round(wVol*100/65535));
  391.  End;
  392.  
  393.  
  394. Procedure TwndGUI.Button2Click(Sender: TObject);
  395.   Var
  396.    wVol: WORD;
  397.  Begin
  398.   // GetWaveOutVolume
  399.   wVol:= GetMixerValue(
  400.           MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,
  401.           MIXERCONTROL_CONTROLTYPE_VOLUME);
  402.  
  403.   labVolume.Caption:= 'WaveOutVolume: '+IntToStr(Round(wVol*100/65535));
  404.  End;
  405.  
  406. End.
  407.  
« Last Edit: March 23, 2017, 09:44:07 pm by RAW »
Windows 7 Pro (x64 Sp1) And Windows XP Pro (x86 Sp3) - LAZARUS 2.0.2 FPC 3.0.4 - TRUNK 2.1.0 FPC 3.3.1