Конференция "Media" » Уровень звука в децебеллах [D7, WinXP]
 
  • Frex (23.06.09 18:06) [0]
    Мне нужно определить уровень звука в системе в децебелах, т.е. проигрывается какойто аудио файл в одном плеере, какой-то в другом, мне надо определить уровень звука во всей системе, очень нужно, помогите!
  • Сергей М. © (23.06.09 22:20) [1]
    http://programmersforum.ru/showthread.php?t=55369

    Это не ты случаем ?)
  • brother © (03.07.09 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 © (05.07.09 14:46) [3]

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

    учитывыая децебельность - точно.
 
Конференция "Media" » Уровень звука в децебеллах [D7, WinXP]
Есть новые Нет новых   [133926   +461][b:0][p:0.002]