unit WAV_Volume;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes;

 function GetWaveVolumeLeft: Word;

 function GetWaveVolumeRight: Word;

 procedure GetWaveVolume(var Left, Right: WORD);

 procedure SetWaveVolume(const Left, Right: WORD);

 function SupportsLAndRVolume: boolean;

implementation

uses mmsystem;

{$R-}

function _GetWaveVolume: DWORD;

var

 Woc : TWAVEOUTCAPS;

 Volume : DWORD;

 hwo : UINT;

begin

 result := 0;

 hwo := WAVE_MAPPER;

 if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then

   if (Woc.dwSupport and WAVECAPS_VOLUME) = WAVECAPS_VOLUME then

   begin

     if WaveOutGetVolume(hwo, @Volume) = MMSYSERR_NOERROR then

       Result := Volume;

   end;

end;

procedure _SetWaveVolume(const AVolume: DWORD);

var

 Woc : TWAVEOUTCAPS;

 hwo : UINT;

begin

 hwo := WAVE_MAPPER;

 if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then

   if (Woc.dwSupport and WAVECAPS_VOLUME) = WAVECAPS_VOLUME then

     WaveOutSetVolume(hwo, AVolume);

end;

function GetWaveVolumeLeft: Word;

var

 d : DWORD;

begin

 d := _GetWaveVolume;

 result := LOWORD(d);

end;

function GetWaveVolumeRight: Word;

var

 d : DWORD;

begin

 d := _GetWaveVolume;

 result := HIWORD(d);

end;

procedure GetWaveVolume(var Left, Right: WORD);

var

 d : DWORD;

begin

 d := _GetWaveVolume;

 Left  := LOWORD(d);

 Right := HIWORD(d);

end;

procedure SetWaveVolume(const Left, Right: WORD);

var

 d : DWORD;

begin

 d := MAKELONG(Left, Right);

 _SetWaveVolume( d );

end;

function SupportsLAndRVolume: boolean;

var

 Woc : TWAVEOUTCAPS;

 Volume : DWORD;

 hwo : UINT;

begin

 result := false;

 hwo := WAVE_MAPPER;

 if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then

   result := (Woc.dwSupport and WAVECAPS_LRVOLUME) = WAVECAPS_LRVOLUME;

end;

end.