Форум: "Media";
Текущий архив: 2019.02.03;
Скачать: [xml.tar.bz2];

Вниз

Уровень звука в децебеллах   Найти похожие ветки 

← →
Frex   (2009-06-23 18:06) [0]

Мне нужно определить уровень звука в системе в децебелах, т.е. проигрывается какойто аудио файл в одном плеере, какой-то в другом, мне надо определить уровень звука во всей системе, очень нужно, помогите!

---

← →
Сергей М. ©   (2009-06-23 22:20) [1]

http://programmersforum.ru/showthread.php?t=55369

Это не ты случаем ?)

---

← →
brother ©   (2009-07-03 06:54) [2]

с того сайта:
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, bass, ExtCtrls;

type
 TForm1 = class(TForm)
   ComboBox1: TComboBox;
   Label1: TLabel;
   Timer1: TTimer;
   PaintBox1: TPaintBox;
   procedure FormCreate(Sender: TObject);
   procedure ComboBox1Change(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 chan: cardinal;

implementation

{$R *.dfm}

function RecordingCallback(Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean; stdcall;
begin
 Result := True
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 a: Integer;
 dName: PChar;
 r_Init: boolean;
 AVolume: Single;
begin
 if (HIWORD(BASS_GetVersion) <> BASSVERSION) then begin
   MessageBox(0, "An incorrect version of BASS.DLL was loaded", nil, MB_ICONERROR);
   Halt;
 end;

 if not BASS_Init(-1, 44100, BASS_DEVICE_LATENCY, handle, nil) then begin
   MessageBox(0,"Can""t initialize device",nil,MB_ICONERROR);
   Exit;
 end;

 r_init := BASS_RecordInit(0);
 chan := BASS_RecordStart(44100, 2, MakeLong(0, 10), @RecordingCallback, nil); // Recording Channel
 if (not R_Init) or (chan = 0) then begin
   Bass_Free();
   MessageBox(0,"Can""t initialize recording device",nil,MB_ICONERROR);
   Halt;
 end;

 a := 0;
 dName := BASS_RecordGetInputName(a);
 while dName <> nil do begin
   ComboBox1.Items.Add(StrPas(dName));
   // is this one currently "on"?
   if (BASS_RecordGetInput(a, AVolume) and BASS_INPUT_OFF) = 0 then ComboBox1.ItemIndex := a;
   Inc(a);
   dName := BASS_RecordGetInputName(a);
 end;
 ComboBox1Change(Self); //update

 BASS_RecordGetInput(ComboBox1.ItemIndex, AVolume);
 BASS_ChannelPlay(chan, False);

 Timer1.Enabled:=true;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
 i: Integer;
 r: Boolean;
 AVolume: Single;
begin
 r := True;
 i := 0;
 while r do begin
   r := BASS_RecordSetInput(i, BASS_INPUT_OFF, -1);
   Inc(i);
 end;
 BASS_RecordSetInput(ComboBox1.ItemIndex, BASS_INPUT_ON, -1);
 BASS_RecordGetInput(ComboBox1.ItemIndex, AVolume);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
type  fftdata = array[1..256] of single;
var data : fftdata;
   i, n : integer;
   level: cardinal;
   levelL, levelR: byte;
begin
level := BASS_ChannelGetLevel(chan);
levelL := loword(level)*100 div (maxword div 2);   // уровень в %
levelR := hiword(level)*100 div (maxword div 2);

Bass_ChannelGetData(chan, @data, BASS_DATA_FFT512);

With PaintBox1 do
begin
  Canvas.FillRect(rect(0, 0, paintbox1.width, paintbox1.height));
  Canvas.Pen.Color := clBlack;
  for i := 1 to 256 do begin
    n := round(data[i] * 100);
    PaintBox1.Canvas.MoveTo(i, 100);
    PaintBox1.Canvas.LineTo(i, 100 - n);
  end;
  Canvas.Rectangle(258,100,266,100-levelL);
  Canvas.Rectangle(268,100,276,100-levelR);
end;
end;

end.
это при использовании библы bass.dll

---

← →
KilkennyCat ©   (2009-07-05 14:46) [3]

> Сергей М. © (23.06.09 22:20) [1]

учитывыая децебельность - точно.

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2019.02.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.001 c