mmacmcvt.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 01.11.98 - 04:14:05 $                                        =}
{========================================================================}
unit MMACMCvt;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Controls,
    MMSystem,
    MMRegs,
    MMObj,
    MMDSPObj,
    MMString,
    MMUtils,
    MMWaveIO,
    MMPCMSup,
    MMACMSup;

type
   EMMConverterError = class(Exception);

   TMMConvertQuality = (cqHigh,cqLow);

   {-- TMMPCMConverter --------------------------------------------------------}
   TMMACMConverter = class(TMMDSPComponent)
   private
      FEnabled     : Boolean;
      FOpen        : Boolean;
      FStarted     : Boolean;
      FCvtBufSize  : Longint;
      FPSrcFormat  : PWaveFormatEx;
      FPDstFormat  : PWaveFormatEx;
      FCvtFormat   : PWaveFormatEx;
      FMustConvert : Boolean;        { the format must be converted    }
      FCanConvert  : Boolean;        { the format can be converted     }
      FPACMConvert : PACMConvert;    { structure for conversion        }
      FMoreBuffers : Boolean;
      FDone        : Boolean;
      FQuality     : TMMConvertQuality;
      Ftwh         : TMMWaveHdr;

      function  GetCanConvert: Boolean;
      procedure PrepareConversion;

   protected
      procedure SuggestFormat; virtual;

      procedure Loaded; override;
      procedure ChangePWaveFormat(aValue: PWaveFormatEx); override;
      procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
      procedure Opened; override;
      procedure Closed; override;
      procedure Started; override;
      procedure Stopped; override;
      procedure Reseting; override;
      procedure BufferReady(lpwh: PWaveHdr); override;
      procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

   public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      procedure Open;
      procedure Close;
      procedure Start;
      procedure Stop;

      property CanConvert: Boolean read GetCanConvert;

   published
      property Input;
      property Output;
      property Enabled: Boolean read FEnabled write FEnabled default True;
      property Quality: TMMConvertQuality read FQuality write FQuality default cqLow;
   end;

   TMMRequiredParam  = (rpBits,rpChannels,rpSampleRate);
   TMMRequiredParams = set of TMMRequiredParam;

   {-- TMMPCMConverter --------------------------------------------------------}
   TMMPCMConverter = class(TMMACMConverter)
   private
      FAutoConvert : Boolean;          { use your params or best match        }
      FBits        : TMMBits;          { bit8 or bit16                        }
      FMode        : TMMMode;          { mMono or mStereo                     }
      FSampleRate  : Longint;          { samplerate 8000..100000              }
      FRequired    : TMMRequiredParams;{ only some of the params are required }

      procedure SetAutoConvert(aValue: Boolean);
      procedure SetSampleRate(Rate: Longint);
      procedure SetBits(aValue: TMMBits);
      procedure SetMode(aValue: TMMMode);
      procedure SetRequired(aValue: TMMRequiredParams);
      procedure SetWaveParams;

   protected
      procedure SuggestFormat; override;
      procedure SetPWaveFormat(aValue: PWaveFormatEx); override;

   public
      constructor Create(aOwner: TComponent); override;

   published
      property AutoConvert: Boolean read FAutoConvert write SetAutoConvert default True;
      property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
      property BitLength: TMMBits read FBits write setBits default b8bit;
      property Mode: TMMMode read FMode write SetMode default mMono;
      property Required: TMMRequiredParams read FRequired write SetRequired;
   end;

implementation

const
     ACM_CONVERT_SIZE = 8192;

{== TMMACMConverter ============================================================}
constructor TMMACMConverter.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FENabled     := True;
   FOpen        := False;
   FStarted     := False;
   FMustConvert := False;
   FCanConvert  := False;
   FPACMConvert := nil;
   FPSrcFormat  := nil;
   FQuality     := cqLow;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMACMConverter ------------------------------------------------------------}
destructor TMMACMConverter.Destroy;
begin
   Close;

   GlobalFreeMem(Pointer(FPSrcFormat));
   GlobalFreeMem(Pointer(FPDstFormat));
   GlobalFreeMem(Pointer(FCvtFormat));

   inherited Destroy;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Loaded;
begin
   inherited Loaded;

   PrepareConversion;
end;

{-- TMMACMConverter ------------------------------------------------------------}
function TMMACMConverter.GetCanConvert: Boolean;
begin
   Result := (not FMustConvert) or FCanConvert;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.ChangePWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> FPSrcFormat) then
   begin
      GlobalFreeMem(Pointer(FPSrcFormat));
      FPSrcFormat := wioCopyWaveFormat(aValue);

      PrepareConversion;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) and not (csLoading in ComponentState) and not (csDestroying in ComponentState) then
   begin
      GlobalFreeMem(Pointer(FPDStFormat));
      FPDstFormat := wioCopyWaveFormat(aValue);
      PrepareConversion;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.SuggestFormat;
begin
   GlobalFreeMem(Pointer(FCvtFormat));
   if FEnabled then
      FCvtFormat := wioCopyWaveFormat(FPDstFormat);
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.PrepareConversion;
begin
   FMustConvert := False;
   FCanConvert := False;

   if (FPSrcFormat <> nil) and FEnabled then
   begin
      SuggestFormat;

      if acmMustConvert(FPSrcFormat,FCvtFormat) then
      begin
         FMustConvert := True;
         if acmQueryConvert(FPSrcFormat,FCvtFormat,Boolean(FQuality)) then
         begin
            FCanConvert := True;
            inherited SetPWaveFormat(FCvtFormat);
            exit;
         end;
      end;
   end;

   inherited SetPWaveFormat(FPSrcFormat);
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Open;
begin
   if not FOpen and FEnabled then
   begin
      if FMustConvert then
      try
         if FCanConvert then
         begin
            FCvtBufSize := Min(ACM_CONVERT_SIZE,Max(BufferSize,Max(QUEUE_READ_SIZE,QUEUE_WRITE_SIZE)));

            { init the conversion structure }
            FPACMConvert := acmBeginConvert(FPSrcFormat,PWaveFormat,nil,FCvtBufSize,Boolean(FQuality));
            if (FPACMConvert = nil) then
            begin
               FCanConvert := False;
               exit;
            end;
         end;
      finally
         if not FCanConvert then
            raise EMMConverterError.Create('Unable to convert to destination format');
      end;
      FOpen := True;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Close;
begin
   if FOpen then
   begin
      Stop;
      FOpen := False;
      acmDoneConvert(FPACMConvert);
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Start;
begin
   if FOpen and not FStarted then
   begin
      FStarted := True;
      FMoreBuffers := False;
      FDone := False;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Stop;
begin
   if FStarted then
   begin
      FStarted := False;
      if (FPACMConvert <> nil) then
      with FPACMConvert^ do
      begin
         dwBytesRead := dwBytesConverted;
      end;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Opened;
begin
   Open;

   inherited Opened;