Поддержка / Donate
 

WebMoney

Яндекс.Деньги

SMS.Копилка
Деньги@Mail.ru
Rupay
E-gold
PayPal

 

Благодарю за поддержку!

Лента RSS - Новости сайта Новости сайта
Лента RSS - Новости форума Новости форума
Добавить в закладки и поделиться Bookmark and Share

 

Архив исходников

 


Automatic translation

 
English German French
Italian Spanish Portuguese
Greece Japan Chinese
  Korean  

  

 

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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

Оформил: 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 World" © Выпуск 2002 - 2004
Автор проекта: Акулов Николай



   Rambler's Top100             Яндекс цитирования