Изменить громкость 5

Delphi , Мультимедиа , Аудио

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

 {by Serhiy Perevoznyk}

 uses
   MMSystem;


 function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint;
   var mxc: TMixerControl): Boolean;
 var
   mxl: TMixerLine;
   mxlc: TMixerLineControls;
   rc: Longint;
 begin
   Result := False;
   FillChar(mxl, SizeOf(TMixerLine), 0);
   mxl.cbStruct := SizeOf(TMixerLine);
   mxl.dwComponentType := componentType;
   {Obtain a line corresponding to the component type}
   rc := mixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
   if rc = MMSYSERR_NOERROR then
   begin
     with mxlc do
     begin
       cbStruct := SizeOf(TMixerLineControls);
       dwLineID := mxl.dwLineID;
       dwControlType := ctrlType;
       cControls := 1;
       cbmxctrl := SizeOf(TMixerLine);
       pamxctrl := @mxc;
       pamxctrl^.cbStruct := SizeOf(TMixerControl);
     end;
     mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
     rc := mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
     Result := rc = MMSYSERR_NOERROR;
   end;
 end;

 function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volume: Longint): Boolean;
 var
   mxcd: TMixerControlDetails;
   vol: TMixerControlDetails_Unsigned;
   rc: MMRESULT;
 begin
   FillChar(mxcd, SizeOf(mxcd), 0);
   with mxcd do
   begin
     cbStruct := SizeOf(TMixerControlDetails);
     dwControlID := mxc.dwControlID;
     cbDetails := SizeOf(TMixerControlDetails_Unsigned);
     paDetails := @vol;
     cMultipleItems := 0;
     cChannels := 1;
   end;
   vol.dwValue := volume;
   rc := mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
   Result := rc = MMSYSERR_NOERROR;
 end;

 function InitMixer: HMixer;
 var
   Err: MMRESULT;
 begin
   Err := mixerOpen(@Result, 0, 0, 0, 0);
   if Err <> MMSYSERR_NOERROR then
     Result := 0;
 end;

 // Example: 


procedure SetMasterVolumeToZero;
 var
   MyMixerHandle: HMixer;
   MyVolCtrl: TMixerControl;
 begin
   MyMixerHandle := InitMixer;
   if MyMixerHandle <> 0 then
     try
       FillChar(MyVolCtrl, SizeOf(MyVolCtrl), 0);
       if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
         MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
       begin
         {The last parameter (0) here is the volume level}
         if SetVolumeControl(MyMixerHandle, MyVolCtrl, 0) then
           ShowMessage('Volume should now be set to zero');
       end;
     finally
       mixerClose(MyMixerHandle);
     end;
 end;


 procedure TForm1.Button2Click(Sender: TObject);
 begin
  SetMasterVolumeToZero
 end;

Программный код на языке Delphi, который управляет основным объемом звуковой системы с помощью библиотеки MMSystem. Он имеет три основных функции:

1. GetVolumeControl: Функция получает информацию о конкретном контроле для заданной линии микшера.
2. SetVolumeControl: Функция устанавливает значение указанного контрола для заданной линии микшера.
3. InitMixer: Функция инициализирует новый объект микшера.

Код также включает в себя пример процедуры SetMasterVolumeToZero, которая устанавливает основной объем звуковой системы в ноль при клике кнопки.

В предложениях и улучшениях:

1. Функция GetVolumeControl может быть упрощена, удалив избыточное присваивание переменной rc.
2. В функции SetVolumeControl можно использовать более описательное имя для параметра volume вместо Longint.
3. Функция InitMixer должна возвращать сообщение об ошибке или исключение, если инициализация микшера не удалась.
4. Можно добавить обработку ошибок в функциях GetVolumeControl и SetVolumeControl, чтобы обработать потенциальные ошибки, которые могут возникнуть при получении и установке контрола.

Вот модифицированный код с этими предложениями:

function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint; var mxc: TMixerControl): Boolean;
var
  mxl: TMixerLine;
  mxlc: TMixerLineControls;
begin
  Result := False;
  FillChar(mxl, SizeOf(TMixerLine), 0);
  mxl.cbStruct := SizeOf(TMixerLine);
  mxl.dwComponentType := componentType;
  MixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  if MMSYSERR_NOERROR = mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) then
    Result := True;
end;

function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volumeValue: Integer): Boolean;
var
  mxcd: TMixerControlDetails;
  vol: TMixerControlDetails_Unsigned;
begin
  FillChar(mxcd, SizeOf(TMixerControlDetails), 0);
  with mxcd do
  begin
    cbStruct := SizeOf(TMixerControlDetails);
    dwControlID := mxc.dwControlID;
    cbDetails := SizeOf(TMixerControlDetails_Unsigned);
    paDetails := @vol;
    cMultipleItems := 0;
    cChannels := 1;
  end;
  vol.dwValue := volumeValue;
  Result := MMSYSERR_NOERROR = mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
end;

function InitMixer: HMixer;
begin
  Result := mixerOpen(nil, 0, 0, 0, 0);
  if MMSYSERR_NOERROR <> Result then
    raise Exception.Create('Failed to initialize mixer');
end;

procedure SetMasterVolumeToZero;
var
  MyMixerHandle: HMixer;
  MyVolCtrl: TMixerControl;
begin
  MyMixerHandle := InitMixer;
  if MyMixerHandle <> 0 then
    try
      FillChar(MyVolCtrl, SizeOf(TMixerControl), 0);
      if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
        MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
      begin
        SetVolumeControl(MyMixerHandle, MyVolCtrl, 0);
        ShowMessage('Volume should now be set to zero');
      end;
    finally
      mixerClose(MyMixerHandle);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SetMasterVolumeToZero;
end;

Обратите внимание, что это еще программный код на языке Delphi и использует библиотеку MMSystem, которая может не быть совместима с современными системами. Для современных приложений вам может потребоваться использование альтернативных библиотек или API для управления настройками звуковой системы.

Изменение громкости звука на компьютере с помощью программирования в Delphi.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Аудио ::