procedure TmainFrm.keyHook(
var msg: TMessage);
begin
case msg.LParam
of
VK_VOLUME_UP : g_mixer.volume := g_mixer.volume + 2048;
VK_VOLUME_DOWN: g_mixer.volume := g_mixer.volume - 2048;
VK_VOLUME_MUTE: g_mixer.muted :=
not g_mixer.muted;
end;
end;
//the volume range is 0 .. 65535; out of band values are silently corrected.
unit Mixer;
interface
type
Tmixer =
class
protected
function getMute: boolean;
virtual;
abstract;
function getVolume: integer;
virtual;
abstract;
procedure setVolume(Value: integer);
virtual;
abstract;
procedure setMute(Value: boolean);
virtual;
abstract;
public
property volume: integer
read getVolume
write setVolume;
property muted: boolean
read getMute
write setMute;
end;
function g_mixer: Tmixer;
implementation
uses
Windows, MMSystem, MMDevApi_tlb, ComObj,
ActiveX, SysUtils;
// ---------------------------------------------------------------------------
type
TxpMixer =
class(Tmixer)
private
Fmxct: integer;
Fmixer: HMIXER;
procedure chk(r: MMRESULT);
protected
function getMute: boolean;
override;
function getVolume: integer;
override;
procedure setVolume(Value: integer);
override;
procedure setMute(Value: boolean);
override;
public
constructor Create;
destructor Destroy;
override;
end;
TvistaMixer =
class(Tmixer)
private
FmmDev: IMMDevice;
FmmDevEnum: IMMDeviceEnumerator;
FmmEndpoint: IMMAudioEndpointVolume;
protected
function getMute: boolean;
override;
function getVolume: integer;
override;
procedure setVolume(Value: integer);
override;
procedure setMute(Value: boolean);
override;
public
constructor Create;
end;
// ---------------------------------------------------------------------------
var
_g_mixer: Tmixer;
function g_mixer: Tmixer;
var
VerInfo: TOSVersioninfo;
begin
if (_g_mixer =
nil)
then
begin
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(VerInfo);
if (VerInfo.dwMajorVersion >= 6)
then
_g_mixer := TvistaMixer.Create
else
_g_mixer := TxpMixer.Create;
end;
result := _g_mixer;
end;
// ---------------------------------------------------------------------------
{ TxpMixer }
procedure TxpMixer.chk(r: MMRESULT);
var
s:
string;
begin
if (r = MMSYSERR_NOERROR)
then
exit;
setLength(s, MMSystem.MAXERRORLENGTH + 1);
waveOutGetErrorText(r, @s[1], MMSystem.MAXERRORLENGTH);
raise Exception.Create(StrPas(pChar(s)));
end;
// ---------------------------------------------------------------------------
constructor TxpMixer.Create;
begin
Fmxct := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
chk(mixerOpen(@Fmixer, 0, 0, 0, 0));
end;
// ---------------------------------------------------------------------------
destructor TxpMixer.Destroy;
begin
if (Fmixer <> 0)
then
mixerClose(Fmixer);
inherited;
end;
// ---------------------------------------------------------------------------
function TxpMixer.getMute: boolean;
var
MasterMute: TMixerControl;
Details: TMixerControlDetails;
BoolDetails: TMixerControlDetailsBoolean;
Line: TMixerLine;
Controls: TMixerLineControls;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := Fmxct;
chk(mixerGetLineInfo(0, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE));
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
Controls.cbmxctrl := SizeOf(MasterMute);
Controls.pamxctrl := @MasterMute;
chk(mixerGetLineControls(0, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE));
Details.cbStruct := SizeOf(Details);
Details.dwControlID := MasterMute.dwControlID;
Details.cChannels := 1;
Details.cMultipleItems := 0;
Details.cbDetails := SizeOf(BoolDetails);
Details.paDetails := @BoolDetails;
chk(mixerGetControlDetails(0, @Details, MIXER_GETCONTROLDETAILSF_VALUE));
result := BoolDetails.fValue <> 0;
end;
// ---------------------------------------------------------------------------
function TxpMixer.getVolume: integer;
var
Line: TMixerLine;
Controls: TMixerLineControls;
MasterVolume: TMixerControl;
Details: TMixerControlDetails;
UnsignedDetails: TMixerControlDetailsUnsigned;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := Fmxct;
chk(mixerGetLineInfo(Fmixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE));
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(MasterVolume);
Controls.pamxctrl := @MasterVolume;
chk(mixerGetLineControls(Fmixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE));
details.cbStruct := SizeOf(Details);
details.dwControlID := MasterVolume.dwControlID;
details.cChannels := 1;
details.cMultipleItems := 0;
details.cbDetails := SizeOf(UnsignedDetails);
details.paDetails := @UnsignedDetails;
chk(mixerGetControlDetails(Fmixer, @Details, MIXER_GETCONTROLDETAILSF_VALUE));
result := UnsignedDetails.dwValue;
end;
// ---------------------------------------------------------------------------
procedure TxpMixer.setMute(Value: boolean);
var
Line: TMixerLine;
Controls: TMixerLineControls;
MasterMute: TMixerControl;
Details: TMixerControlDetails;
BoolDetails: TMixerControlDetailsBoolean;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := Fmxct;
chk(mixerGetLineInfo(Fmixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE));
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
Controls.cbmxctrl := SizeOf(masterMute);
Controls.pamxctrl := @masterMute;
chk(mixerGetLineControls(Fmixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE));
details.cbStruct := SizeOf(Details);
details.dwControlID := MasterMute.dwControlID;
details.cChannels := 1;
details.cMultipleItems := 0;
details.cbDetails := SizeOf(BoolDetails);
details.paDetails := @BoolDetails;
mixerGetControlDetails(0, @Details, MIXER_GETCONTROLDETAILSF_VALUE);
if (Value)
then
BoolDetails.fValue := 1
else
BoolDetails.fValue := 0;
chk(mixerSetControlDetails(0, @Details, MIXER_SETCONTROLDETAILSF_VALUE));
end;
// ---------------------------------------------------------------------------
procedure TxpMixer.setVolume(Value: integer);
var
Line: TMixerLine;
Controls: TMixerLineControls;
MasterVolume: TMixerControl;
Details: TMixerControlDetails;
UnsignedDetails: TMixerControlDetailsUnsigned;
begin
if (value < 0)
then
value := 0;
if (value > 65535)
then
value := 65535;
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := Fmxct;
chk(mixerGetLineInfo(Fmixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE));
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(MasterVolume);
Controls.pamxctrl := @MasterVolume;
chk(mixerGetLineControls(Fmixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE));
details.cbStruct := SizeOf(Details);
details.dwControlID := MasterVolume.dwControlID;
details.cChannels := 1;
details.cMultipleItems := 0;
details.cbDetails := SizeOf(UnsignedDetails);
details.paDetails := @UnsignedDetails;
UnsignedDetails.dwValue := Value;
chk(mixerSetControlDetails(Fmixer, @Details, MIXER_SETCONTROLDETAILSF_VALUE));
end;
// ---------------------------------------------------------------------------
{ TvistaMixer }
constructor TvistaMixer.Create;
begin
CoCreateInstance(CLSID_MMDeviceEnumerator,
nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, FmmDevEnum);
FmmDevEnum.GetDefaultAudioEndpoint(eRender, eMultimedia, FmmDev);
FmmDev.Activate(IID_IAudioEndpointVolume, CLSCTX_ALL,
nil, FmmEndpoint);
end;
// ---------------------------------------------------------------------------
function TvistaMixer.getMute: boolean;
begin
FmmEndpoint.GetMute(Result);
end;
// ---------------------------------------------------------------------------
function TvistaMixer.getVolume: integer;
var
VolLevel: Single;
begin
FmmEndpoint.GetMasterVolumeLevelScalar(VolLevel);
result := Round(VolLevel * 65535);
end;
// ---------------------------------------------------------------------------
procedure TvistaMixer.setMute(Value: boolean);
begin
FmmEndpoint.SetMute(Value,
nil);
end;
// ---------------------------------------------------------------------------
procedure TvistaMixer.setVolume(Value: integer);
var
fValue: Single;
begin
if (value < 0)
then
value := 0;
if (value > 65535)
then
value := 65535;
fValue := Value / 65535;
FmmEndpoint.SetMasterVolumeLevelScalar(fValue,
nil);
end;
// ---------------------------------------------------------------------------
end.
-
unit MMDevApi_tlb;
interface
uses Windows,
ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL,ComObj;
const
// TypeLibrary Major and minor versions
CLSID_MMDeviceEnumerator: TGUID = '
{BCDE0395-E52F-467C-8E3D-C4579291692E}';
IID_IMMDeviceEnumerator: TGUID = '
{A95664D2-9614-4F35-A746-DE8DB63617E6}';
IID_IMMDevice: TGUID = '
{D666063F-1587-4E43-81F1-B948E807363F}';
IID_IMMDeviceCollection: TGUID = '
{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}';
IID_IAudioEndpointVolume: TGUID = '
{5CDF2C82-841E-4546-9722-0CF74078229A}';
IID_IAudioMeterInformation : TGUID = '
{C02216F6-8C67-4B5B-9D00-D008E73E0064}';
IID_IAudioEndpointVolumeCallback: TGUID = '
{657804FA-D6AD-4496-8A60-352752AF4F89}';
GUID_NULL: TGUID = '
{00000000-0000-0000-0000-000000000000}';
DEVICE_STATE_ACTIVE = $00000001;
DEVICE_STATE_UNPLUGGED = $00000002;
DEVICE_STATE_NOTPRESENT = $00000004;
DEVICE_STATEMASK_ALL = $00000007;
type
EDataFlow = TOleEnum;
const
eRender = $00000000;
eCapture = $00000001;
eAll = $00000002;
EDataFlow_enum_count = $00000003;
type
ERole = TOleEnum;
const
eConsole = $00000000;
eMultimedia = $00000001;
eCommunications = $00000002;
ERole_enum_count = $00000003;
type
IAudioEndpointVolumeCallback =
interface(IUnknown)
['
{657804FA-D6AD-4496-8A60-352752AF4F89}']
end;
IMMAudioEndpointVolume =
interface(IUnknown)
['
{5CDF2C82-841E-4546-9722-0CF74078229A}']
Function RegisterControlChangeNotify( AudioEndPtVol: IAudioEndpointVolumeCallback): Integer;
stdcall;
Function UnregisterControlChangeNotify( AudioEndPtVol: IAudioEndpointVolumeCallback): Integer;
stdcall;
Function GetChannelCount(
out PInteger): Integer;
stdcall;
Function SetMasterVolumeLevel(fLevelDB: single; pguidEventContext: PGUID):Integer;
stdcall;
Function SetMasterVolumeLevelScalar(fLevelDB: single; pguidEventContext: PGUID):Integer;
stdcall;
Function GetMasterVolumeLevel(
out fLevelDB: single):Integer;
stdcall;
Function GetMasterVolumeLevelScalar(
out fLevel: single):Integer;
stdcall;
Function SetChannelVolumeLevel(nChannel: Integer; fLevelDB: double; pguidEventContext: TGUID):Integer;
stdcall;
Function SetChannelVolumeLevelScalar(nChannel: Integer; fLevelDB: single; pguidEventContext: TGUID):Integer;
stdcall;
Function GetChannelVolumeLevel(nChannel: Integer;
out fLevelDB: double) : Integer;
stdcall;
Function GetChannelVolumeLevelScalar(nChannel: Integer;
out fLevel: double) : Integer;
stdcall;
Function SetMute(bMute: Boolean ; pguidEventContext: PGUID) :Integer;
stdcall;
Function GetMute(
out bMute: Boolean ) :Integer;
stdcall;
Function GetVolumeStepInfo( pnStep: Integer;
out pnStepCount: Integer):Integer;
stdcall;
Function VolumeStepUp(pguidEventContext: TGUID) :Integer;
stdcall;
Function VolumeStepDown(pguidEventContext: TGUID) :Integer;
stdcall;
Function QueryHardwareSupport(
out pdwHardwareSupportMask): Integer;
stdcall;
Function GetVolumeRange(
out pflVolumeMindB: double;
out pflVolumeMaxdB: double;
out pflVolumeIncrementdB: double): Integer;
stdcall;
end;
IPropertyStore =
interface(IUnknown)
end;
type
IMMDevice =
interface(IUnknown)
['
{D666063F-1587-4E43-81F1-B948E807363F}']
Function Activate(
const refId :TGUID;
dwClsCtx: DWORD;
pActivationParams: PInteger ;
out pEndpointVolume: IMMAudioEndpointVolume): Hresult;
stdCall;
Function OpenPropertyStore(stgmAccess: DWORD;
out ppProperties :IPropertyStore): Hresult;
stdcall;
Function GetId(
out ppstrId: PLPWSTR ): Hresult;
stdcall;
Function GetState(
out State :Integer): Hresult;
stdcall;
end;
IMMDeviceCollection =
interface(IUnknown)
['
{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
end;
IMMNotificationClient =
interface (IUnknown)
['
{7991EEC9-7E89-4D85-8390-6C703CEC60C0}']
end;
IMMDeviceEnumerator =
interface(IUnknown)
['
{A95664D2-9614-4F35-A746-DE8DB63617E6}']
Function EnumAudioEndpoints( dataFlow: EDataFlow; deviceState: SYSUINT; DevCollection:IMMDeviceCollection ): Hresult ;
stdcall;
Function GetDefaultAudioEndpoint(EDF: SYSUINT; ER: SYSUINT;
out Dev :IMMDevice ): Hresult ;
stdcall;
Function GetDevice( pwstrId: pointer ;
out Dev :IMMDevice) : HResult;
stdcall;
Function RegisterEndpointNotificationCallback(pClient :IMMNotificationClient) :Hresult;
stdcall;
end;
implementation
end.