mmacmdlg.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/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;