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

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;

Статья Измерить уровень звучания раздела Мультимедиа Аудио может быть полезна для разработчиков на Delphi и FreePascal.

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

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