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

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.