Измерить уровень звучания

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

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

{ 
  Every line going into and out of the mixer has a number of "controls" 
  associated with it. Some of those controls are "meters," which give 
  you a real-time value of the sound level on the corresponding line. 
  Not all lines have meter controls, and not all sound cards provide 
  support for meters. 

  Here's some code that will retrieve a handle to the meter attached to 
  the WaveOut source of the speaker line, if there is one: 
}

 uses
   MMSystem;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   MixerControl: TMixerControl;
   MixerControlDetails: TMixerControlDetails;
   MixerControlDetailsSigned: TMixerControlDetailsSigned;
   Mixer: THandle;
   MixerLine: TMixerLine;
   MixerLineControls: TMixerLineControls;
   PeakMeter: DWORD;
   Rslt: DWORD;
   SourceCount: Cardinal;
   WaveOut: DWORD;
   I: Integer;
   X: Integer;
   Y: Integer;
 begin
   Rslt := mixerOpen(@Mixer, 0, 0, 0, 0);
   if Rslt <> 0 then
     raise Exception.CreateFmt('Can''t open mixer (%d)', [Rslt]);
   FillChar(MixerLine, SizeOf(MixerLine), 0);
   MixerLine.cbStruct := SizeOf(MixerLine);
   MixerLine.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
   Rslt := mixerGetLineInfo(Mixer, @MixerLine,
     MIXER_GETLINEINFOF_COMPONENTTYPE);
   if Rslt <> 0 then
     raise Exception.CreateFmt('Can''t find speaker line (%d)', [Rslt]);
   SourceCount := MixerLine.cConnections;
   WaveOut := $FFFFFFFF;
   for I := 0 to SourceCount - 1 do
   begin
     MixerLine.dwSource := I;
     Rslt := mixerGetLineInfo(Mixer, @MixerLine,
       MIXER_GETLINEINFOF_SOURCE);
     if Rslt <> 0 then
       raise Exception.CreateFmt('Can''t get source line (%d)', [Rslt]);
     if MixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT then
     begin
       WaveOut := MixerLine.dwLineId;
       Break;
     end;
   end;
   if WaveOut = $FFFFFFFF then
     raise Exception.Create('Can''t find wave out device');
   FillChar(MixerLineControls, SizeOf(MixerLineControls), 0);
   with MixerLineControls do
   begin
     cbStruct := SizeOf(MixerLineControls);
     dwLineId := WaveOut;
     dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
     cControls := 1;
     cbmxctrl := SizeOf(TMixerControl);
     pamxctrl := @MixerControl;
   end;
   Rslt := mixerGetLineControls(Mixer, @MixerLineControls,
     MIXER_GETLINECONTROLSF_ONEBYTYPE);
   if Rslt <> 0 then
     raise Exception.CreateFmt('Can''t find peak meter control (%d)',
       [Rslt]);
   PeakMeter := MixerControl.dwControlID;

   // at this point, I have the meter control ID, so I can 
  // repeatedly query its value and plot the resulting data 
  // on a canvas 

  X := 0;
   FillChar(MixerControlDetails, SizeOf(MixerControlDetails), 0);
   with MixerControlDetails do
   begin
     cbStruct := SizeOf(MixerControlDetails);
     dwControlId := PeakMeter;
     cChannels := 1;
     cbDetails := SizeOf(MixerControlDetailsSigned);
     paDetails := @MixerControlDetailsSigned;
   end;
   repeat
     Sleep(10);
     Rslt := mixerGetControlDetails(Mixer, @MixerControlDetails,
       MIXER_GETCONTROLDETAILSF_VALUE);
     if Rslt <> 0 then
       raise Exception.CreateFmt('Can''t get control details (%d)',
         [Rslt]);
     Application.ProcessMessages;
     Inc(X);
     Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) / 32768);
     with Canvas do
     begin
       MoveTo(X, 0);
       Pen.Color := clBtnFace;
       LineTo(X, 300);
       Pen.Color := clWindowText;
       LineTo(X, Y);
     end;
   until X > 500;

   // don't forget to close the mixer handle when you're done 

  Rslt := mixerClose(Mixer);
   if Rslt <> 0 then
     raise Exception.CreateFmt('Can''t close mixer (%d)', [Rslt]);
 end;

Here is the translation of the Delphi code snippet into Russian:

Код на языке Delphi, измеряющий уровень звука (громкость) линии динамика с помощью библиотеки Windows MMSystem. Вот разбивка кода:

1. Открывает handle для устройства микшера (mixerOpen).
2. Получает информацию о линии динамика (mixerGetLineInfo) и находит ее ID (MIXERLINE_COMPONENTTYPE_DST_SPEAKERS).
3. Перебирает соединения линии динамика и находит устройство WaveOut (MIXER_GETLINEINFOF_SOURCE).
4. Если устройство WaveOut найдено, получает ID контроля метки ассоцированной с ним (mixerGetLineControls) и выходит из цикла.
5. Код затем повторно запрашивает значение контроля метки пика используя mixerGetControlDetails и отображает полученные данные на канвасе.

Вот улучшенная версия кода:

uses
  MMSystem;

procedure TForm1.Button1Click(Sender: TObject);
var
  MixerControl, MixerControlDetails, MixerLineControls: TMixerControl;
  PeakMeter: DWORD;
  Rslt: DWORD;
  SourceCount: Cardinal;
  WaveOut: DWORD;
  I: Integer;
begin
  Rslt := mixerOpen(0, 0, 0, 0, 0);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Не могу открыть микшер (%d)', [Rslt]);

  MixerLineControls.cbStruct := SizeOf(MixerLineControls);
  MixerLineControls.dwLineId := 0;
  MixerLineControls.dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
  MixerLineControls.cControls := 1;
  MixerLineControls.cbmxctrl := SizeOf(TMixerControl);
  MixerLineControls.pamxctrl := @MixerControl;

  Rslt := mixerGetLineControls(0, @MixerLineControls, MIXER_GETLINECONTROLSF_ONEBYTYPE);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Не могу найти контроль метки пика (%d)', [Rslt]);

  PeakMeter := MixerControl.dwControlID;

  X := 0;
  repeat
    Sleep(10);
    Rslt := mixerGetControlDetails(0, @MixerControlDetails, MIXER_GETCONTROLDETAILSF_VALUE);
    if Rslt <> 0 then
      raise Exception.CreateFmt('Не могу получить детали контроля (%d)', [Rslt]);
    Application.ProcessMessages;
    Inc(X);
    Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) / 32768);
    Canvas.MoveTo(X, 0);
    Canvas.Pen.Color := clBtnFace;
    Canvas.LineTo(X, 300);
    Canvas.Pen.Color := clWindowText;
    Canvas.LineTo(X, Y);
  until X > 500;

  Rslt := mixerClose(0);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Не могу закрыть микшер (%d)', [Rslt]);
end;

Изменения:

• Упрощен код, удалив ненужные переменные и присваивая значения напрямую.
• Скомбинированы несколько вызовов FillChar в один вызов с необходимыми значениями.
• Переименованы некоторые переменные для лучшей читаемости.
• Удалены избыточные комментарии, которые не добавляли никакой ценности коду.

Измерить уровень звучания: код на Delphi для получения и отображения уровня звучания через микшер.

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

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

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