Delphi控件源码

开发平台：
Delphi

MMACMCvt.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  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;
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Closed;
begin
   Close;
   inherited Closed;
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Started;
begin
   inherited Started;
   Start;
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Stopped;
begin
   Stop;
   inherited Stopped;
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Reseting;
begin
   inherited Reseting;
   if (FPACMConvert <> nil) then
   begin
      acmFlushConvert(FPACMConvert);
      FDone := False;
   end;
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.BufferReady(lpwh: PWaveHdr);
var
   nBytes,nRead,nWrite,nConvert: Longint;
begin
   if FOpen and FStarted then
   begin
      { write Data }
      if (Output <> nil) then
      begin
         if FMustConvert and FCanConvert and (FPACMConvert <> nil) then
         with FPACMConvert^ do
         begin
            nBytes := lpwh^.dwBytesRecorded;
            nRead := 0;
            while FStarted and (nBytes > 0) do
            begin
               nConvert := Min(nBytes,dwSrcBufferSize);
               GlobalMoveMem(PChar(lpwh^.lpData+nRead)^,lpSrcBuffer^,nConvert);
               try
                  if acmDoConvert(FPACMConvert,nConvert) <= 0 then
                  begin
                     if not bPending and not bQueued then
                     begin
                        FCanConvert := False;
                        raise EMMConverterError.Create('Unable to convert to destination format');
                        exit;
                     end;
                  end;
               except
                  FCanConvert := False;
                  raise;
               end;
               dec(nBytes,nConvert);
               inc(nRead,nConvert);
               while FStarted and (dwBytesRead < dwBytesConverted) do
               begin
                  GlobalFillMem(Ftwh,sizeOf(Ftwh),0);
                  nWrite := Min(dwBytesConverted-dwBytesRead,BufferSize);
                  Ftwh.wh.lpData := PChar(lpDstBuffer+dwBytesRead);
                  Ftwh.wh.dwBufferLength := nWrite;
                  Ftwh.wh.dwBytesRecorded:= nWrite;
                  inc(dwBytesRead,nWrite);
                  inherited BufferReady(@Ftwh);
               end;
            end;
         end
         else inherited BufferReady(lpwh);
      end;
   end
   else inherited BufferReady(lpwh);
end;
{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
Label CopyData;
var
   nRead,nBytes: Longint;
   TryCount: integer;
begin
   if FOpen and FStarted then
   begin
      { read Data }
      if (Input <> nil) then
      begin
         TryCount := 0;
         nBytes   := lpwh^.dwBufferLength;
         if FMustConvert and FCanConvert and (FPACMConvert <> nil) then
         with FPACMConvert^ do
         begin
CopyData:
            { get some data from the conversion buffer }
            if (dwBytesConverted-dwBytesRead > 0) then
            begin
               nRead := Min(dwBytesConverted-dwBytesRead,nBytes);
               GlobalMoveMem((lpDstBuffer+dwBytesRead)^,(lpwh^.lpData+lpwh^.dwBytesRecorded)^,nRead);
               dec(nBytes,nRead);
               inc(dwBytesRead,nRead);
               inc(lpwh^.dwBytesRecorded,nRead);
            end;
            if not PMMWaveHdr(lpwh)^.LoopRec.dwLooping then
            begin
               { do we need more data ? }
               if FStarted and (nBytes > 0) then
               begin
                  if not FDone then
                  begin
                     GlobalFillMem(Ftwh,sizeOf(Ftwh),0);
                     Ftwh.wh.lpData := lpSrcBuffer;
                     Ftwh.wh.dwBufferLength := dwSrcBufferSize;
                     Ftwh.LoopRec := PMMWaveHdr(lpwh)^.LoopRec;
                     FMoreBuffers := False;
                     inherited BufferLoad(@Ftwh,FMoreBuffers);
                     nRead := Ftwh.wh.dwBytesRecorded;
                     PMMWaveHdr(lpwh)^.LoopRec := Ftwh.LoopRec;
                     if not FMoreBuffers or (nRead <= 0) then FDone := True;
                  end
                  else nRead := 0;
                  if (nRead > 0) and FStarted then
                  begin
                     if acmDoConvert(FPACMConvert,nRead) <= 0 then
                     begin
                        if not FDone then
                        begin
                           inc(TryCount);
                           if (TryCount < 5) then goto CopyData;
                           FCanConvert := False;
                           raise EMMConverterError.Create('Unable to convert to destination format');
                           exit;
                        end
                        else
                        begin
                           if (acmEndConvert(FPACMConvert,nRead) > 0) then
                               goto CopyData;
                        end;
                     end
                     else if FStarted then goto CopyData;
                  end
                  else if FStarted then
                  begin
                     if (acmEndConvert(FPACMConvert,0) > 0) then goto CopyData;
                  end;
               end;
            end;
            MoreBuffers := FMoreBuffers or (dwBytesConverted-dwBytesRead > 0) or bPending;
         end
         else inherited BufferLoad(lpwh,MoreBuffers);
      end;
   end
   else inherited BufferLoad(lpwh,MoreBuffers);
end;
{== TMMPCMConverter ============================================================}
constructor TMMPCMConverter.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);
   FAutoConvert := True;
   FSampleRate  := 11025;
   FBits        := b8Bit;
   FMode        := mMono;
   FRequired    := [rpBits,rpChannels,rpSampleRate];
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SuggestFormat;
var
   wfx,wfx2: TWaveFormatEx;
begin
   GlobalFreeMem(Pointer(FCvtFormat));
   if not FEnabled then exit;
   if FAutoConvert and (FPSrcFormat <> nil) then
   begin
      wfx := acmSuggestPCMFormat(FPSrcFormat);
   end
   else
   begin
      if (FPSrcFormat <> nil) then
      begin
         wfx2 := acmSuggestPCMFormat(FPSrcFormat);
         if (rpBits in FRequired) then
             wfx2.wBitsPerSample := (Ord(FBits)+1)*8;
         if (rpChannels in FRequired) then
             wfx2.nChannels := Ord(FMode)+1;
         if (rpSampleRate in FRequired) then
             wfx2.nSamplesPerSec := FSampleRate;
         pcmBuildWaveHeader(@wfx,wfx2.wBitsPerSample,wfx2.nChannels,wfx2.nSamplesPerSec);
      end
      else pcmBuildWaveHeader(@wfx,(Ord(FBits)+1)*8,Ord(FMode)+1,FSampleRate);
   end;
   if (wfx.wFormatTag <> 0) then
       FCvtFormat := wioCopyWaveFormat(@wfx);
end;
{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) and not (csLoading in ComponentState) and not (csDestroying in ComponentState) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMConverterError.Create(LoadResStr(IDS_INVALIDFORMAT));
      inherited SetPWaveFormat(aValue);
   end;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetAutoConvert(aValue: Boolean);
begin
   if (aValue <> FAutoConvert) then
   begin
      FAutoConvert := aValue;
      SetWaveParams;
   end;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetWaveParams;
begin
   SuggestFormat;
   if (FCvtFormat <> nil) then
       PWaveFormat := FCvtFormat
   else
       PWaveFormat := FPSrcFormat;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetRequired(aValue: TMMRequiredParams);
begin
     if (FRequired <> aValue) then
     begin
        FRequired := aValue;
        SetWaveParams;
     end;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetSampleRate(Rate: Longint);
begin
     if (Rate <> SampleRate) then
     begin
        FSampleRate := MinMax(Rate,8000,88200);
        SetWaveParams;
     end;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      SetWaveParams;
   end;
end;
{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) and (aValue in [mMono,mStereo]) then
   begin
      FMode := aValue;
      SetWaveParams;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
end.

						