Obsługa karty dźwiękowej

unit win;

interface

uses
  Windows, MMSystem;

const
  N = 10;
  BUF_SIZE = 1024;

type
  TProcedureIn = procedure;

  TIn = class
  private
    FRunning: Boolean;
    FBufory: array[0..N] of Pointer;
    FHdr: array[0..N] of WAVEHDR;
    FFirst: Integer;
    FLast: Integer;
    FOffFirst: Integer;
    FHandle: LongWord;
    FWrite: Integer;
    FDone: TProcedureIn;
    procedure MakeHandle;
    procedure AddData;
    procedure SetRunning(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    function Read(Buffor: Pointer; Count: Integer): Integer;
    procedure Start;
    procedure Stop;
    property Running: Boolean read FRunning write SetRunning;
    property OnDone: TProcedureIn read FDone write FDone;
  end;

implementation

const
  MaxIns = 20;

var
  ins: array[0..MaxIns] of record Han: Longword; cin: TIn; end;

procedure WaveInError(r: MMResult);
var
  a: array[Byte] of Char;
begin
  waveInGetErrorText(r, a, 256);
  MessageBox(0, 'WaveIn Error', a, MB_OK);
end;

procedure IncLic(var l: Integer);
begin
  l:= (l + 1) mod (N + 1);
end;

procedure CalcP(var P: Pointer; m: LongWord);
begin
  P:= Pointer(longWord(P) + m);
end;

function LockFor(n: Longword): Integer;
var
  i: Integer;
begin
  for i:= 0 to Maxins do begin
    if n = ins[i].Han then begin
       Result:= i;
       Exit;
    end;
  end;
  Result:= -1;
end;

procedure waveInProc(hwi: LongWord; Msg: UInt; dwInstance, dwParam1, dwParam2: DWord); stdcall;
var
  i: Integer;
begin
  case Msg of
    WIM_CLOSE: begin
    end;
    WIM_DATA: begin
       i:= LockFor(hwi);
       if i >= 0 then begin
          ins[i].cin.AddData;
          if Assigned(ins[i].cin.FDone) then ins[i].cin.FDone;
       end;
    end;
    WIM_OPEN: begin
    end;
  end;
end;

procedure TIn.AddData;
begin
  IncLic(FLast);
  if FLast = FFirst then IncLic(FFirst);
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);
end;

procedure TIn.SetRunning(Value: Boolean);
begin
  if FRunning = Value then Exit;
  if Value then Start else Stop;
end;

procedure TIn.MakeHandle;
var
  lp: TWaveFormatEx;
  r: MMResult;
begin
  if FHandle <> 0 then begin
     ins[LockFor(FHandle)].Han:= 0;
  end;
  with lp do begin
    wFormatTag:= WAVE_FORMAT_PCM;
    nChannels:= 1;
    nSamplesPerSec:= 32000;
    nAvgBytesPerSec:= nSamplesPerSec * nBlockAlign;
    nBlockAlign:= (nChannels * wBitsPerSample) div 8;
    wBitsPerSample:= 8;
    cbSize:= Sizeof(lp);
  end;
  r:= waveInOpen(@FHandle, 0, @lp, Cardinal(@WaveInProc), hInstance, CALLBACK_FUNCTION);
  if FHandle  = 0 then
     WaveInError(r)
  else begin
     ins[LockFor(0)].Han:= FHandle;
     ins[LockFor(FHandle)].cin:= Self;
  end;
end;

constructor TIn.Create;
var
  i: Integer;
begin
  FFirst:= 0;
  FLast:= 0;
  FOffFirst:= 0;
  FWrite:= 0;
  FRunning:= False;  
  MakeHandle;
  for i:= 0 to N do begin
      GetMem(FBufory[i], BUF_SIZE);
      FHdr[i].lpData:= FBufory[i];
      Fhdr[i].dwBufferLength:= BUF_SIZE;
      waveInPrepareHeader(FHandle, @FHdr[i], Sizeof(FHdr[i]));
  end;
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);
  waveInAddBuffer(FHandle, @FHdr[FWrite], Sizeof(FHdr[FWrite])); IncLic(FWrite);        
end;

destructor TIn.Destroy;
var
  i: Integer;
begin
  if FHandle <> 0 then begin
     waveInStop(FHandle);
     waveInClose(FHandle);
  end;
  for i:= 0 to N do begin
      waveInUnPrepareHeader(FHandle, @FHdr[i], Sizeof(FHdr[i]));  
      FreeMem(FBufory[i], BUF_SIZE);
  end;
end;

procedure Tin.Start;
begin
  waveInStart(FHandle);
  FRunning:= True;
end;

procedure TIn.Stop;
begin
  waveInStop(FHandle);
  FRunning:= False;
end;

function TIn.Read(Buffor: Pointer; Count: Integer): Integer;
var
  do_od: Integer;
  od: Integer;
  ile: Integer;
  Dest, Src: Pointer;
begin
  do_od:= Count;
  od:= 0;
  Dest:= Pointer(Buffor);
  while do_od > 0 do begin
    if FFirst = FLast then Break;
    ile:= BUF_SIZE - FOffFirst; // ilosc pozostalych bajtow w danym buforze
    Src:= FBufory[FFirst];
    CalcP(Src, FOffFirst); // obliczanie zrudla
    if do_od >= ile then begin
       move(Src^, Dest^, ile);
       inc(od, ile);
       CalcP(Dest, ile);
       dec(do_od, ile); // zmniejszamy ilosc bajtow do odczytania
       IncLic(FFirst); // nastepny buffor
       FOffFirst:= 0; // nastepny buffor czytamy od poczatku
       if FFirst = FLast then
          Break;
    end else begin
       move(Src^, Dest^, do_od);
       inc(od, do_od);
       Inc(FOffFirst, do_od);
       do_od:= 0;
    end;
  end;
  Result:= od;
end;


initialization
  FillChar(ins, MaxIns * Sizeof(ins[0]), 0);

end.