VPF::Нестандартные ситуации при записи звука

Jin X

Дата 10.2.2016, 19:30 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 5.3.2004

Репутация: нет
Всего: 1

1. Имеется вот такой проект (см. аттач), ниже приведён код.
Всё работает чётко. Но есть пара нюансов:
а) Если выбран WAVE_MAPPER и происходит смена аудиоустройства по умолчанию (в настройках "Звука" Windows), прога виснет.
б) Если выбран конкретный девайс и происходит его отключение, прога виснет.
Зависание заключается в том, что при очередном вызове callback-функции зависает функция waveInAddBuffer, т.е. после её вызова код не выполняется (соответственно, выхода из callback-функции нет).
Функции waveInStop/Reset (и даже Close) тоже зависают при нажатии на кнопку "Стоп".
Что делать, как это исправить? Может, какую-то проверку нужно делать перед waveInAddBuffer? И если да, то какую и что делать после (в частности, при изменении аудиоустройства по умолчанию... я думаю, не совсем корректно будет закрывать текущее устройство и открывать новое прямо из callback-функции)?
Стандартная программа "Звукозапись" спокойно переживает изменение аудиоустройства по умолчанию и даже переключает устройство на новое (т.е. продолжает запись с нового устройства). Моя же прога при изменении устройства (если убрать функцию waveInAddBuffer из callback) продолжает запись с того же устройства, что было в самом начале. Кстати, если waveInAddBuffer убрать, то waveInStop/Reset/Close работают как положено и ничего не виснет.

2. И второй вопрос (чтобы новую тему не создавать): каким образом можно отследить изменение состава аудиоустройств (например, что-то отключилось или подключилось) и аудиоустройства по умолчанию (в системных настройках)?
Может, какое-то сообщение посылается всем окнам? Чтобы не проверять каждый раз вручную (например, раз в секунду).
И как, кстати, определить какое из аудиоустройств установлено по умолчанию?

А вот, собственно, и код, касающийся первого вопроса:

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    cmbDevice: TComboBox;
    btnStart: TButton;
    btnStop: TButton;
    btnReset: TButton;
    pbNow: TProgressBar;
    pbMax: TProgressBar;
    tmrBars: TTimer;
    lblNow: TLabel;
    lblMax: TLabel;
    lblNowText: TLabel;
    lblMaxText: TLabel;
    btnGetDevList: TButton;
    lblBufsText: TLabel;
    edtBufs: TEdit;
    function GetDevList: Integer;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure tmrBarsTimer(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnGetDevListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TWAVEINCAPS2 = record
    Caps: TWAVEINCAPS;
    ManufacturerGuid, ProductGuid, NameGuid: TGUID
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TBuf = array [0..2205] of SmallInt;
  PBuf = ^TBuf;
const
  BufN = 10;
var
  WaveHdr: array [0..BufN-1] of TWAVEHDR;
  WaveH: HWAVEIN;
  Buf: array [0..BufN-1] of TBuf;
  ErrMsg: array [0..255] of Char;
  WaveNow, WaveMax, Bufs: Integer;
  Stop: Boolean;

procedure waveInProc(hwi: HWAVEIN; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
var i, N, wMin, wMax: Integer;
begin
  if uMsg = MM_WIM_DATA then
  begin
    Inc(Bufs);
    with PWAVEHDR(dwParam1)^ do
    begin
      WaveNow := 0;
      wMin := 0;
      wMax := 0;
      for i := 0 to dwBytesRecorded div 2-1 do
      begin
        N := PBuf(lpData)^[i];
        if N < wMin then wMin := N;
        if N > wMax then wMax := N
      end;
      N := (wMax - wMin) div 2;
      WaveNow := N;
      if N > WaveMax then WaveMax := N;
      if not Stop then
      begin
        dwFlags := dwFlags and (not WHDR_DONE);
        dwBytesRecorded := 0;
        waveInAddBuffer(WaveH, PWAVEHDR(dwParam1), SizeOf(WaveHdr[0]));
      end
    end
  end
end;

//  Обновляет список устройств и возвращает номер выбранного устройства или -2, если устройство не найдено
function TForm1.GetDevList: Integer;
var
  i, N: Integer;
  DevIn: TWAVEINCAPS;
  S: String;
begin
  Result := -2;
  S := cmbDevice.Text;
  cmbDevice.Clear;
  N := 0;
  for i := -1 to waveInGetNumDevs-1 do
  begin
    FillChar(DevIn, SizeOf(DevIn), 0);
    if waveInGetDevCaps(i, @DevIn, SizeOf(DevIn)) = MMSYSERR_NOERROR then cmbDevice.Items.Add(DevIn.szPname);
    if DevIn.szPname = S then
    begin
      N := cmbDevice.Items.Count-1;
      Result := i
    end
  end;
  cmbDevice.ItemIndex := N
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  GetDevList
end;

procedure TForm1.btnStartClick(Sender: TObject);
var
  WaveFmt: TWAVEFORMATEX;
  i, DevID: Integer;

 function ProcessError(Err: Integer): Boolean;
 var i: Integer;
 begin
   Result := (Err <> MMSYSERR_NOERROR);
   if not Result then Exit;
   if WaveH <> 0 then
   begin
     for i := 0 to BufN-1 do
       if WaveHdr[i].dwFlags and WHDR_PREPARED > 0 then waveInUnprepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
     waveInClose(WaveH)
   end;
   waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
   MessageBox(0, ErrMsg, PChar('Ошибка '+IntToStr(Err)+'!'), MB_OK or MB_ICONERROR or MB_TASKMODAL);
   btnStart.Enabled := True;
   cmbDevice.Enabled := True;
   btnGetDevList.Enabled := True;
 end;

begin
  edtBufs.Text := '0';
  DevID := GetDevList;
  if DevID = -2 then
    if MessageBox(0, PChar('Выбранное устройство было отключено.'+Chr(13)+'Продолжить запись с устройства по умолчанию?'), 'Предупреждение', MB_YESNO or MB_ICONWARNING or MB_TASKMODAL) = idNo then Exit;
  btnStart.Enabled := False;
  cmbDevice.Enabled := False;
  btnGetDevList.Enabled := False;

  with WaveFmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 44100;
    wBitsPerSample := 16;
    nBlockAlign := nChannels*wBitsPerSample shr 3;
    nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
    cbSize := 0
  end;
  WaveH := 0;
  if ProcessError(waveInOpen(@WaveH, DevID, @WaveFmt, DWord(@waveInProc), 0, CALLBACK_FUNCTION)) then Exit;

  FillChar(WaveHdr, SizeOf(WaveHdr), 0);
  for i := 0 to BufN-1 do
  begin
    with WaveHdr[i] do
    begin
      lpData := @Buf[i];
      dwBufferLength := SizeOf(Buf[i])
    end;
    if ProcessError(waveInPrepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]))) then Exit;
    if ProcessError(waveInAddBuffer(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]))) then Exit
  end;

  WaveNow := 0;
  WaveMax := 0;
  Bufs := 0;
  Stop := False;
  if ProcessError(waveInStart(WaveH)) then Exit;

  btnStop.Enabled := True;
  tmrBars.Enabled := True
end;

procedure TForm1.btnStopClick(Sender: TObject);
var
  i, Err: Integer;
//  Done: Boolean;
begin
  btnStop.Enabled := False;

  Stop := True;
  waveInReset(WaveH);

{ Этот код я убираю, т.к. смысла в неё нет, поскольку waveInReset завершится только тогда, когда все буферы обработаются
  repeat
    Done := True;
    Application.ProcessMessages;
    for i := 0 to BufN-1 do
      if WaveHdr[i].dwFlags and WHDR_DONE = 0 then Done := False
  until Done;
}
  for i := 0 to BufN-1 do
    waveInUnprepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));

  Err := waveInClose(WaveH);
  if Err <> MMSYSERR_NOERROR then
  begin
    waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
    MessageBox(0, ErrMsg, PChar('Ошибка '+IntToStr(Err)+'!'), MB_OK or MB_ICONERROR or MB_TASKMODAL);
  end;

  tmrBarsTimer(nil);
  tmrBars.Enabled := False;
  GetDevList;
  cmbDevice.Enabled := True;
  btnGetDevList.Enabled := True;
  btnStart.Enabled := True
end;

procedure TForm1.btnResetClick(Sender: TObject);
begin
  WaveNow := 0;
  WaveMax := 0;
  tmrBarsTimer(nil)
end;

procedure TForm1.tmrBarsTimer(Sender: TObject);
begin
  pbNow.Position := Round(Ln(WaveNow+1)/Ln(32768)*100);
  if WaveNow = 0 then lblNow.Caption := '-Inf db'
  else lblNow.Caption := IntToStr(Round((Ln(WaveNow)-Ln(32767))/Ln(10)*20)) + ' db';
  pbMax.Position := Round(Ln(WaveMax+1)/Ln(32768)*100);
  if WaveMax = 0 then lblMax.Caption := '-Inf db'
  else lblMax.Caption := IntToStr(Round((Ln(WaveMax)-Ln(32767))/Ln(10)*20)) + ' db';
  edtBufs.Text := IntToStr(Bufs)
end;

procedure TForm1.btnGetDevListClick(Sender: TObject);
begin
  GetDevList
end;

end.

Это сообщение отредактировал(а) Jin X - 10.2.2016, 19:32

Присоединённый файл ( Кол-во скачиваний: 1 )

WaveMeter.zip 5,73 Kb

--------------------

Бойся своей мечты, ибо она осуществима!

Alexeis

Дата 11.2.2016, 12:13 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Вижу процедурку
procedure waveInProc(hwi: HWAVEIN; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
Судя по документации она умеет не только уведомлять о том, что данные заканчиваются, но и об ошибках.
Вероятно, система шлет сообщение с MM_WIM_OPEN / MM_WIM_CLOSE перед закрытием/открытием нового устройства.
А MM_WIM_DATA скорее всего приходит уже для нового устройства.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Jin X

Дата 11.2.2016, 13:52 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 157
Регистрация: 5.3.2004

Репутация: нет
Всего: 1

Alexeis, проверил. К сожалению, даже этого не происходит :(

--------------------

Бойся своей мечты, ибо она осуществима!

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »