wave.pas

VCL component dsplab , STFT and SPECTRUM viewer, real time

unit Wave;

interface

uses
  Windows, SysUtils, Classes, MMSystem;

type

  {  EWaveStreamError  }

  EWaveStreamError = class(Exception);

  {  TCustomWaveStream  }

  TCustomWaveStream = class(TStream)
  private
    FPosition: Integer;
  protected
    function GetFilledSize: Integer; virtual;
    function GetFormat: PWaveFormatEx; virtual; abstract;
    function GetFormatSize: Integer; virtual;
    function GetSize: Integer; virtual;
    function ReadWave(var Buffer; Count: Integer): Integer; virtual;
    procedure SetFormatSize(Value: Integer); virtual; abstract;
    procedure SetSize(Value: Integer); override;
    function WriteWave(const Buffer; Count: Integer): Integer; virtual;
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
    property FilledSize: Integer read GetFilledSize;
    property Format: PWaveFormatEx read GetFormat;
    property FormatSize: Integer read GetFormatSize write SetFormatSize;
    property Size: Integer read GetSize write SetSize;
  end;

  {  TCustomWaveStream2  }

  TCustomWaveStream2 = class(TCustomWaveStream)
  private
    FFormat: PWaveFormatEx;
    FFormatSize: Integer;
  protected
    function GetFormat: PWaveFormatEx; override;
    function GetFormatSize: Integer; override;
    procedure SetFormatSize(Value: Integer); override;
  public
    destructor Destroy; override;
  end;

  {  TWaveStream  }

  TWaveStream = class(TCustomWaveStream2)
  private
    FDataPosition: Integer;
    FDataHeaderPosition: Integer;
    FOpened: Boolean;
    FOriPosition: Integer;
    FReadMode: Boolean;
    FSize: Integer;
    FStream: TStream;
    procedure CloseWriteMode;
    procedure OpenReadMode;
    procedure OpenWriteMode;
  protected
    function GetSize: Integer; override;
    function ReadWave(var Buffer; Count: Integer): Integer; override;
    function WriteWave(const Buffer; Count: Integer): Integer; override;
  public
    constructor Create(AStream: TStream);
    destructor Destroy; override;
    procedure Open(WriteMode: Boolean);
  end;

  {  TWaveFileStream  }

  TWaveFileStream = class(TWaveStream)
  private
    FFileStream: TFileStream;
  public
    constructor Create(const FileName: string; FileMode: Integer);
    destructor Destroy; override;
  end;

procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
  SamplesPerSec, BitsPerSample, Channels: Integer);

implementation

uses DXConsts;

procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
  SamplesPerSec, BitsPerSample, Channels: Integer);
begin
  with Format do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := Channels;
    nSamplesPerSec := SamplesPerSec;
    wBitsPerSample := BitsPerSample;
    nBlockAlign := nChannels*(wBitsPerSample div 8);
    nAvgBytesPerSec := nBlockAlign*nSamplesPerSec;
    cbSize := 0;
  end;
end;

{  TCustomWaveStream  }

function TCustomWaveStream.GetFilledSize: Longint;
begin
  Result := -1;
end;

function TCustomWaveStream.GetFormatSize: Integer;
begin
  Result := 0;
end;

function TCustomWaveStream.GetSize: Integer;
begin
  Result := -1;
end;

function TCustomWaveStream.Read(var Buffer; Count: Longint): Longint;
begin
  if GetSize<0 then
    Result := ReadWave(Buffer, Count)
  else
  begin
    if FPosition>Size then
      FPosition := Size;
    if FPosition+Count>Size then
      Result := Size-FPosition
    else
      Result := Count;

    Result := ReadWave(Buffer, Result);
  end;

  Inc(FPosition, Result);
end;

function TCustomWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
  Result := 0;
end;

function TCustomWaveStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent  : FPosition := FPosition + Offset;
    soFromEnd      : FPosition := GetSize + Offset;
  end;
  if FPosition<0 then FPosition := 0;
  if FPosition>GetSize then FPosition := GetSize;

  Result := FPosition;
end;

procedure TCustomWaveStream.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
begin
  FormatSize := SizeOf(TWaveFormatEx);
  MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
end;

procedure TCustomWaveStream.SetSize(Value: Integer);
begin
end;

function TCustomWaveStream.Write(const Buffer; Count: Longint): Longint;
begin
  if FPosition>Size then
    FPosition := Size;
  Result := WriteWave(Buffer, Count);
  Inc(FPosition, Result);
end;

function TCustomWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
  Result := 0;
end;

{  TCustomWaveStream2  }

destructor TCustomWaveStream2.Destroy;
begin
  FormatSize := 0;
  inherited Destroy;
end;

function TCustomWaveStream2.GetFormat: PWaveFormatEx;
begin
  Result := FFormat;
end;

function TCustomWaveStream2.GetFormatSize: Integer;
begin
  Result := FFormatSize;
end;

procedure TCustomWaveStream2.SetFormatSize(Value: Integer);
begin
  ReAllocMem(FFormat, Value);
  FFormatSize := Value;
end;

{  TWaveStream  }

const
  ID_RIFF = Ord('R') + Ord('I')*$100 + Ord('F')*$10000 + Ord('F')*$1000000;
  ID_WAVE = Ord('W') + Ord('A')*$100 + Ord('V')*$10000 + Ord('E')*$1000000;
  ID_FMT  = Ord('f') + Ord('m')*$100 + Ord('t')*$10000 + Ord(' ')*$1000000;
  ID_FACT = Ord('f') + Ord('a')*$100 + Ord('c')*$10000 + Ord('t')*$1000000;
  ID_DATA = Ord('d') + Ord('a')*$100 + Ord('t')*$10000 + Ord('a')*$1000000;

type
  TWaveFileHeader = packed record
    FType: Integer;
    Size: Longint;
    RType: Integer;
  end;

  TWaveChunkHeader = packed record
    CType: Longint;
    Size: Longint;
  end;

constructor TWaveStream.Create(AStream: TStream);
begin
  inherited Create;
  FStream := AStream;

  FOriPosition := FStream.Position;
end;

destructor TWaveStream.Destroy;
begin
  if FOpened and (not FReadMode) then
    CloseWriteMode;
  inherited Destroy;
end;

function TWaveStream.GetSize: Integer;
begin
  if FOpened then
  begin
    if not FReadMode then
      Result := FStream.Size-FDataPosition
    else
      Result := FSize;
  end else
    Result := 0;
end;

function TWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
  if not FOpened then
    raise EWaveStreamError.Create(SStreamNotOpend);

  FStream.Position := FDataPosition+Position;
  Result := FStream.Read(Buffer, Count);
end;

function TWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
  if not FOpened then
    raise EWaveStreamError.Create(SStreamNotOpend);

  if FReadMode then
  begin
    if Position+Count>FSize then
      Count := FSize-Position;
  end;

  FStream.Position := FDataPosition+Position;
  Result := FStream.Write(Buffer, Count);
end;

procedure TWaveStream.Open(WriteMode: Boolean);
begin
  if WriteMode then
    OpenWriteMode
  else
    OpenReadMode;
end;

procedure TWaveStream.OpenReadMode;
var
  WF: TWaveFileHeader;
  WC: TWaveChunkHeader;

  procedure Readfmt;   { fmt }
  begin
    FormatSize := WC.Size;
    FStream.ReadBuffer(Format^, WC.Size);
  end;

  procedure Readdata; { data }
  begin
    FSize := WC.Size;
    FDataPosition := FStream.Position;
    FStream.Seek(FSize, 1);
  end;

begin
  if FOpened then
    raise EWaveStreamError.Create(SStreamOpend);

  FOpened := True;
  FReadMode := True;

  FStream.Position := FOriPosition;

  {  File header reading.  }
  FStream.ReadBuffer(WF, SizeOf(TWaveFileHeader));

  {  Is it Wave file of the file?  }
  if (WF.FType<>ID_RIFF) or (WF.RType<>ID_WAVE) then
    raise EWaveStreamError.Create(SInvalidWave);

  {  Chunk reading.  }
  FillChar(WC, SizeOf(WC), 0);
  FStream.Read(WC, SizeOf(TWaveChunkHeader));
  while WC.CType<>0 do
  begin
    case WC.CType of
      ID_FMT : Readfmt;
      ID_DATA: Readdata;
    else
    {  Chunk which does not correspond is disregarded.  }
      FStream.Seek(WC.Size, 1);
    end;

    FillChar(WC, SizeOf(WC), 0);
    FStream.Read(WC, SizeOf(TWaveChunkHeader));
  end;
end;

procedure TWaveStream.OpenWriteMode;

  procedure WriteFmt;    { fmt }
  var
    WC: TWaveChunkHeader;
  begin
    with WC do
    begin
      CType := ID_FMT;
      Size := FFormatSize;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));
    FStream.WriteBuffer(FFormat^, FFormatSize);
  end;

  procedure WriteData;   { data }
  var
    WC: TWaveChunkHeader;
  begin
    FDataHeaderPosition := FStream.Position;

    with WC do
    begin
      CType := ID_DATA;
      Size := 0;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));

    FDataPosition := FStream.Position;
  end;

var
  WF: TWaveFileHeader;
begin
  if FOpened then
    raise EWaveStreamError.Create(SStreamOpend);

  if FormatSize=0 then
    raise EWaveStreamError.Create(SInvalidWaveFormat);

  FOpened := True;
  FStream.Position := FOriPosition;

  FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));

  {  Chunk writing.  }
  WriteFmt;
  WriteData;
end;

procedure TWaveStream.CloseWriteMode;

  procedure WriteDataHeader; { data }
  var
    WC: TWaveChunkHeader;
  begin
    FStream.Position := FDataHeaderPosition;

    with WC do
    begin
      CType := ID_DATA;
      Size := Self.Size;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));
  end;

var
  WF: TWaveFileHeader;
begin
  with WF do
  begin
    FType := ID_RIFF;
    Size := (FStream.Size-FOriPosition)-SizeOf(TWaveChunkHeader);
    RType := ID_WAVE;
  end;
  FStream.Position := FOriPosition;
  FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
  WriteDataHeader;
  FStream.Position := FStream.Size;
end;

{  TWaveFileStream  }

constructor TWaveFileStream.Create(const FileName: string; FileMode: Integer);
begin
  FFileStream := TFileStream.Create(FileName, FileMode);
  inherited Create(FFileStream);
end;

destructor TWaveFileStream.Destroy;
begin
  inherited Destroy;
  FFileStream.Free;
end;

end.