zdroj

.
.
.
private
{ Private declarations }
function GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
procedure SetMasterVolume(Mixer: hMixerObj; Value: Word);
.
.
.

procedure TForm1.SetMasterVolume(Mixer: hMixerObj; Value: Word);
var
MasterVolume : TMixerControl;
Details : TMixercontrolDetails;
UnsignedDetails: TMixercontrolDetailsUnsigned;
Code: MMResult;
begin
code := GetMasterVolumecontrol(Mixer, MasterVolume);
if code = MMSYSERR_NOERROR then
begin
with Details do begin
cbStruct := SizeOf(Details);
dwControlId := MasterVolume.dwControlId;
cChannels := 1;
cMultipleItems := 0;
cbDetails := SizeOf(UnsignedDetails);
paDetails := @UnsignedDetails;
end;
UnsignedDetails.dwValue := Value;
code := mixerSetControlDetails(Mixer, @Details, Mixer_SetControlDetailsf_value);
end;
if Code <> MMSYSERR_NOERROR then ShowMessage('Došlo k chybě při pokusu o změnu hlasitosti.');
end;

function TForm1.GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
var
Line: TMixerLine;
Controls: TMixerLineControls;
begin
ZeroMemory(@line, SizeOf(line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then
begin
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := sizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := @Control;
Result := MixerGetLineControls(Mixer, @Controls, Mixer_GETLINECONTROLSF_ONEBYTYPE);
end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetMasterVolume(0,TrackBar1.Position);
end;