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.
Recent
