Delphi控件源码

开发平台：
Delphi

MMADCvt.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/mmtools.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: 09.03.98 - 23:34:41 $                                        =}
{========================================================================}
unit MMADCvt;
{$I COMPILER.INC}
interface
uses
    {$IFDEF WIN32}
    Windows,
    {$ELSE}
    WinTypes,
    WinProcs,
    {$ENDIF}
    SysUtils,
    Classes,
    MMSystem,
    MMUtils,
    MMObj,
    MMDSPObj,
    MMRegs,
    MMWaveIO,
    MMADPCM,
    MMPCMSup,
    MMAntex;
type
   EMMADPCMError = class(Exception);
   {-- TMMADPCMConverter ------------------------------------------------------}
   TMMADPCMConverter = class(TMMDSPComponent)
   private
      FEnabled     : Boolean;
      FOpen        : Boolean;
      FStarted     : Boolean;
      FPSrcFormat  : PWaveFormatEx;
      FPDstFormat  : PWaveFormatEx;
      FCvtFormat   : PWaveFormatEx;
      FPSrcBuffer  : PChar;
      FPDstBuffer  : PChar;
      FSrcBufSize  : Longint;
      FDstBufSize  : Longint;
      FNumConverted: Longint;
      FNumRead     : Longint;
      FMustConvert : Boolean;        { the format must be converted    }
      FCanConvert  : Boolean;        { the format can be converted     }
      FMoreBuffers : Boolean;
      FDone        : Boolean;
      FIsLoading   : Boolean;
      Ftwh         : TMMWaveHdr;
      FBits        : TMMBits;
      FIMAParams   : TIMA_PARAMS;
      procedure SetBits(aValue: TMMBits);
      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 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 BitLength: TMMBits read FBits write SetBits default b16Bit;
      property Enabled: Boolean read FEnabled write FEnabled default True;
   end;
implementation
const
     LOADSIZE = 4096;
{== TMMADPCMConverter =========================================================}
constructor TMMADPCMConverter.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);
   FEnabled     := True;
   FOpen        := False;
   FStarted     := False;
   FMustConvert := False;
   FCanConvert  := False;
   FPSrcFormat  := nil;
   FPSrcBuffer  := nil;
   FPDstBuffer  := nil;
   FBits        := b16Bit;
   FIsLoading   := True;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
destructor TMMADPCMConverter.Destroy;
begin
   Close;
   GlobalFreeMem(Pointer(FPSrcFormat));
   GlobalFreeMem(Pointer(FPDstFormat));
   GlobalFreeMem(Pointer(FCvtFormat));
   inherited Destroy;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      PrepareConversion;
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Loaded;
begin
   inherited Loaded;
   FIsLoading := False;
   PrepareConversion;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
function TMMADPCMConverter.GetCanConvert: Boolean;
begin
   Result := (not FMustConvert) or FCanConvert;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.ChangePWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> FPSrcFormat) then
   begin
      GlobalFreeMem(Pointer(FPSrcFormat));
      FPSrcFormat := wioCopyWaveFormat(aValue);
      PrepareConversion;
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   (* TODO: setzen von WaveFormat nicht erlaubt !!! *)
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.SuggestFormat;
var
   wfx: TWaveFormatEx;
begin
   GlobalFreeMem(Pointer(FCvtFormat));
   if (FPSrcFormat <> nil) and FEnabled then
   case FPSrcFormat.wFormatTag of
       WAVE_FORMAT_ADPCM:
       begin
          if adpcmBuildFormatHeader(FPSrcFormat, @wfx, (Ord(FBits)+1)*8,-1,-1) then
             FCvtFormat := wioCopyWaveFormat(@wfx);
       end;
       WAVE_FORMAT_MEDIAVISION_ADPCM,
       WAVE_FORMAT_ANTEX_ADPCME,
       WAVE_FORMAT_ADPCME:
       begin
          pcmBuildWaveheader(@wfx,(Ord(FBits)+1)*8,FPSrcFormat^.nChannels,FPSrcFormat.nSamplesPerSec);
          FCvtFormat := wioCopyWaveFormat(@wfx);
        end;
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.PrepareConversion;
begin
   FMustConvert := False;
   FCanConvert := False;
   if (FPSrcFormat <> nil) and FEnabled then
   begin
      if (FPSrcFormat^.wFormatTag <> WAVE_FORMAT_PCM) then
      begin
         FMustConvert := True;
         SuggestFormat;
         if (FCvtFormat <> nil) and (FCvtFormat^.wFormatTag = WAVE_FORMAT_PCM) then
         begin
            FCanConvert := True;
            inherited SetPWaveFormat(FCvtFormat);
            exit;
         end;
      end;
   end;
   inherited SetPWaveFormat(FPSrcFormat);
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Open;
begin
   if not FOpen and FEnabled then
   begin
      if FMustConvert then
      try
         if FCanConvert then
         begin
            FSrcBufSize := LOADSIZE;
            case FPSrcFormat.wFormatTag of
                 WAVE_FORMAT_ADPCM:
                 begin
                    FDstBufSize := PADPCMWaveFormat(FPSrcFormat)^.wSamplesPerBlock * Longint(FCvtFormat^.nBlockAlign);
                    FDstBufSize := FDstBufSize*(FSrcBufSize div FPSrcFormat^.nBlockAlign);
                 end;
                 WAVE_FORMAT_MEDIAVISION_ADPCM,
                 WAVE_FORMAT_ANTEX_ADPCME,
                 WAVE_FORMAT_ADPCME:
                 begin
                    FDstBufSize := 4*FSrcBufSize;
                 end;
            end;
            FPSrcBuffer := GlobalAllocMem(FSrcBufSize);
            FPDstBuffer := GlobalAllocMem(FDstBufSize);
            if (FPSrcBuffer = nil) or (FPDstBuffer = nil) then
            begin
               FCanConvert := False;
               exit;
            end;
         end;
      finally
         if not FCanConvert then
            raise EMMADPCMError.Create('Unable to convert to destination format');
      end;
      FOpen := True;
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Close;
begin
   if FOpen then
   begin
      Stop;
      FOpen := False;
      GlobalFreeMem(Pointer(FPSrcBuffer));
      GlobalFreeMem(Pointer(FPDstBuffer));
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Start;
begin
   if FOpen and not FStarted then
   begin
      FStarted := True;
      FMoreBuffers := False;
      FDone := False;
      FNumRead := 0;
      FNumConverted := 0;
      FillChar(FIMAParams,sizeOf(FIMAParams),0);
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Stop;
begin
   if FStarted then
   begin
      FStarted := False;
      FNumRead := FNumConverted;
   end;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Opened;
begin
   Open;
   inherited Opened;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Closed;
begin
   Close;
   inherited Closed;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Started;
begin
   inherited Started;
   Start;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Stopped;
begin
   Stop;
   inherited Stopped;
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.Reseting;
begin
   inherited Reseting;
   FNumRead := FNumConverted;
   FillChar(FIMAParams,sizeOf(FIMAParams),0);
end;
{-- TMMADPCMConverter ---------------------------------------------------------}
procedure TMMADPCMConverter.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
Label CopyData;
var
   nRead,nBytes: Longint;
begin
   if FOpen and FStarted and FEnabled then
   begin
      { read Data }
      if (Input <> nil) then
      begin
         nBytes := lpwh^.dwBufferLength;
         if FMustConvert and FCanConvert then
         begin
CopyData:
            { get some data from the conversion buffer }
            if (FNumConverted-FNumRead > 0) then
            begin
               nRead := Min(FNumConverted-FNumRead,nBytes);
               GlobalMoveMem((FPDstBuffer+FNumRead)^,(lpwh^.lpData+lpwh^.dwBytesRecorded)^,nRead);
               dec(nBytes,nRead);
               inc(FNumRead,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 := FPSrcBuffer;
                     Ftwh.wh.dwBufferLength := FSrcBufSize;
                     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
                     case FPSrcFormat.wFormatTag of
                         WAVE_FORMAT_ADPCM:
                         begin
                            nRead := adpcmDecode4Bit(PADPCMWaveFormat(FPSrcFormat),
                                                     FCvtFormat,
                                                     FPSrcBuffer, FPDstBuffer, nRead);
                         end;
                         WAVE_FORMAT_MEDIAVISION_ADPCM:
                         begin
                            if (FPSrcFormat^.nChannels = 1) then
                                nRead := wmimatopcm(FPSrcBuffer, FPDstBuffer, nRead, FIMAParams)
                            else if (FPSrcFormat^.nChannels = 2) then
                                nRead := wsimatopcm(FPSrcBuffer, FPDstBuffer, nRead, FIMAParams)
                            else
                                nRead := 0;
                            if (FBits = b8Bit) then
                                nRead := pcmBitsPerSampleAlign(8, FPDstBuffer, 16, FPDstBuffer,nRead);
                         end;
                         WAVE_FORMAT_ANTEX_ADPCME,
                         WAVE_FORMAT_ADPCME:
                         begin
                            if (FPSrcFormat^.nChannels = 1) then
                                nRead := wmdvitopcm(FPSrcBuffer, FPDstBuffer, nRead, FIMAParams)
                            else if (FPSrcFormat^.nChannels = 2) then
                                nRead := wsdvitopcm(FPSrcBuffer, FPDstBuffer, nRead, FIMAParams)
                            else
                                nRead := 0;
                            if (FBits = b8Bit) then
                                nRead := pcmBitsPerSampleAlign(8, FPDstBuffer, 16, FPDstBuffer,nRead);
                         end;
                     end;
                     if nRead <= 0 then
                     begin
                        if not FDone then
                        begin
                           FCanConvert := False;
                           exit;
                        end;
                     end
                     else if FStarted then
                     begin
                        FNumConverted := nRead;
                        FNumRead      := 0;
                        goto CopyData;
                     end;
                  end;
               end;
            end;
            MoreBuffers := FMoreBuffers or (FNumConverted-FNumRead > 0);
         end
         else inherited BufferLoad(lpwh,MoreBuffers);
      end;
   end
   else inherited BufferLoad(lpwh,MoreBuffers);
end;
end.

						