acmconvertor.pas

语音acm控件

{ACMIO v1.0

                            EMail: [e-mail]
                            Http:  pcauto.3322.net
}
unit ACMConvertor;

interface

uses
  Classes, Messages, Windows, Forms, SysUtils, Controls, MSACM, MMSystem;

type
  EACMConvertor = class(Exception);


  TACMWaveFormat = packed record
    case integer of
      0 : (Format : TWaveFormatEx);
      1 : (RawData : Array[0..128] of byte);
  end;

  TACMConvertor = Class(TComponent)
  private
    FChooseData               : TACMFORMATCHOOSEA;
    FActive                   : Boolean;
    FBufferIn                 : Pointer;
    FBufferOut                : Pointer;
    FInputBufferSize          : DWord;
    FOutputBufferSize         : DWord;
    FStartOfStream            : Boolean;
    FStreamHandle             : HACMStream;
    FStreamHeader             : TACMStreamHeader;

    procedure ReadFormatIn(Stream : TStream);
    procedure ReadFormatOut(Stream : TStream);
    procedure WriteFormatIn(Stream : TStream);
    procedure WriteFormatOut(Stream : TStream);
    procedure SetActive(const Value: Boolean);
    procedure SetInputBufferSize(const Value: DWord);
  protected
    procedure CloseStream;
    procedure DefineProperties(Filer : TFiler); override;
    procedure OpenStream;
    procedure ReadFormat(var Format : TACMWaveFormat; Stream : TStream);
    procedure WriteFormat(var Format : TACMWaveFormat; Stream : TStream);
  public
    FormatIn,
    FormatOut                 : TACMWaveFormat;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function  Open(Data:Pointer;Size:DWord):Boolean;
    function  Close():Boolean;
    function  Convert() : DWord  ;  //result is the used outbuffer length


    function  ChooseFormat(var Format : TACMWaveFormat; const UseDefault : Boolean) : Boolean;
    function  ChooseFormatIn(const UseDefault : Boolean) : Boolean;
    function  ChooseFormatOut(const UseDefault : Boolean) : Boolean;

    procedure RaiseException(aMessage : String; Result : MMResult);
    function  SuggestFormat(aFormat : TACMWaveFormat{; MandatorySettings : TMandatorySettings}) : TACMWaveFormat;

    property Active           : Boolean
      read FActive;
    property BufferIn         : Pointer
      read FBufferIn ;
    property BufferOut        : Pointer
      read FBufferOut;
    property OutputBufferSize : DWord
      read FOutputBufferSize;
    property InputBufferSize  : DWord
      read FInputBufferSize ;
  published

  end;

implementation
{ TACMConvertor }
function TACMConvertor.Open (Data:Pointer;Size:DWord):Boolean;
begin
   if active=false then
   begin
       SetInputBufferSize(Size);
       SetActive(True);
       Move(Data^,FBufferin^,FinputBufferSize);
   end
   else
   begin
      if Size<>FInputBufferSize then
      begin
         SetActive(False);
         SetInputBufferSize(Size);
         setactive(True);
      end;
      Move(Data^,FBufferin^,FinputBufferSize);
   end;
   Result:=True;
end;

function TACMConvertor.Close():Boolean;
Begin
   SetActive(False);
   result:=True;
end;



function TACMConvertor.ChooseFormat(var Format: TACMWaveFormat; const UseDefault : Boolean) : Boolean;
var
  OrigFormat                  : PWaveFormatEX;
  Res                         : Longint;
begin
  Result := False;
  GetMem(OrigFormat,Sizeof(TACMWaveFormat));

  try
    if UseDefault then
      Move(Format,OrigFormat^, SizeOf(TACMWaveFormat))
    else with OrigFormat^ do begin
      wFormatTag := 1;
      nChannels := 1;
      nSamplesPerSec := 8000;
      nAvgBytesPerSec:= 8000;
      nBlockAlign:=1;
      wbitspersample := 8;
      cbSize :=0;
    end;

    with FChooseData do begin
      pwfx := OrigFormat;
      cbStruct := SizeOf(FChooseData);  //Size of this structure
      cbwfx := SizeOf(TACMWaveFormat);  //Size of our WaveFormat

      fdwStyle := ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT //use our default when choosing
    end;

    Res := acmFormatChoose(FChooseData);

    if Res = MMSYSERR_NoError then begin
      Move(FChooseData.pwfx^,Format, SizeOf(TACMWaveFormat));
      Result := True;
    end else
      if Res <> ACMErr_Canceled then RaiseException('Choose format', Res);
  finally
    FreeMem(OrigFormat);
  end;
end;

function TACMConvertor.ChooseFormatIn(const UseDefault : Boolean) : Boolean;
begin
  Result := ChooseFormat(FormatIn, UseDefault);
end;

function TACMConvertor.ChooseFormatOut( const UseDefault : Boolean): Boolean;
begin
  Result := ChooseFormat(FormatOut, UseDefault);
end;

procedure TACMConvertor.CloseStream;
var
  Result : MMResult;
begin
  Result := acmStreamUnPrepareHeader(FStreamHandle, FStreamHeader, 0);
  RaiseException('acmStreamUnPrepareHeader:',Result);

  Result := acmStreamClose(FStreamHandle, 0);
  RaiseException('acmStreamClose:',Result);

  FreeMem(FBufferIn);
  FreeMem(FBufferOut);
  FActive := False;
  FStartOfStream := False;
end;

function TACMConvertor.Convert() : DWord;    //result is the used outbuffer length
var
  Res : MMResult;
  IsTheStart : DWord;
begin
  if FStartOfStream then
    IsTheStart := ACM_STREAMCONVERTF_BLOCKALIGN
  else
    IsTheStart := 0;

  FillChar(BufferOut^,OutputBufferSize,#0);
  Res := acmStreamConvert(FStreamHandle,FStreamHeader,
    ACM_STREAMCONVERTF_BLOCKALIGN or IsTheStart);
  RaiseException('acmStreamConvert:',Res);

  Res := acmStreamReset(FStreamHandle,0);
  RaiseException('acmStreamReset',Res);

  Result := FStreamHeader.cbDstLengthUsed;

  FStartOfStream := False;
end;

constructor TACMConvertor.Create(AOwner: TComponent);
begin
  inherited;
  FStreamHandle := 0;
   with FormatIn.Format do begin
    wFormatTag := 1;
    nChannels := 1;
    nSamplesPerSec := 22050;
    nAvgBytesPerSec:= 22050;
    nBlockAlign:=1;
    wbitspersample := 8;
    cbSize := SizeOf(TACMWaveFormat);
  end;
  with FormatOut.Format do begin
    wFormatTag := 1;
    nChannels := 1;
    nSamplesPerSec := 22050;
    nAvgBytesPerSec:= 22050;
    nBlockAlign:=1;
    wbitspersample := 8;
    cbSize := SizeOf(TACMWaveFormat);
  end;

end;

procedure TACMConvertor.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('ACMFormatIn',ReadFormatIn,WriteFormatIn,True);
  Filer.DefineBinaryProperty('ACMFormatOut',ReadFormatOut,WriteFormatOut,True);
end;

destructor TACMConvertor.Destroy;
begin
  FActive := False;
  inherited;
end;

procedure TACMConvertor.OpenStream;
  procedure BuildHeader;
  begin
    with FStreamHeader do begin
      cbStruct := SizeOf(TACMStreamHeader);
      fdwStatus := 0;
      dwUser := 0;
      pbSrc := FBufferIn;
      cbSrcLength := InputBufferSize;
      cbSrcLengthUsed := 0;
      dwSrcUser := 0;
      pbDst := FBufferOut;
      cbDstLength := OutputBufferSize;
      cbDstLengthUsed := 0;
      dwDstUser := 0;
    end;
  end;


var
  Result : MMResult;
begin
  FStartOfStream := True;

  Result := acmStreamOpen(FStreamhandle,0, FormatIn.Format, FormatOut.Format, nil, 0, 0, 0);
  RaiseException('acmStreamOpen:',Result);

  Result := acmStreamSize(FStreamHandle, InputBufferSize, FOutputBufferSize, ACM_STREAMSIZEF_SOURCE);
  RaiseException('acmStreamSize:',Result);

  GetMem(FBufferIn, InputBufferSize);
  Getmem(FBufferOut, OutputBufferSize);
  try
    BuildHeader;
    Result := acmStreamPrepareHeader(FStreamHandle, FStreamHeader, 0);
    RaiseException('acmStreamPrepareHeader:',Result);
  except
    Freemem(FBufferIn);
    Freemem(FBufferOut);
    raise;
  end;

  FActive := True;
end;

procedure TACMConvertor.RaiseException(aMessage : String; Result: MMResult);
begin
  case Result of
    ACMERR_NotPossible : Raise EACMConvertor.Create(aMessage + ' The requested operation cannot be performed.');
    ACMERR_BUSY : Raise EACMConvertor.Create(aMessage + ' The conversion stream is already in use.');
    ACMERR_UNPREPARED : Raise EACMConvertor.Create(aMessage + ' Cannot perform this action on a header that has not been prepared.');
    MMSYSERR_InvalFlag : Raise EACMConvertor.Create(aMessage + ' At least one flag is invalid.');
    MMSYSERR_InvalHandle : Raise EACMConvertor.Create(aMessage + ' The specified handle is invalid.');
    MMSYSERR_InvalParam : Raise EACMConvertor.Create(aMessage + ' At least one parameter is invalid.');
    MMSYSERR_NoMem : Raise EACMConvertor.Create(aMessage + ' The system is unable to allocate resources.');
    MMSYSERR_NoDriver : Raise EACmConvertor.Create(aMessage + ' A suitable driver is not available to provide valid format selections.');
  else
    if Result <> 0 then
      Raise EACMConvertor.Create(Format('%s raised an unknown error (code #%d)',[aMessage,Result]));
  end;
end;

procedure TACMConvertor.ReadFormat(var Format: TACMWaveFormat;
  Stream: TStream);
var
  TheSize                     : Integer;
begin
  Stream.Read(TheSize,SizeOf(Integer));
  Stream.Read(Format,TheSize);
end;

procedure TACMConvertor.ReadFormatIn(Stream: TStream);
begin
  ReadFormat(FormatIn, Stream);
end;

procedure TACMConvertor.ReadFormatOut(Stream: TStream);
begin
  ReadFormat(FormatOut, Stream);
end;

procedure TACMConvertor.SetActive(const Value: Boolean);
begin
  if Value = FActive then exit;
  if Value then
    OpenStream
  else
    CloseStream;
end;

procedure TACMConvertor.SetInputBufferSize(const Value: DWord);
begin
  if Active then
    raise EACMConvertor.Create('You cannot change the buffer size while active.');
  FInputBufferSize := Value;
end;

function TACMConvertor.SuggestFormat(aFormat : TACMWaveFormat{; MandatorySettings : TMandatorySettings}): TACMWaveFormat;
var
  R : MMResult;
  Temp : TWaveFormatEx;
  ValidItems : DWord;
begin
  ValidItems := 0;
  R := acmFormatSuggest(0,aFormat.Format, Temp, SizeOf(TACMWaveFormat), ValidItems);
  if R <> 0 then RaiseException('SuggestFormat',R);
  move(Temp,Result,SizeOf(TACMWaveFormat));
end;

procedure TACMConvertor.WriteFormat(var Format: TACMWaveFormat;
  Stream: TStream);
var
  TheSize                     : Integer;
begin
  TheSize := SizeOf(Format);
  Stream.Write(TheSize, SizeOf(Integer));
  Stream.Write(Format,TheSize);
end;

procedure TACMConvertor.WriteFormatIn(Stream: TStream);
begin
  WriteFormat(FormatIn, Stream);
end;

procedure TACMConvertor.WriteFormatOut(Stream: TStream);
begin
  WriteFormat(FormatOut, Stream);
end;

end.