Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.02.2016, 19:32   #1
7in
(aka Jin X) !RTFM!
Форумчанин
 
Аватар для 7in
 
Регистрация: 14.12.2014
Сообщений: 295
Восклицание Нестандартные ситуации при записи звука

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

2. И второй вопрос (чтобы новую тему не создавать): каким образом можно отследить изменение состава аудиоустройств (например, что-то отключилось или подключилось) и аудиоустройства по умолчанию (в системных настройках)?
Может, какое-то сообщение посылается всем окнам? Чтобы не проверять каждый раз вручную (например, раз в секунду).
И как, кстати, определить какое из аудиоустройств установлено по умолчанию?
Вложения
Тип файла: zip WaveMeter.zip (5.7 Кб, 10 просмотров)
Делаю лабы на Asm/Delphi/C++/Python/VBA(Excel): asmlabs.ru
7in вне форума Ответить с цитированием
Старый 10.02.2016, 19:32   #2
7in
(aka Jin X) !RTFM!
Форумчанин
 
Аватар для 7in
 
Регистрация: 14.12.2014
Сообщений: 295
По умолчанию

А вот, собственно, и код, касающийся первого вопроса:
Код:
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.
Делаю лабы на Asm/Delphi/C++/Python/VBA(Excel): asmlabs.ru
7in вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Компонент для записи звука в .mp3 или .ogg CheChe Компоненты Delphi 3 01.07.2015 20:14
Ошибка при удалении звука в OpenAL andreil Общие вопросы C/C++ 1 27.04.2015 10:17
Список устройст записи звука... demx Мультимедиа в Delphi 3 10.07.2011 00:29
обработка искл. ситуации при изменении масштаба Torkve Помощь студентам 3 02.06.2010 22:36
Фронты при создании звука. SilverMan39 Мультимедиа в Delphi 2 28.06.2009 14:17