wave.pas

delphi中很有名的delphiX组件。传奇2客户端源代码也是用这个组件。

unit Wave;

interface

{$INCLUDE DelphiXcfg.inc}

uses
  Windows, SysUtils, Classes, MMSystem;

type

  {  EWaveError  }

  EWaveError = class(Exception);

  {  TWave  }

  TWave = class(TPersistent)
  private
    FData: Pointer;
    FFormat: PWaveFormatEx;
    FFormatSize: Integer;
    FSize: Integer;
    procedure SetFormatSize(Value: Integer);
    procedure SetSize(Value: Integer);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadData(Stream: TStream); virtual;
    procedure WriteData(Stream: TStream); virtual;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    procedure LoadFromFile(const FileName : string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName : string);
    procedure SaveToStream(Stream: TStream);
    procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
    property Data: Pointer read FData;
    property Format: PWaveFormatEx read FFormat;
    property FormatSize: Integer read FFormatSize write SetFormatSize;
    property Size: Integer read FSize write SetSize;
  end;

  {  TCustomDXWave  }

  TCustomDXWave = class(TComponent)
  private
    FWave: TWave;
    procedure SetWave(Value: TWave);
  public
    constructor Create(AOnwer: TComponent); override;
    destructor Destroy; override;
    property Wave: TWave read FWave write SetWave;
  end;

  {  TDXWave  }

  TDXWave = class(TCustomDXWave)
  published
    property Wave;
  end;

  {  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;

  {  TWaveObjectStream  }

  TWaveObjectStream = class(TCustomWaveStream)
  private
    FWave: TWave;
  protected
    function GetFormat: PWaveFormatEx; override;
    function GetFormatSize: Integer; override;
    function GetSize: Integer; override;
    function ReadWave(var Buffer; Count: Integer): Integer; override;
    procedure SetFormatSize(Value: Integer); override;
    procedure SetSize(Value: Integer); override;
    function WriteWave(const Buffer; Count: Integer): Integer; override;
  public
    constructor Create(AWave: TWave);
  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;

{  TWave  }

const
  WavePoolSize = 8096;

destructor TWave.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TWave.Assign(Source: TPersistent);
var
  AWave: TWave;
begin
  if Source=nil then
  begin
    Clear;
  end else if Source is TWave then
  begin
    if Source<>Self then
    begin
      AWave := TWave(Source);
      Size := AWave.Size;
      FormatSize := AWave.FormatSize;
      Move(AWave.Data^, FData^, FSize);
      Move(AWave.Format^, FFormat^, FFormatSize);
    end;
  end else
    inherited Assign(Source);
end;

procedure TWave.Clear;
begin
  FreeMem(FData, 0); FData := nil;
  FreeMem(FFormat, 0); FFormat := nil;

  FSize := 0;
  FFormatSize := 0;
end;

procedure TWave.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('WAVE', ReadData, WriteData, True);
end;

procedure TWave.LoadFromFile(const FileName : string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TWave.LoadFromStream(Stream: TStream);
var
  WaveStream: TWaveStream;
begin
  Clear;

  WaveStream := TWaveStream.Create(Stream);
  try
    WaveStream.Open(False);

    FormatSize := WaveStream.FormatSize;
    Move(WaveStream.Format^, Format^, FormatSize);
    Size := WaveStream.Size;
    WaveStream.ReadBuffer(FData^, Size);
  finally
    WaveStream.Free;
  end;
end;

procedure TWave.ReadData(Stream: TStream);
begin
  LoadFromStream(Stream);
end;

procedure TWave.SaveToFile(const FileName : string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TWave.SaveToStream(Stream: TStream);
var
  WaveStream: TWaveStream;
begin
  if (FFormatSize<=0) or (FSize<=0) then Exit;

  WaveStream := TWaveStream.Create(Stream);
  try
    WaveStream.FormatSize := FormatSize;
    Move(Format^, WaveStream.Format^, FormatSize);

    WaveStream.Open(True);
    WaveStream.WriteBuffer(FData^, Size);
  finally
    WaveStream.Free;
  end;
end;

procedure TWave.SetFormatSize(Value: Integer);
begin
  if Value<=0 then Value := 0;
  ReAllocMem(FFormat, Value);
  FFormatSize := Value;
end;

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

procedure TWave.SetSize(Value: Integer);
var
  i: Integer;
begin
  if Value<=0 then Value := 0;

  i := (Value+WavePoolSize-1) div WavePoolSize;
  if i<>(FSize+WavePoolSize-1) div WavePoolSize then
    ReAllocMem(FData, i*WavePoolSize);

  FSize := Value;
end;

procedure TWave.WriteData(Stream: TStream);
begin
  SaveToStream(Stream);
end;

{  TCustomDXWave  }

constructor TCustomDXWave.Create(AOnwer: TComponent);
begin
  inherited Create(AOnwer);
  FWave := TWave.Create;
end;

destructor TCustomDXWave.Destroy;
begin
  FWave.Free;
  inherited Destroy;
end;

procedure TCustomDXWave.SetWave(Value: TWave);
begin
  FWave.Assign(Value);
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