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

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

Автор: MMM
WEB-сайт: http://forum.vingrad.ru

uses mmsystem;

function GetWaveVolume: DWord;
var
  Woc: TWAVEOUTCAPS;
  Volume: DWord;
begin
  result := 0;
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
    begin
      WaveOutGetVolume(WAVE_MAPPER, @Volume);
      Result := Volume;
    end;
end;

procedure SetWaveVolume(const AVolume: DWord);
var
  Woc: TWAVEOUTCAPS;
begin
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
      WaveOutSetVolume(WAVE_MAPPER, AVolume);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Beep;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LeftVolume: Word;
  RightVolume: Word;
begin
  LeftVolume := StrToInt(Edit1.Text);
  RightVolume := StrToInt(Edit2.Text);
  SetWaveVolume(MakeLong(LeftVolume, RightVolume));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Caption := IntToStr(GetWaveVolume);
end;

Here is a translation of the provided text into Russian:

Код, предоставленный ниже, это программный проект на языке Delphi, который взаимодействует с Windows API для управления звуком устройства. Вот что каждый раздел делает:

1. uses mmsystem;: Это строка включает модуль MMSYSTEM, который обеспечивает функции для работы с устройствами мультимедиа.

2. function GetWaveVolume: DWord; : Функция получает текущий объем звука устройства. Она делает это, вызывая WaveOutGetDevCaps, чтобы получить возможности устройства, и затем проверяет, поддерживает ли устройство управление объемом (WAVECAPS_ВOLUME). Если оно поддерживает, она вызывает WaveOutGetVolume, чтобы получить текущий объем.

3. procedure SetWaveVolume( const AVolume: DWord ); : Функция устанавливает объем звука устройства. Она делает это, вызывая WaveOutGetDevCaps, чтобы получить возможности устройства, и затем проверяет, поддерживает ли устройство управление объемом (WAVECAPS_ВOLUME). Если оно поддерживает, она вызывает WaveOutSetVolume, чтобы установить новый объем.

4. procedure TForm1.Button1Click( Sender: TObject ); : Это обработчик события для клика кнопки на Form1. Он просто играет звуковой сигнал с помощью функции Beep.

5. procedure TForm1.Button2Click( Sender: TObject ); : Это обработчик события для другого клика кнопки на Form1. Он получает текст из двух полей ввода (Edit1 и Edit2) и конвертирует их в целые числа с помощью функции StrToInt. Затем он вызывает SetWaveVolume, чтобы установить левый и правый объем звука устройства.

6. procedure TForm1.Button3Click( Sender: TObject ); : Это обработчик события для другого клика кнопки на Form1. Он вызывает GetWaveVolume, чтобы получить текущий объем, конвертирует его в строку с помощью функции IntToStr и устанавливает эту строку как заголовок Form1.

Однако, есть несколько проблем с этим кодом:

• В функции Button2Click используется функция MakeLong, которая создает 32-битное значение из двух байт. Это может работать, если вы работаете только с 8-битными уровнями громкости (0 до 255), но это safer и более читаемо использовать отдельные переменные для левого и правого объемов, особенно поскольку вы получаете их как отдельные значения.

• В этом коде нет обработки ошибок. Если WaveOutGetDevCaps или WaveOutSetVolume fails, оно вернет код ошибки, который можно проверить с помощью констант MMSYSERR_XXX. Было бы хорошей практикой включать проверки этих ошибок и предоставлять обратную связь пользователю, если что-то пошло не так.

• Значения объемов хранятся в виде DWords (32-битных неотрицательных целых чисел), но функция MakeLong используется, что предполагает, что вы работаете с 16-битными значениями. Это может вызвать проблемы, если ваш систем использует 24-битные или 32-битные уровни громкости.

Вот альтернативное решение, которое решает эти проблемы:

uses
  mmsystem,
  Classes;

type
  TMyForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    FLeftVolume, FRightVolume: Word;
  public
    { Public declarations }
  end;

var
  Form1: TMyForm;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Beep;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LeftVolume, RightVolume: Word;
begin
  LeftVolume := StrToInt(Edit1.Text);
  RightVolume := StrToInt(Edit2.Text);
  SetWaveVolume(LeftVolume, RightVolume);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Caption := IntToStr(GetWaveVolume);
end;

function GetWaveVolume: DWord;
var
  Woc: TWAVEOUTCAPS;
  Volume: DWord;
begin
  Result := 0;
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
      begin
        WaveOutGetVolume(WAVE_MAPPER, @Volume);
        Result := Volume;
      end;
end;

procedure SetWaveVolume(Left: Word; Right: Word);
var
  Woc: TWAVEOUTCAPS;
begin
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
      begin
        // Convert 16-bit values to 32-bit values
        WaveOutSetVolume(WAVE_MAPPER, MakeLong(Left, Right));
      end;
end;

initialization
  // Initialize form components here...
end.

В этом коде используются отдельные переменные для левого и правого объемов, включены проверки ошибок для WaveOutGetDevCaps и WaveOutSetVolume, а также конвертируются значения объемов в 32-битные значения перед установкой.

В статье описана реализация функции изменения громкости звука в программировании с использованием библиотеки mmsystem и языка Delphi.

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

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

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