wavestorage.pas

一整套声音录制控件

{------------------------------------------------------------------------------}
{                                                                              }
{  WaveStorage - Wave storage components                                       }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}

unit WaveStorage;

interface

uses
  Windows, Messages, Classes, mmSystem, WaveUtils, WaveACM;

type

  // Encapsulates a wave audio as a stream and provides easy access to its
  // informational fields.
  TWaveStreamAdapter = class(TPersistent)
  private
    fStream: TStream;
    fOwnership: TStreamOwnership;
    fModified: Boolean;
    fValid: Boolean;
    fDataSize: DWORD;
    fDataOffset: DWORD;
    fWaveFormat: PWaveFormatEx;
    fOnChanging: TNotifyEvent;
    fOnChange: TNotifyEvent;
    fState: TWaveStreamState;
    function GetValid: Boolean;
    function GetEmpty: Boolean;
    function GetDataSize: DWORD;
    function GetDataOffset: DWORD;
    function GetLength: DWORD;
    function GetBitRate: DWORD;
    function GetPeakLevel: Integer;
    function GetPCMFormat: TPCMFormat;
    function GetWaveFormat: PWaveFormatEx;
    function GetAudioFormat: String;
    function GetPosition: Integer;
    procedure SetPosition(Value: Integer);
  protected
    ckRIFF, ckData: TMMCKInfo;
    mmIO: HMMIO;
    function UpdateWaveInfo: Boolean; virtual;
    function LockData(out pData: Pointer; ForceCopy: Boolean): Boolean; virtual;
    function UnlockData(pData: Pointer; WriteData: Boolean): Boolean; virtual;
    function MSecToByte(MSec: DWORD): DWORD; virtual;
    procedure DoChanging; virtual;
    procedure DoChange; virtual;
    property Modified: Boolean read fModified;
  public
    constructor Create(AStream: TStream; AOwnership: TStreamOwnership
      {$IFDEF COMPILER4_UP} = soReference {$ENDIF}); virtual;
    destructor Destroy; override;
    function Equals(Wave: TWaveStreamAdapter): Boolean; virtual;
    function SameFormat(WaveStream: TWaveStreamAdapter): Boolean; virtual;
    function SameWaveFormat(pWaveFormat: PWaveFormatEx): Boolean; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromStream(AStream: TStream); virtual;
    procedure SaveToStream(AStream: TStream); virtual;
    procedure LoadFromFile(const AFileName: String); virtual;
    procedure SaveToFile(const AFileName: String); virtual;
    procedure Clear; virtual;
    procedure Refresh; virtual;
    procedure Crop; virtual;
    function Invert: Boolean; virtual;
    function ChangeVolume(Percent: Integer): Boolean; virtual;
    function ConvertTo(const pTargetWaveFormat: PWaveFormatEx): Boolean; virtual;
    function ConvertToPCM(TargetFormat: TPCMFormat): Boolean;
    function Delete(Pos: DWORD; Len: DWORD): Boolean; virtual;
    function Insert(Pos: DWORD; WaveStream: TWaveStreamAdapter): Boolean; virtual;
    function InsertSilence(Pos: DWORD; Len: DWORD): Boolean; virtual;
    function BeginRewrite(pWaveFormat: PWaveFormatEx): Boolean; virtual;
    function BeginRewritePCM(Format: TPCMFormat): Boolean;
    function EndRewrite: Boolean; virtual;
    function Write(const Buffer; Count: Integer): Integer; virtual;
    function BeginRead: Boolean; virtual;
    function EndRead: Boolean; virtual;
    function Read(var Buffer; Count: Integer): Integer; virtual;
    property Stream: TStream read fStream;
    property Ownership: TStreamOwnership read fOwnership write fOwnership;
    property State: TWaveStreamState read fState;
    property Valid: Boolean read GetValid;
    property Empty: Boolean read GetEmpty;
    property DataSize: DWORD read GetDataSize;
    property DataOffset: DWORD read GetDataOffset;
    property PCMFormat: TPCMFormat read GetPCMFormat;
    property WaveFormat: PWaveFormatEx read GetWaveFormat;
    property AudioFormat: String read GetAudioFormat;
    property Length: DWORD read GetLength;              // in milliseconds
    property BitRate: DWORD read GetBitRate;            // in kbps
    property PeakLevel: Integer read GetPeakLevel;      // in percent
    property Position: Integer read GetPosition write SetPosition;
    property OnChanging: TNotifyEvent read fOnChanging write fOnChanging;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  // Converts audio format of wave streams
  TWaveStreamConverter = class(TWaveStreamAdapter)
  private
    fBufferFormat: PWaveFormatEx;
    ACMStream: HACMSTREAM;
    ACMHeader: TACMSTREAMHEADER;
    SrcBuffer: Pointer;
    SrcBufferSize: DWORD;
    DstBuffer: Pointer;
    DstBufferSize: DWORD;
    BufferOffset: DWORD;
  protected
    procedure Reset;
  public
    destructor Destroy; override;
    procedure SetBufferFormat(const pWaveFormat: PWaveFormatEx); virtual;
    procedure SetBufferFormatPCM(Format: TPCMFormat);
    function CanRewrite(pWaveFormat: PWaveFormatEx): Boolean; virtual;
    function CanRewritePCM(Format: TPCMFormat): Boolean;
    function BeginRewrite(pWaveFormat: PWaveFormatEx): Boolean; override;
    function EndRewrite: Boolean; override;
    function Write(const Buffer; Count: Integer): Integer; override;
    function CanRead: Boolean; virtual;
    function BeginRead: Boolean; override;
    function EndRead: Boolean; override;
    function Read(var Buffer; Count: Integer): Integer; override;
    property BufferFormat: PWaveFormatEx read fBufferFormat;
  end;

  // Creates a memory stream as a wave audio
  TWave = class(TWaveStreamAdapter)
  public
    constructor Create;
      {$IFDEF COMPILER4_UP} reintroduce; {$ENDIF}
  end;

  // Creates a file stream as a wave audio
  TWaveFile = class(TWaveStreamAdapter)
  public
    constructor Create(const FileName: String; Mode: Word);
      {$IFDEF COMPILER4_UP} reintroduce; {$ENDIF}
  end;

  // Creates a memory stream as a wave audio for conversion purpose
  TWaveConverter = class(TWaveStreamConverter)
  public
    constructor Create;
      {$IFDEF COMPILER4_UP} reintroduce; {$ENDIF}
  end;

  // Creates a file stream as a wave audio for conversion purpose
  TWaveFileConverter = class(TWaveStreamConverter)
  public
    constructor Create(const FileName: String; Mode: Word);
      {$IFDEF COMPILER4_UP} reintroduce; {$ENDIF}
  end;

  // Base class for wave storage classes
  TCustomWaveStorage = class(TComponent)
  protected
    function GetWaveStream(Index: Integer): TStream; virtual; abstract;
  public
    function Equals(Another: TCustomWaveStorage): Boolean; virtual; abstract;
    property WaveStream[Index: Integer]: TStream read GetWaveStream;
  end;

  // Stores one wave audio
  TWaveStorage = class(TCustomWaveStorage)
  private
    fWave: TWave;
    procedure SetWave(Value: TWave);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function GetWaveStream(Index: Integer): TStream; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function Equals(Another: TCustomWaveStorage): Boolean; override;
  published
    property Wave: TWave read fWave write SetWave;
  end;

  // Stores a collection of wave audios

  TWaveItem = class;
  TWaveItems = class;

  TWaveItemClass = class of TWaveItem;

  // TWave Item
  TWaveItem = class(TCollectionItem)
  private
    fName: String;
    fWave: TWave;
    fTag: Integer;
    procedure SetWave(Value: TWave);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function GetDisplayName: String; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Wave: TWave read fWave write SetWave;
    property Name: String read fName write fName;
    property Tag: Integer read fTag write fTag default 0;
  end;

  // TWaveItems
  TWaveItems = class(TCollection)
  private
    fOwner: TPersistent;
    function GetItem(Index: Integer): TWaveItem;
    procedure SetItem(Index: Integer; Value: TWaveItem);
  protected
    function GetOwner: TPersistent; override;
  public
    {$IFDEF COMPILER4_UP}
    constructor Create(AOwner: TPersistent; ItemClass: TWaveItemClass); reintroduce; virtual;
    {$ELSE}
    constructor Create(AOwner: TPersistent; ItemClass: TWaveItemClass); virtual;
    {$ENDIF}
    function Add: TWaveItem;
    {$IFDEF COMPILER4_UP}
    function Insert(Index: Integer): TWaveItem;
    {$ENDIF}
    property Items[Index: Integer]: TWaveItem read GetItem write SetItem; default;
  end;

  // TWaveCollection
  TWaveCollection = class(TCustomWaveStorage)
  private
    fWaves: TWaveItems;
    procedure SetWaves(const Value: TWaveItems);
  protected
    function GetWaveStream(Index: Integer): TStream; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Equals(Another: TCustomWaveStorage): Boolean; override;
    function ExportWaveNames(const List: TStrings): Integer; virtual;
    function IndexOfName(const AName: String): Integer; virtual;
  published
    property Waves: TWaveItems read fWaves write SetWaves;
  end;

implementation

uses
  SysUtils;

{ TWaveStreamAdapter }

constructor TWaveStreamAdapter.Create(AStream: TStream; AOwnership: TStreamOwnership);
begin
  inherited Create;
  fModified := True;
  fStream := AStream;
  fOwnership := AOwnership;
end;

destructor TWaveStreamAdapter.Destroy;
begin
  case fState of
    wssReading: EndRead;
    wssWriting: EndRewrite;
  end;
  if Assigned(fWaveFormat) then
    FreeMem(fWaveFormat);
  if fOwnership = soOwned then
    fStream.Free;
  inherited Destroy;
end;

function TWaveStreamAdapter.BeginRewritePCM(Format: TPCMFormat): Boolean;
var
  WaveFormatEx: TWaveFormatEx;
begin
  SetPCMAudioFormatS(@WaveFormatEx, Format);
  Result := BeginRewrite(@WaveFormatEx);
end;

function TWaveStreamAdapter.BeginRewrite(pWaveFormat: PWaveFormatEx): Boolean;
begin
  Result := False;
  if fState = wssReady then
  begin
    mmIO := CreateStreamWaveAudio(Stream, pWaveFormat, ckRIFF, ckData);
    if mmIO <> 0 then
    begin
      fState := wssWriting;
      fDataOffset := mmioSeek(mmIO, 0, SEEK_CUR);
      DoChanging;
      Result := True;
    end;
  end;
end;

function TWaveStreamAdapter.EndRewrite: Boolean;
begin
  Result := False;
  if fState = wssWriting then
  begin
    mmioAscend(mmIO, @ckData, 0);
    mmioAscend(mmIO, @ckRIFF, 0);
    mmioClose(mmIO, 0);
    mmIO := 0;
    fState := wssReady;
    UpdateWaveInfo;
    Stream.Size := fDataOffset + fDataSize;
    Result := True;
  end;
end;

function TWaveStreamAdapter.Write(const Buffer; Count: Integer): Longint;
begin
  if fState = wssWriting then
    Result := mmioWrite(mmIO, @Buffer, Count)
  else
    Result := -1;
end;

function TWaveStreamAdapter.BeginRead: Boolean;
begin
  Result := False;
  if Valid and (fState = wssReady) then
  begin
    mmIO := OpenStreamWaveAudio(Stream);
    if mmIO <> 0 then
    begin
      mmioSeek(mmIO, fDataOffset, SEEK_SET);
      fState := wssReading;
      Result := True;
    end;
  end;
end;

function TWaveStreamAdapter.EndRead: Boolean;
begin
  Result := False;
  if fState = wssReading then
  begin
    mmioClose(mmIO, 0);
    mmIO := 0;
    fState := wssReady;
    Result := True;
  end;
end;

function TWaveStreamAdapter.Read(var Buffer; Count: Integer): Integer;
begin
  if fState = wssReading then
    Result := mmioRead(mmIO, @Buffer, Count)
  else
    Result := -1;
end;

procedure TWaveStreamAdapter.DoChanging;
begin
  if not fModified then
  begin
    fValid := False;
    fModified := True;
    if Assigned(fOnChanging) then
      fOnChanging(Self);
  end;
end;

procedure TWaveStreamAdapter.DoChange;
begin
  if Assigned(fOnChange) then
    fOnChange(Self);
end;

function TWaveStreamAdapter.MSecToByte(MSec: DWORD): DWORD;
begin
  Result := GetWaveDataPositionOffset(fWaveFormat, MSec);
end;

function TWaveStreamAdapter.LockData(out pData: Pointer; ForceCopy: Boolean): Boolean;
begin
  Result := False;
  pData := nil;
  if UpdateWaveInfo and (fDataSize <> 0) then
  begin
    Result := True;
    if not ForceCopy and (Stream is TCustomMemoryStream) then
    begin
      pData := TCustomMemoryStream(Stream).Memory;
      Inc(PByte(pData), fDataOffset);
    end
    else
    begin
      ReallocMem(pData, fDataSize);
      Stream.Seek(fDataOffset, soFromBeginning);
      if DWORD(Stream.Read(pData^, fDataSize)) <> fDataSize then
      begin
        ReallocMem(pData, 0);
        Result := False;
      end;
    end;
  end;
end;

function TWaveStreamAdapter.UnlockData(pData: Pointer; WriteData: Boolean): Boolean;
begin
  Result := False;
  if Assigned(pData) then
  begin
    Result := True;
    if not (Stream is TCustomMemoryStream) or
      ((DWORD(TCustomMemoryStream(Stream).Memory) + fDataOffset) <> DWORD(pData)) then
    begin
      if WriteData then
      begin
        Stream.Seek(fDataOffset, soFromBeginning);
        if DWORD(Stream.Write(pData^, fDataSize)) <> fDataSize then
          Result := False;
      end;
      ReallocMem(pData, 0);
    end;
  end;
end;

function TWaveStreamAdapter.UpdateWaveInfo: Boolean;
begin
  if fModified and (fState <> wssWriting) then
  begin
    fModified := False;
    if Assigned(fWaveFormat) then
    begin
      FreeMem(fWaveFormat);
      fWaveFormat := nil;
    end;
    fValid := GetStreamWaveAudioInfo(Stream, fWaveFormat, fDataSize, fDataOffset);
    DoChange;
  end;