Delphi控件源码

开发平台：
Delphi

MMACMDlg.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: 06.09.98 - 02:53:10 $                                        =}
{========================================================================}
Unit MMACMDlg;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Controls,
    Forms,
    Dialogs,
    MMSystem,
    MMUtils,
    MMObj,
    MMRegs,
    MMRiff,
    MMWaveIO,
    MMWave,
    MMACM;
type
    EMMACMError = class(Exception);
    TMMACMEnumFormats = (efAll,efInput,efOutput,efConvert,efSuggest,efRestrict);
    TMMACMCodecEnum   = procedure (Sender: TObject; dwFormatTag: DWORD; Description: String; var Continue: Boolean) of object;
    TMMACMFormatEnum  = procedure (Sender: TObject; pwfx: PWaveFormatEx; Description: String; var Continue: Boolean) of object;
    {-- TMMACM ---------------------------------------------------------}
    TMMACM = class(TMMNonVisualComponent)
    private
       FACMPresent   : Boolean;
       FACMVersion   : Longint;
       FNumDrivers   : Longint;
       FNumCodecs    : Longint;
       FNumConverters: Longint;
       FNumFilters   : Longint;
       FMaxFormatSize: Longint;
       FMaxFilterSize: Longint;
       FEnumFormats  : TMMACMEnumFormats;
       FTitle        : String;
       FPWaveFilter  : PWaveFilter;
       FPWaveFormatEx: PWaveFormatEx;
       FSource       : TMMCustomWaveFile;
       FOnCodecEnum  : TMMACMCodecEnum;
       FOnFormatEnum : TMMACMFormatEnum;
       procedure SetSource(aSource: TMMCustomWaveFile);
       procedure SetACMPresent(aValue: Boolean);
       procedure SetNumDrivers(aValue: Longint);
       procedure SetPWaveFormat(aValue: PWaveFormatEx);
       procedure SetPWaveFilter(aValue: PWaveFilter);
       function  GetWave: TMMWave;
    protected
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;
       procedure AllocWaveHeader(var pwfx: PWaveFormatEx);
       procedure FreeWaveHeader(var pwfx: PWaveFormatEX);
       procedure AllocWaveFilter(var pwfltr: PWaveFilter);
       procedure FreeWaveFilter(var pwfltr: PWaveFilter);
       function GetFormatDescription(pwfx: PWaveFormatEx;var sFormatTag,sFormat: String): Boolean;
       function GetFilterDescription(pwfltr: PWaveFilter;var sFilterTag,sFilter: String): Boolean;
       function EnumerateFormats(wFormatTag: integer): Boolean;
       function EnumerateCodecs: Boolean;
       function SuggestFormat(pwfxSrc: PWaveFormatEx; dwSuggest: Longint): Boolean;
       function ChooseFormat(pwfxSrc: PWaveFormatEx; Title: String): Boolean;
       function ChooseFilter(pwfltrSrc: PWaveFilter; Title: String): Boolean;
       function QueryConvert(pwfxDst: PWaveFormatEx; pwfltr: PWaveFilter): Boolean;
       function ProcessFile(const FileName: TFileName; pwfxDst: PWaveFormatEx; pwfltr: PWaveFilter): Boolean;
       function FilterFile(const FileName: TFileName): Boolean;
       function CreateFile(const FileName: TFileName): Boolean;
       function ConvertFile(const FileName: TFileName): Boolean;
       property DriverVersion: Longint read FacmVersion;
       property PWaveFormat: PWaveFormatEx read FPWaveFormatEx write SetPWaveFormat;
       property MaxFormatSize: Longint read FMaxFormatSize;
       property PFilter: PWaveFilter read FPWaveFilter write SetPWaveFilter;
       property MaxFilterSize: Longint read FMaxFilterSize;
       property Wave: TMMWave read GetWave;
    published
       property OnCodecEnum: TMMACMCodecEnum read FOnCodecEnum write FOnCodecEnum;
       property OnFormatEnum: TMMACMFormatEnum read FOnFormatEnum write FOnFormatEnum;
       property ACMPresent: Boolean read FACMPresent write SetACMPresent;
       property NumDrivers: Longint read FNumDrivers write SetNumDrivers;
       property NumCodecs: Longint read FNumCodecs write SetNumDrivers;
       property NumConverters: Longint read FNumConverters write SetNumDrivers;
       property NumFilters: Longint read FNumFilters write SetNumDrivers;
       property EnumFormats: TMMACMEnumFormats read FEnumFormats write FEnumFormats default efAll;
       property Title: String read FTitle write FTitle;
       property Source: TMMCustomWaveFile read FSource write SetSource;
    end;
function acmBuildTrueSpeechHeader: PTrueSpeechWaveFormat;
function acmBuildGSM610Header(SampleRate: integer): PGSM610WaveFormat;
function acmBuildADPCMHeader(SampleRate, Channels: integer): PADPCMWaveFormat;
function acmBuildMPEG1Header(SampleRate, Bitrate, Channels: integer): PMPEG1WaveFormat;
function acmBuildMP3Header(SampleRate, Bitrate, Channels: integer): PWaveFormatEx;
function acmBuildMPEGHeader(Layer,SampleRate, Bitrate, Channels: integer): PWaveFormatEx;
function acmGetFormatDescription(pwfx: PWaveFormatEx; var sFormatTag,sFormat: String): Boolean;
function acmGetFilterDescription(pwfltr: PWaveFilter; var sFilterTag,sFilter: String): Boolean;
procedure acmSaveFormatToRegistry(pwfx: PWaveFormatEx;
                                  RootKey: integer; const LocalKey,Field: String);
function  acmGetFormatFromRegistry(RootKey: integer; const LocalKey,Field: String): PWaveFormatEx;
implementation
uses MMString;
{========================================================================}
function acmBuildTrueSpeechHeader: PTrueSpeechWaveFormat;
begin
   Result := GlobalAllocMem(sizeOf(TTrueSpeechWaveFormat));
   with Result^ do
   begin
      wfx.wFormatTag     := WAVE_FORMAT_DSPGROUP_TRUESPEECH;
      wfx.nChannels      := 1;
      wfx.nSamplesPerSec := 8000;
      wfx.nAvgBytesPerSec:= 1067;
      wfx.nBlockAlign    := 32;
      wfx.wBitsPerSample := 1;
      wfx.cbSize         := 32;
      wRevision          := 1;
      nSamplesPerBlock   := $00F0;
   end;
end;
{========================================================================}
function acmBuildGSM610Header(SampleRate: integer): PGSM610WaveFormat;
begin
   Result := GlobalAllocMem(sizeOf(TGSM610WaveFormat));
   with Result^ do
   begin
      wfx.wFormatTag     := WAVE_FORMAT_GSM610;
      wfx.nChannels      := 1;
      wfx.nSamplesPerSec := SampleRate;
      wfx.wBitsPerSample := 0;
      wfx.nAvgBytesPerSec:= 0;
      wfx.nBlockAlign    := 65;
      wfx.cbSize         := 2;
      wSamplesPerBlock   := 320;
      case Word(SampleRate) of
         8000 : wfx.nAvgBytesPerSec := 1625;
         11025: wfx.nAvgBytesPerSec := 2239;
         22050: wfx.nAvgBytesPerSec := 4478;
         44100: wfx.nAvgBytesPerSec := 8957;
      end;
   end;
end;
{========================================================================}
function acmBuildADPCMHeader(SampleRate, Channels: integer): PADPCMWaveFormat;
const
     MSADPCM_NUM_COEF = 7;
     gaiCoef1: array[0..MSADPCM_NUM_COEF-1]of Smallint = (256,  512,  0, 192, 240,  460,  392);
     gaiCoef2: array[0..MSADPCM_NUM_COEF-1]of Smallint = (0, -256,  0,  64,   0, -208, -232);
var
   wBitsperSample,
   wHeaderBytes,
   w: Word;
   dw: DWORD;
begin
   wBitsPerSample := 4;
   { fill in destination header with appropriate ADPCM stuff based }
   { on source PCM header...                                       }
   Result := GlobalAllocMem(sizeOf(TADPCMWaveFormat)+MSADPCM_NUM_COEF*sizeOf(TADPCMCOEFSET));
   with Result^ do
   begin
      wfx.wFormatTag     := WAVE_FORMAT_ADPCM;
      wfx.nSamplesPerSec := SampleRate;
      wfx.nChannels      := Channels;
      wfx.wBitsPerSample := wBitsperSample;
      { choose a block alignment that makes sense for the sample rate  }
      { that the original PCM data is. basically, this needs to be     }
      { some reasonable number to allow efficient streaming, etc.      }
      {                                                                }
      { don't let block alignment get too small...                     }
      wfx.nBlockAlign := 256 * Channels;
      if (SampleRate > 11025) then
          wfx.nBlockAlign := wfx.nBlockAlign * (SampleRate div 11000);
      { compute that 'samples per block' that will be in the encoded   }
      { ADPCM data blocks. this is determined by subtracting out the   }
      { 'other info' contained in each block--a block is composed of   }
      {  a header followed by the encoded data.                        }
      {                                                                }
      { the block header is composed of the following data:            }
      {     1 byte predictor per channel                               }
      {     2 byte delta per channel                                   }
      {     2 byte first sample per channel                            }
      {     2 byte second sample per channel                           }
      {                                                                }
      { this gives us (7 * wChannels) bytes of header information that }
      { contains our first two full samples (so we add two below).     }
      wHeaderBytes := (7 * Channels);
      w := (wfx.nBlockAlign - wHeaderBytes) * 8;
      wSamplesPerBlock := (w div (wBitsPerSample * Channels)) + 2;
      { now compute the avg bytes per second (man this code bites!) }
      dw := ((Longint(wBitsPerSample) * Channels * Longint(SampleRate)) div 8);
      wfx.nAvgBytesPerSec := (dw + wHeaderBytes + ((dw div wfx.nBlockAlign) * wHeaderBytes));
      { fill in the cbSize field of the extended wave format header.    }
      { this number is the number of _EXTRA BYTES_ *after* the end      }
      { of the WAVEFORMATEX structure that are need for the compression }
      { format.                                                         }
      {                                                                 }
      { for Microsoft's 4 Bit ADPCM format, this number is 32:          }
      wfx.cbSize := sizeof(TADPCMWAVEFORMAT) - sizeof(TWaveFormatEx) +
                           ((MSADPCM_NUM_COEF-1) * sizeof(TADPCMCOEFSET));
      { copy the Microsoft 4 Bit ADPCM coef's into the header }
      wNumCoef := MSADPCM_NUM_COEF;
      for w := 0 to MSADPCM_NUM_COEF-1 do
      begin
         aCoef[w].iCoef1 := gaiCoef1[w];
         aCoef[w].iCoef2 := gaiCoef2[w];
      end;
   end;
end;
{========================================================================}
function acmBuildMPEG1Header(SampleRate, Bitrate, Channels: integer): PMPEG1WaveFormat;
var
   wSamplesPerBlock: Integer;
begin
   // Example: SampleRate: 44100, Bitrate: 128000, Channels: 2
   Result := GlobalAllocMem(sizeOf(TMPEG1WaveFormat));
   with Result^ do
   begin
      wfx.wFormatTag     := WAVE_FORMAT_MPEG;
      wfx.nChannels      := Channels;
      wfx.nSamplesPerSec := SampleRate;
      wfx.wBitsPerSample := 16;
      wfx.nAvgBytesPerSec:= 0;
      wfx.nBlockAlign    := 144 * (BitRate * wfx.nChannels) div SampleRate;
      wfx.cbSize         := 22;
      wSamplesPerBlock   := 1120;
      fwHeadLayer        := ACM_MPEG_LAYER2;
      fwHeadModeExt      := $0F;
      wHeadEmphasis      := 1;   // no emphasis
      fwHeadFlags        := ACM_MPEG_ID_MPEG1;// or ACM_MPEG_PROTECTIONBIT or ACM_MPEG_COPYRIGHT or ACM_MPEG_ORIGINALHOME;
      dwPTSLow           := 0;
      dwPTSHigh          := 0;
      if (wfx.nChannels = 1) then
          fwHeadMode     := ACM_MPEG_SINGLECHANNEL
      else
          fwHeadMode     := ACM_MPEG_JOINTSTEREO;
      dwHeadBitrate      := BitRate * wfx.nChannels;
      wfx.nAvgBytesPerSec:= (((wfx.nSamplesPerSec * 100) div wSamplesPerBlock)*wfx.nBlockAlign) div 100;
   end;
end;
{========================================================================}
function acmBuildMP3Header(SampleRate, Bitrate, Channels: integer): PWaveFormatEx;
const
    MP3Ext: array[0..11] of Byte = ($01,$00,$02,$00,$00,$00,$00,$00,$01,$00,$71,$05);
var
    BlockAlign: Double;
begin
    Result := GlobalAllocMem(sizeOf(TWaveFormatEx)+12);
    with Result^ do
    begin
       wFormatTag     := WAVE_FORMAT_MPEG_LAYER3;
       nChannels      := Channels;
       nSamplesPerSec := SampleRate;
       wBitsPerSample := 0;
       nBlockAlign    := 1;
       BlockAlign     := (144 * BitRate) / SampleRate;
       nAvgBytesPerSec:= Round((((SampleRate*100) / 1152)*BlockAlign) / 100);
       cbSize         := sizeOf(MP3Ext);
       GlobalMoveMem(MP3Ext,(PChar(Result)+sizeOf(TWaveFormatEx))^,sizeOf(MP3Ext));
       PWord(PChar(Result)+sizeOf(TWaveFormatEx)+6)^ := Trunc(BlockAlign);
    end;
end;
{========================================================================}
function acmBuildMPEGHeader(Layer,SampleRate, Bitrate, Channels: integer): PWaveFormatEx;
begin
   if (Layer = 2) then
       Result := Pointer(acmBuildMPEG1Header(SampleRate, BitRate, Channels))
   else if (Layer = 3) then
       Result := Pointer(acmBuildMP3Header(SampleRate, BitRate, Channels))
   else
       Result := nil;
end;
{========================================================================}
function acmGetFormatDescription(pwfx: PWaveFormatEx;var sFormatTag,sFormat: String): Boolean;
var
   mmr : MMRESULT;
   aftd: TACMFormatTagDetails;
   afd : TACMFormatDetails;
begin
   { get the name for the format tag of the specified format }
   Result := False;
   if (pwfx <> nil) then
   begin
      if acmDLLLoaded and (HiWord(acmGetVersion) >= $0200) then
      begin
         { get the name for the format tag of the specified format }
         { initialize all unused members of the TACMFORMATTAGDETAILS }
         { structure to zero                                         }
         FillChar(aftd, sizeOf(aftd), 0);
         { fill in the required members of the TACMFORMATTAGDETAILS }
         { structure for the ACM_FORMATTAGDETAILSF_FORMATTAG query  }
         aftd.cbStruct    := sizeOf(aftd);
         aftd.dwFormatTag := pwfx^.wFormatTag;
         { ask the ACM to find the first available driver that }
         { supports the specified format tag                   }
         mmr := acmFormatTagDetails(0, @aftd, ACM_FORMATTAGDETAILSF_FORMATTAG);
         if (mmr = 0) then
             { copy the format tag name into the caller's buffer }
             sFormatTag := StrPas(aftd.szFormatTag)
         else
             { no ACM driver is available that supports the }
             { specified format tag                         }
             wioGetFormatName(pwfx, sFormatTag);
         { get the description of the attributes for the specified format }
         { initialize all unused members of the ACMFORMATDETAILS }
         { structure to zero                                     }
         FillChar(afd, sizeOf(afd), 0);
         { fill in the required members of the ACMFORMATDETAILS  }
         { structure for the ACM_FORMATDETAILSF_FORMAT query     }
         afd.cbStruct    := sizeof(afd);
         afd.dwFormatTag := pwfx^.wFormatTag;
         afd.pwfx        := pwfx;
         { the cbwfx member must be initialized to the total size  }
         { in bytes needed for the specified format. for a PCM     }
         { format, the cbSize member of the WAVEFORMATEX structure }
         { is not valid.                                           }
         afd.cbwfx := wioSizeOfWaveFormat(pwfx);
         { ask the ACM to find the first available driver that }
         { supports the specified format                       }
         mmr := acmFormatDetails(0, @afd, ACM_FORMATDETAILSF_FORMAT);
         if (mmr = 0) then
             { copy the format attributes description into the caller's buffer }
             sFormat := StrPas(afd.szFormat)
         else
             { no ACM driver is available that supports the specified format }
             wioGetFormat(pwfx, sFormat);
      end
      else
      begin
         wioGetFormatName(pwfx, sFormatTag);
         wioGetFormat(pwfx, sFormat);
      end;
      Result := True;
   end;
end;
{========================================================================}
function acmGetFilterDescription(pwfltr: PWaveFilter;var sFilterTag,sFilter: String): Boolean;
var
   mmr : MMRESULT;
   aftd: TACMFilterTagDetails;
   afd : TACMFilterDetails;
begin
   { get the name for the filter tag of the specified filter }
   Result := False;
   if acmDLLLoaded and (HiWord(acmGetVersion) >= $0200) and (pwfltr <> nil) then
   begin
      { initialize all unused members of the TACMFILTERTAGDETAILS }
      { structure to zero                                         }
      FillChar(aftd, sizeOf(aftd), 0);
      { fill in the required members of the TACMFILTERTAGDETAILS }
      { structure for the ACM_FILTERTAGDETAILSF_FILTERTAG query  }
      aftd.cbStruct    := sizeOf(aftd);
      aftd.dwFilterTag := pwfltr^.dwFilterTag;
      { ask the ACM to find the first available driver that }
      { supports the specified filter tag                   }
      mmr := acmFilterTagDetails(0, @aftd, ACM_FILTERTAGDETAILSF_FILTERTAG);
      if (mmr <> 0) then
         { no ACM driver is available that supports the specified filter tag }
         sFilterTag := LoadResStr(IDS_WAVEUNKNOWN) + ' FilterTag'
      else
         { copy the filter tag name into the caller's buffer }
         sFilterTag := StrPas(aftd.szFilterTag);
      { get the description of the attributes for the specified filter }
      { initialize all unused members of the TACMFILTERDETAILS }
      { structure to zero                                      }
      FillChar(afd, sizeOf(afd), 0);
      { fill in the required members of the TACMFILTERDETAILS }
      { structure for the ACM_FILTERDETAILSF_FILTER query     }
      afd.cbStruct    := sizeOf(afd);
      afd.dwFilterTag := pwfltr^.dwFilterTag;
      afd.pwfltr      := pwfltr;
      afd.cbwfltr     := pwfltr^.cbStruct;
      { ask the ACM to find the first available driver that }
      { supports the specified filter                       }
      mmr := acmFilterDetails(0, @afd, ACM_FILTERDETAILSF_FILTER);
      if (mmr <> 0) then
          { no ACM driver is available that supports the specified filter }
          sFilter := LoadResStr(IDS_WAVEUNKNOWN)+ ' Filter'
      else
          { copy the filter attributes description into the caller's buffer }
          sFilter := StrPas(afd.szFilter);
      Result := True;
   end;
end;
{========================================================================}
procedure acmSaveFormatToRegistry(pwfx: PWaveFormatEx;
                                  RootKey: integer; const LocalKey,Field: String);
begin
   SaveInRegistryBinary(RootKey,LocalKey,Field,pwfx^,wioSizeOfWaveFormat(pwfx));
end;
{========================================================================}
function  acmGetFormatFromRegistry(RootKey: integer; const LocalKey,Field: String): PWaveFormatEx;
var
   wfx: array[0..1024] of Char;
begin
   if GetFromRegistryBinary(RootKey,LocalKey,Field,wfx,sizeOf(wfx)) > 0 then
      Result := wioCopyWaveFormat(@wfx)
   else
      Result := nil;
end;
{== TMMACM =============================================================}
constructor TMMACM.Create(aOwner:TComponent);
begin
   inherited Create(aOwner);
   FACMPresent := False;
   FEnumFormats := efAll;
   FSource := nil;
   FTitle := LoadResStr(IDS_ACMSELECT);
   if (not acmDLLLoaded) then
   begin
      MessageDlg(LoadResStr(IDS_ACMNOACM), mtInformation, [mbOk], 0);
   end
   else
   begin
      FacmVersion := acmGetVersion;
      if HiWord(FacmVersion) < $0200 then
      begin
         MessageDlg(Format(LoadResStr(IDS_ACMBADVERSION),
                    [HiWord(FacmVersion) shr 8,HiWord(FacmVersion) and $FF]),
                    mtInformation, [mbOk], 0);
         exit;
      end;
      FACMPresent := True;
      acmMetrics(0, ACM_METRIC_COUNT_DRIVERS, @FNumDrivers);
      acmMetrics(0, ACM_METRIC_COUNT_CODECS, @FNumCodecs);
      acmMetrics(0, ACM_METRIC_COUNT_CONVERTERS, @FNumConverters);
      acmMetrics(0, ACM_METRIC_COUNT_FILTERS, @FNumFilters);
      acmMetrics(0, ACM_METRIC_MAX_SIZE_FORMAT, @FMaxFormatSize);
      acmMetrics(0, ACM_METRIC_MAX_SIZE_FILTER, @FMaxFilterSize);
      AllocWaveHeader(FPWaveFormatEx);
      AllocWaveFilter(FPWaveFilter);
   end;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMACM -------------------------------------------------------------}
Destructor TMMACM.Destroy;
begin
   FreeWaveHeader(FPWaveFormatEx);
   FreeWaveFilter(FPWaveFilter);
   inherited Destroy;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.SetACMPresent(aValue: Boolean);
begin
   { dummy }
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.SetNumDrivers(aValue: Longint);
begin
   { dummy }
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.SetSource(aSource: TMMCustomWaveFile);
begin
   if (aSource is TMMCustomWaveFile) or (aSource = Nil) then
   begin
      if (FSource <> aSource) then
      begin
         FSource := aSource;
      end;
   end;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);
   if (Operation = opRemove) and (AComponent = FSource) then
      FSource := Nil;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
      move(aValue^, FPWaveFormatEx^, sizeOf(TWaveFormatEx) + aValue^.cbSize);
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.SetPWaveFilter(aValue: PWaveFilter);
begin
   if (aValue <> nil) then
      move(aValue^, FPWaveFilter^, aValue^.cbStruct);
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.GetWave: TMMWave;
begin
   Result := nil;
   if assigned(FSource) then
   begin
      Result := (FSource as TMMCustomWaveFile).Wave;
   end;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.AllocWaveHeader(var pwfx: PWaveFormatEx);
begin
   if ACMPresent and (FMaxFormatSize > 0) then
      pwfx := GlobalAllocMem(FMaxFormatSize)
   else
      pwfx := nil;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.FreeWaveHeader(var pwfx: PWaveFormatEx);
begin
   if ACMPresent then
      GlobalFreeMem(pointer(pwfx));
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.AllocWaveFilter(var pwfltr: PWaveFilter);
begin
   if ACMPresent and (FMaxFilterSize > 0) then
      pwfltr := GlobalAllocMem(FMaxFilterSize)
   else
      pwfltr := nil;
end;
{-- TMMACM -------------------------------------------------------------}
procedure TMMACM.FreeWaveFilter(var pwfltr: PWaveFilter);
begin
   if ACMPresent then
      GlobalFreeMem(pointer(pwfltr));
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.GetFormatDescription(pwfx: PWaveFormatEx;var sFormatTag,sFormat: String): Boolean;
begin
   Result := acmGetFormatDescription(pwfx,sFormatTag,sFormat);
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.GetFilterDescription(pwfltr: PWaveFilter;var sFilterTag,sFilter: String): Boolean;
begin
   Result := acmGetFilterDescription(pwfltr,sFilterTag,sFilter);
end;
{-----------------------------------------------------------------------}
function acmDriverEnumCallback(hadid: THACMDRIVERID; dwInstance, fdwSupport: DWORD): Boolean; stdcall;
begin
   if (fdwSupport and ACMDRIVERDETAILS_SUPPORTF_CODEC <> 0) or
      (fdwSupport and ACMDRIVERDETAILS_SUPPORTF_CONVERTER <> 0) then
   begin
      TList(dwInstance).Add(Pointer(hadid));
   end;
end;
{-----------------------------------------------------------------------}
function acmFormatEnumTagCallback(hadid: THACMDRIVERID; paftd:  PACMFORMATTAGDETAILS;
                                  dwInstance, fdwSupport: DWORD): Boolean; stdcall;
begin
   Result := False;
   if (dwInstance <> 0) then
   with TMMACM(dwInstance) do
   begin
      if assigned(FOnCodecEnum) then
         FOnCodecEnum(TMMACM(dwInstance), paftd.dwFormatTag, StrPas(paftd.szFormatTag), Result);
   end;
end;
{-----------------------------------------------------------------------}
function acmFormatEnumCallback(hadid: THACMDRIVERID; pafd:  PACMFORMATDETAILS;
                               dwInstance, fdwSupport: DWORD): Boolean; stdcall;
begin
   Result := False;
   if (dwInstance <> 0) then
   with TMMACM(dwInstance) do
   begin
      if assigned(FOnFormatEnum) then
         FOnFormatEnum(TMMACM(dwInstance), pafd.pwfx, StrPas(pafd.szFormat), Result);
   end;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.EnumerateCodecs: Boolean;
var
   aftd: TACMFORMATTAGDETAILS;
begin
   Result := False;
   if not ACMPresent then exit;
   FillChar(aftd,sizeOf(aftd),0);
   aftd.cbStruct := sizeOf(aftd);
   Result := acmFormatTagEnum(0, @aftd, acmFormatEnumTagCallback, Longint(Self), 0) = 0;
   if not Result then // Bug Fix for Win98, some times the first call fails...
      Result := acmFormatTagEnum(0, @aftd, acmFormatEnumTagCallback, Longint(Self), 0) = 0;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.EnumerateFormats(wFormatTag: integer): Boolean;
var
   afd: TACMFORMATDETAILS;
   fdwEnum: DWORD;
begin
   Result := False;
   if not ACMPresent then exit;
   FillChar(afd,sizeOf(afd),0);
   afd.cbStruct := sizeOf(afd);
   afd.pwfx := GlobalAllocMem(FMaxFormatSize);
   try
      afd.pwfx.wFormatTag := wFormatTag;
      afd.dwFormatTag := wFormatTag;
      afd.cbwfx := FMaxFormatSize;
      fdwEnum := ACM_FORMATENUMF_WFORMATTAG;
      case FEnumFormats of
          efInput  : fdwEnum := fdwEnum or ACM_FORMATENUMF_INPUT;
          efOutput : fdwEnum := fdwEnum or ACM_FORMATENUMF_OUTPUT;
      end;
      Result := acmFormatEnum(0, @afd, acmFormatEnumCallback, Longint(Self), fdwEnum) = 0;
   finally
      GlobalFreeMem(Pointer(afd.pwfx));
   end;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.SuggestFormat(pwfxSrc: PWaveFormatEx; dwSuggest: Longint): Boolean;
var
   mmr: MMRESULT;
   cbwfx,cbwfxSrc: Longint;
begin
    Result := False;
    if not ACMPresent or (pwfxSrc = nil) then exit;
   { just in case no ACM driver is installed for the source format and }
   { the source has a larger format size than the largest enabled ACM  }
   { driver...                                                         }
   cbwfxSrc := wioSizeOfWaveFormat(pwfxSrc);
   cbwfx    := Max(FMaxFormatSize, cbwfxSrc);
   if (cbwfx > FMaxFormatSize) then
   begin
      FMaxFormatSize := cbwfx;
      FreeWaveHeader(FPWaveFormatEx);
      AllocWaveHeader(FPWaveFormatEx);
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
   { 'suggest anything' }
   mmr := acmFormatSuggest(0, pwfxSrc, FPWaveFormatEx, cbwfx, dwSuggest);
   if (mmr <> 0) then
      move(pwfxSrc^, FPWaveFormatEx^, cbwfxSrc);
   Result := True;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.ChooseFormat(pwfxSrc: PWaveFormatEx; Title: String): Boolean;
Label Again;
var
   mmr : MMRESULT;
   aBuf: array[0..255] of char;
   afc : TACMFORMATCHOOSE;
   cbwfx,cbwfxSrc: Longint;
   TryCount: integer;
begin
   Result := False;
   if not ACMPresent then exit;
   { initialize the TACMFORMATCHOOSE members }
   FillChar(afc, sizeOf(afc), 0);
   if pwfxSrc <> nil then
   begin
      { just in case no ACM driver is installed for the source format and }
      { the source has a larger format size than the largest enabled ACM  }
      { driver...                                                         }
      cbwfxSrc := wioSizeOfWaveFormat(pwfxSrc);
      cbwfx    := Max(FMaxFormatSize, cbwfxSrc);
      if (cbwfx > FMaxFormatSize) then
      begin
         FMaxFormatSize := cbwfx;
         FreeWaveHeader(FPWaveFormatEx);
         AllocWaveHeader(FPWaveFormatEx);
      end;
      { copy to our struc to init the dialog }
      move(pwfxSrc^, FPWaveFormatEx^, cbwfxSrc);
      afc.fdwStyle := afc.fdwStyle or ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT;
   end;
   afc.cbStruct        := sizeof(afc);
   if (Owner <> nil) then
       afc.hwndOwner   := (Owner as TWinControl).Handle;
   afc.pwfx            := FPWaveFormatEx;
   afc.cbwfx           := FMaxFormatSize;
   if (Title <> '') then
       afc.pszTitle    := StrPCopy(aBuf, Title);
   afc.szFormatTag[0]  := #0;
   afc.szFormat[0]     := #0;
   afc.pszName         := nil;
   afc.cchName         := 0;
   afc.pwfxEnum        := nil;
   afc.fdwEnum         := 0;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
   case FEnumFormats of
       efInput  : afc.fdwEnum := ACM_FORMATENUMF_INPUT;
       efOutput : afc.fdwEnum := ACM_FORMATENUMF_OUTPUT;
       efConvert: if (pwfxSrc <> nil) then
                  begin
                     afc.fdwEnum := ACM_FORMATENUMF_CONVERT;
                     afc.pwfxEnum:= pwfxSrc;
                  end;
       efSuggest: if (pwfxSrc <> nil) then
                  begin
                     afc.fdwEnum := ACM_FORMATENUMF_SUGGEST;
                     afc.pwfxEnum:= pwfxSrc;
                  end;
       efRestrict:if (pwfxSrc <> nil) then
                  begin
                     afc.fdwEnum := ACM_FORMATENUMF_WFORMATTAG;
                     afc.pwfxEnum:= pwfxSrc;
                  end;
        else afc.fdwEnum  := 0;
   end;
   afc.hInstance       := 0;
   afc.pszTemplateName := nil;
   afc.lCustData       := 0;
   afc.pfnHook         := nil;
   TryCount := 0;
Again:
   mmr := acmFormatChoose(@afc);
   if (mmr <> 0) then
   begin
      if (mmr <> ACMERR_CANCELED) then
      begin
         inc(TryCount);
         if (TryCount = 1) then goto Again; // Bug Fix for Win98
         raise EMMACMError.Create('acmFormatChoose failed with error '+IntToStr(mmr));
      end;
      exit;
   end;
   Result := True;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.ChooseFilter(pwfltrSrc: PWaveFilter; Title: String): Boolean;
var
   afc    : TACMFilterChoose;
   aBuf   : array[0..255] of char;
   mmr    : MMRESULT;
   cbwfltr: Longint;
begin
   Result := False;
   if not ACMPresent or (FNumFilters <= 0) then exit;
   { initialize the TACMFILTERCHOOSE members }
   FillChar(afc, sizeOf(afc), 0);
   cbwfltr := Max(FMaxFilterSize, sizeof(TWaveFilter));
   if (pwfltrSrc <> nil) then
   begin
      if (cbwfltr > FMaxFilterSize) then
      begin
         FMaxFilterSize := cbwfltr;
         FreeWaveFilter(FPWaveFilter);
         AllocWaveFilter(FPWaveFilter);
      end;
      move(pwfltrSrc^, FPWaveFilter, pwfltrSrc^.cbStruct);
      afc.fdwStyle := ACMFILTERCHOOSE_STYLEF_INITTOFILTERSTRUCT;
   end;
   afc.cbStruct        := sizeOf(afc);
   if (Owner <> nil) then
       afc.hwndOwner   := (Owner as TWinControl).Handle;
   afc.pwfltr          := FPWaveFilter;
   afc.cbwfltr         := cbwfltr;
   if (Title <> '') then
       afc.pszTitle    := StrPCopy(aBuf, Title);
   afc.szFilterTag[0]  := #0;
   afc.szFilter[0]     := #0;
   afc.pszName         := nil;
   afc.cchName         := 0;
   afc.fdwEnum         := 0;
   mmr := acmFilterChoose(@afc);
   if (mmr <> 0) then
   begin
      if (mmr <> ACMERR_CANCELED) then
         raise EMMACMError.Create('acmFilterChoose failed with error '+IntToStr(mmr));
      exit;
   end;
   Result := True;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.QueryConvert(pwfxDst: PWaveFormatEx; pwfltr: PWaveFilter): Boolean;
var
   mmr: MMRESULT;
begin
   Result := False;
   if ACMPresent and (FSource<>nil) and (Wave<>nil) then
   begin
      mmr := acmStreamOpen(nil, 0, Wave.PWaveFormat, pwfxDst, pwfltr, 0, 0,
                           ACM_STREAMOPENF_NONREALTIME or
                           ACM_STREAMOPENF_QUERY);
      if (mmr = 0) then Result := True;
   end;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.ProcessFile(const FileName: TFileName; pwfxDst: PWaveFormatEx;
                            pwfltr: PWaveFilter): Boolean;
Label ERROR_CONVERT;
var
   mmr: MMRESULT;
   Cancel: Boolean;
   FOnProgress: TMMWaveProgress;
   TmpFile, DestFile: PChar;
   CurByte, NumBytes, NumRead, dw: Longint;
   lpwioSrc, lpwioDst: PWaveIOCB;
   pSrc,pDst: PChar;
   SrcBufSize,DstBufSize: Longint;
   pwfxSrc: PWaveFormatEx;
   has: THACMSTREAM;
   ash : TACMStreamHeader;
begin
   Result := False;
   if not ACMPresent or (FSource = nil) or
      (Wave = nil) or Wave.Empty or (FileName = '') then exit;
   Cancel := False;
   pSrc := nil;
   pDst := nil;
   lpwioSrc := Wave.PWaveIOInfo;
   lpwioDst:= nil;
   pwfxSrc := Wave.PWaveFormat;
   if (pwfxDst = nil) then pwfxDst := pwfxSrc;
   if not QueryConvert(pwfxDst, pwfltr) then
      raise EMMACMError.Create(LoadResStr(IDS_ACMBADFORMAT));
   { open the source file and set position to data chunk }
   if wioWaveOpen(lpwioSrc) <> 0 then
      goto ERROR_CONVERT;
   { set the bytes to convert }
   NumBytes := lpwioSrc^.dwBytesLeft;
   { create the dest. WAVEIOINFO }
   if wioCreateFileInfo(lpwioDst, pwfxDst) <> 0 then
      goto ERROR_CONVERT;
   { copy all known chunks to the destination }
   if wioCopyFileInfo(lpwioDst, lpwioSrc) <> 0 then
      goto ERROR_CONVERT;
   TmpFile := StrAlloc(MAX_PATH+1);
   DestFile := StrAlloc(MAX_PATH+1);
   { first create a temporary file for the destination file }
   StrPCopy(TmpFile, FileName);
   if Not wioFileCreateTemp(TmpFile) then
      goto ERROR_CONVERT;
   { write the new Header to disc }
   if wioWriteFileInfo(lpwioDst, TmpFile) <> 0 then
      goto ERROR_CONVERT;
   { compute source bytes to read (round down to nearest }
   { block for one second of data)                       }
   with pwfxSrc^ do
   SrcBufSize := nAvgBytesPerSec-(nAvgBytesPerSec mod nBlockAlign);
   mmr := acmStreamOpen(@has, 0, pwfxSrc, pwfxDst, pwfltr, 0, 0,
                        ACM_STREAMOPENF_NONREALTIME);
   if (mmr <> 0) then
   begin
      ShowMessage('acmStreamOpen failed with error '+IntToStr(mmr));
      goto ERROR_CONVERT;
   end;
   mmr := acmStreamSize(has, SrcBufSize, DstBufSize,
                        ACM_STREAMSIZEF_SOURCE);
   if (mmr <> 0) then
   begin
      ShowMessage('acmStreamSize failed with error '+IntToStr(mmr));
      goto ERROR_CONVERT;
   end;
   { allocate the src and dst buffers for reading/converting data }
   pSrc := GlobalAllocPtr(GHND, SrcBufSize);
   if (pSrc = Nil) then goto ERROR_CONVERT;
   pDst := GlobalAllocPtr(GHND, DstBufSize);
   if (pDst = Nil) then goto ERROR_CONVERT;
   { setup the stream header structure }
   ash.cbStruct          := sizeof(ash);
   ash.fdwStatus         := 0;
   ash.dwUser            := 0;
   ash.pbSrc             := pSrc;
   ash.cbSrcLength       := SrcBufSize;
   ash.cbSrcLengthUsed   := 0;
   ash.dwSrcUser         := SrcBufSize;
   ash.pbDst             := pDst;
   ash.cbDstLength       := DstBufSize;
   ash.cbDstLengthUsed   := 0;
   ash.dwDstUser         := DstBufSize;
   mmr := acmStreamPrepareHeader(has, @ash, 0);
   if (mmr <> 0) then
   begin
      ShowMessage('acmStreamPrepareHeader failed with error '+IntToStr(mmr));
      goto ERROR_CONVERT;
   end;
   FOnProgress := Wave.OnProgress;
   CurByte := 0;
   while CurByte < NumBytes do
   begin
      { read the data to convert }
      NumRead := min(SrcBufSize, NumBytes - CurByte);
      NumRead := wioWaveReadData(lpwioSrc, pSrc, NumRead);
      if (NumRead <= 0) then break;
      ash.cbSrcLength     := NumRead;
      ash.cbDstLengthUsed := 0;
      mmr := acmStreamConvert(has, @ash, ACM_STREAMCONVERTF_BLOCKALIGN);
      if (mmr <> 0) then
      begin
         ShowMessage('acmStreamConvert failed with error '+IntToStr(mmr));
         goto ERROR_CONVERT;
      end;
      { wait until the converting is done }
      while (ash.fdwStatus and ACMSTREAMHEADER_STATUSF_DONE = 0) do;
      { adjust the current read position }
      NumRead := NumRead - ash.cbSrcLengthUsed;
      if (NumRead <> 0) then
      begin
         mmioSeek(lpwioSrc^.hmmio, -NumRead, SEEK_CUR);
         inc(lpwioSrc^.dwBytesLeft, NumRead);
      end;
      inc(CurByte, ash.cbSrcLengthUsed);
      NumRead := ash.cbDstLengthUsed;
      if (NumRead <= 0) then break;
      { have we space on the drive ? }
      if not GetDiskFree(ExtractFilePath(TmpFile),NumRead+10240) then
         goto ERROR_CONVERT;
      { write the data out as we go... }
      if wioWaveWriteData(lpwioDst, pDst, NumRead) <> NumRead then
         goto ERROR_CONVERT;
      { let the user have some time }
      Application.ProcessMessages;
      if assigned(FOnProgress) then
         FOnProgress(Self, CurByte, NumBytes, Cancel);
      if Cancel then goto ERROR_CONVERT;
   end;
   { cleanup pass }
   while True do
   begin
      dw := 0;
      NumRead := min(SrcBufSize, NumBytes - CurByte);
      if (NumRead > 0) then
      begin
         dw := wioWaveReadData(lpwioSrc, pSrc, NumRead);
         if (dw <= 0) then break;
      end;
      ash.cbSrcLength     := dw;
      ash.cbDstLengthUsed := 0;
      mmr := acmStreamConvert(has, @ash, ACM_STREAMCONVERTF_BLOCKALIGN or
                                         ACM_STREAMCONVERTF_END);
      if (mmr <> 0) then
      begin
         ShowMessage('acmStreamConvert failed with error '+IntToStr(mmr));
         goto ERROR_CONVERT;
      end;
      { wait until the converting is done }
      while (ash.fdwStatus and ACMSTREAMHEADER_STATUSF_DONE = 0) do;
      dw := ash.cbDstLengthUsed;
      if (dw = 0) then
      begin
         ash.cbDstLengthUsed := 0;
         mmr := acmStreamConvert(has, @ash, ACM_STREAMCONVERTF_END);
         if (mmr = 0) then
         begin
            { wait until the converting is done }
            while (ash.fdwStatus and ACMSTREAMHEADER_STATUSF_DONE = 0) do;
         end;
         dw := ash.cbDstLengthUsed;
         if (dw = 0) then break;
      end;
      { have we space on the drive ? }
      if not GetDiskFree(ExtractFilePath(TmpFile),dw+10240) then
         goto ERROR_CONVERT;
      { write the data out as we go... }
      if wioWaveWriteData(lpwioDst, pDst, dw) <> dw then
         goto ERROR_CONVERT;
      { adjust the current read position }
      dw := NumRead - ash.cbSrcLengthUsed;
      if (dw <> 0) then
      begin
         mmioSeek(lpwioSrc^.hmmio, -dw, SEEK_CUR);
         inc(lpwioSrc^.dwBytesLeft, dw);
      end;
      inc(CurByte, ash.cbSrcLengthUsed);
      if (ash.cbDstLengthUsed = 0) then break;
      { let the user have some time }
      Application.ProcessMessages;
      if assigned(FOnProgress) then
         FOnProgress(Self, CurByte, NumBytes, Cancel);
      if Cancel then goto ERROR_CONVERT;
   end;
   { close source and temp file }
   wioWaveClose(lpwioSrc);
   wioWaveClose(lpwioDst);
   StrPCopy(DestFile, FileName);
   { delete the real destination file (if exits) }
   if wioFileExists(DestFile) then wioFileDelete(DestFile);
   { rename the temp file to the destination file }
   if mmioRename(TmpFile, DestFile, Nil, 0) <> 0 then
      goto ERROR_CONVERT;
   Result := True;
ERROR_CONVERT:
   wioWaveClose(lpwioSrc);
   wioWaveClose(lpwioDst);
   wioFreeFileInfo(lpwioDst);
   { clear up the stream stuff }
   if (ash.fdwStatus and ACMSTREAMHEADER_STATUSF_PREPARED <> 0) then
   begin
      ash.cbSrcLength := SrcBufSize;
      ash.cbDstLength := DstBufSize;
      mmr := acmStreamUnprepareHeader(has, @ash, 0);
      if (mmr <> 0) then
         ShowMessage('acmStreamUnprepareHeader failed with error '+IntToStr(mmr));
   end;
   acmStreamClose(has, 0);
   if (pSrc <> nil) then GlobalFreePtr(pSrc);
   if (pDst <> nil) then GlobalFreePtr(pDst);
   { make sure we delete the temp file }
   if wioFileExists(TmpFile) then wioFileDelete(TmpFile);
   StrDispose(TmpFile);
   StrDispose(DestFile);
   if not Result then
      if not Cancel then
         raise EMMACMError.Create(LoadResStr(IDS_ACMERROR))
      else
         raise EMMACMError.Create(LoadResStr(IDS_ACMABORT));
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.CreateFile(const FileName: TFileName): Boolean;
begin
   Result := False;
   if ACMPresent and (FSource <> nil) and (Wave <> nil) then
   begin
      if not Wave.Empty and (FileName <> '') and (FPWaveFormatEx <> nil) then
      begin
         Wave.CreateFile(FileName, FPWaveFormatEx);
         Result := True;
      end;
   end;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.ConvertFile(const FileName: TFileName): Boolean;
begin
   Result := False;
   if ACMPresent and (FNumConverters > 0) and (FSource <> nil) and
      (Wave <> nil) and not Wave.Empty and (FileName <> '') then
   begin
      Result := ProcessFile(FileName, FPWaveFormatEx, nil);
   end;
end;
{-- TMMACM -------------------------------------------------------------}
function TMMACM.FilterFile(const FileName: TFileName): Boolean;
begin
   Result := False;
   if ACMPresent and (FNumFilters > 0) and (FSource <> nil) and
      (Wave <> nil) and not Wave.Empty and (FileName <> '') then
   begin
      Result := ProcessFile(FileName, nil, FPWaveFilter);
   end;
end;
end.

						