mmpcmsup.pas

一套及时通讯的原码

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

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Forms,
    MMSystem,
    MMUtils,
    MMMath,
    MMRegs,
    MMWaveIO,
    MMAbout;

type
    {$IFDEF WIN32}
    TDataSize = Longint;
    {$ELSE}
    {$IFDEF USEASM}
    TDataSize = Longint;
    {$ELSE}
    TDataSize = integer;
    {$ENDIF}
    {$ENDIF}

const
    Overflow      : Boolean = False;

type
    PMMMixPool    = ^TMMMixPool;
    TMMMixPool    = record
        dwLeftVolume : Longint;  { master volumes                     }
        dwRightVolume: Longint;
        lpBuffers    : array[0..0] of PChar;
    end;

{------------------------------------------------------------------------}
function  pcmSampleClip8(Sample: Smallint): Shortint;
function  pcmSampleClip16(Sample: Longint): Smallint;

{------------------------------------------------------------------------}
function  pcmSampleVolume8(Sample: ShortInt; Volume: Longint): Shortint;
function  pcmSampleVolume16(Sample: Smallint; Volume: Longint): Smallint;

{------------------------------------------------------------------------}
function  pcmVolume(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize;
                    LeftVolume, RightVolume: Longint): Boolean;

function  pcmVolume8M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
                      {$IFDEF WIN32}pascal;{$ENDIF}
function  pcmVolume8S(lpData: PChar; dwSrcLen: TDataSize;
                      LeftVolume, RightVolume: Longint): Boolean;
                      {$IFDEF WIN32}pascal;{$ENDIF}
function  pcmVolume16M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
                       {$IFDEF WIN32}pascal;{$ENDIF}
function  pcmVolume16S(lpData: PChar; dwSrcLen: TDataSize;
                       LeftVolume, RightVolume: Longint): Boolean;
                       {$IFDEF WIN32}pascal;{$ENDIF}

{------------------------------------------------------------------------}
procedure pcmReverse(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize);

{------------------------------------------------------------------------}
function pcmPitchChange(pwfx: PWaveFormatEx; pSrc,pDst: PChar;
                        var SrcLen,DstLen,IncValue: Longint; Factor: Longint): Longint;

function pcmPitchChange8M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
                          Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}

function pcmPitchChange8S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
                          Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}

function pcmPitchChange16M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
                           Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}

function pcmPitchChange16S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
                           Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}

{------------------------------------------------------------------------}
function  pcmAllocMixPool(NumTracks: integer): PMMMixPool;

function  pcmMixIt(pwfx: PWaveFormatEx;
                   pDst: PChar; pTemp: PChar;
                   const pSrc: PMMMixPool; NumWaves: integer;
                   dwSrcLen: Longint): Boolean;

function  pcmMixIt8(pDst: PChar; pTemp: PSmallint;
                    const pSrc: PMMMixPool; NumWaves: integer;
                    dwSrcLen: Longint): Boolean;
                    {$IFDEF WIN32}pascal;{$ENDIF}

function  pcmMixIt16(pDst: PChar; pTemp: PLongint;
                     const pSrc: PMMMixPool; NumWaves: integer;
                     dwSrcLen: Longint): Boolean;
                     {$IFDEF WIN32}pascal;{$ENDIF}

{------------------------------------------------------------------------}
function  pcmIsValidFormat(pwfx: PWaveFormatEx): Boolean;

procedure pcmBuildWaveHeader(pwfx: PWaveFormatEx;wBitsPS,nChannels: Word;
                             dwSampleRate: Longint);

procedure pcmBuildWaveFormatExtensible(pwfxEx: PWaveFormatExtensible;
                                       wBitsPS, nChannels: Word;
                                       dwSampleRate: DWORD;
                                       dwChannelMask: DWORD);

procedure pcmFillSilence(pwfx: PWaveFormatEx; lpData: PChar; dwLength: Longint);

function  pcmFindZeroCross(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Cardinal;
                           Channel, Flank, Level: Integer): Longint;

procedure pcmCalcStatistics(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
                            var AvgL, AvgR, RmsL, RmsR: SmallInt);

procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
                      var PeakL, PeakR: SmallInt); {$IFDEF WIN32}pascal;{$ENDIF}

procedure pcmFindMinMax(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
                      var MinL, MaxL, MinR, MaxR: SmallInt); {$IFDEF WIN32}pascal;{$ENDIF}

procedure pcmFindSilenceEnd(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
                            Threshold: Longint; var SilenceEnd: Longint);

procedure pcmFindSilenceStart(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
                              Threshold: Longint; var SilenceStart: Longint);

function  pcmConvertSizeOutputData(pwfDst, pwfSrc: PPCMWaveFormat;
                                   NumBytesSrc: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}

function  pcmConvert(pwfDst: PPCMWaveFormat; pDst: PChar;
                     pwfSrc: PPCMWaveFormat; pSrc: PChar;
                     dwSrcLen: Cardinal): Cardinal; {$IFDEF WIN32}pascal;{$ENDIF}

function  pcmBitsPerSampleAlign(nDstBitsPS: Word; pDst: PChar;
                                nSrcBitsPS: Word; pSrc: PChar;
                                dwSrcLen: Cardinal): Cardinal;

function  pcmChannelAlign(nDstChannels: Word; pDst: PChar;
                          nSrcChannels: Word; pSrc: PChar;
                          nBitsPS: Word; dwSrcLen: Cardinal): Cardinal;

procedure pcmAvgSample8(pDst, pSrc: PChar; nSkip, nChannels: Word);
procedure pcmAvgSample16(pDst, pSrc: PChar; nSkip, nChannels: Word);
procedure pcmRepSample8(pDst, pSrc: PChar; nRep, nChannels: Word);
procedure pcmRepSample16(pDst, pSrc: PChar; nRep, nChannels: Word);

function  pcmSamplesPerSecAlign(nDstSPS: Longint; pDst: PChar;
                               nSrcSPS: Longint; pSrc: PChar;
                               nBitsPS, nChannels: Word;
                               dwSrcLen: Cardinal): Cardinal;

implementation

Uses MMMulDiv;

{*************************************************************************}
{* the code below provides 'support' routines for building/verifying     *}
{* PCM wave headers                                                      *)
{*************************************************************************}
function pcmIsValidFormat(pwfx: PWaveFormatEx): Boolean;
begin
   Result := False;
   if (pwfx = Nil) then exit;

   if (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;

   if ((pwfx^.wBitsPerSample <> 8) and (pwfx^.wBitsPerSample <> 16)) then exit;

   if ((pwfx^.nChannels <> 1) and (pwfx^.nChannels <> 2)) then exit;

   if ((pwfx^.nSamplesPerSec < 4000) or (pwfx^.nSamplesPerSec > 100000)) then
      exit;

   Result := True;
end;

(*************************************************************************)
procedure pcmBuildWaveHeader(pwfx: PWaveFormatEx; wBitsPS, nChannels: Word;
                             dwSampleRate: Longint);
begin
     { fill in the info for our destination format... }
     pwfx^.wFormatTag     := WAVE_FORMAT_PCM;
     pwfx^.nChannels      := nChannels;
     pwfx^.nSamplesPerSec := dwSampleRate;
     pwfx^.wBitsPerSample := wBitsPS;

     { set nAvgBytesPerSec and nBlockAlign }
     pwfx^.nBlockAlign    := (wBitsPS * nChannels) div 8;
     pwfx^.nAvgBytesPerSec:= pwfx^.nBlockAlign * pwfx^.nSamplesPerSec;
     pwfx^.cbSize := 0;
end;

(*************************************************************************)
procedure pcmBuildWaveFormatExtensible(pwfxEx: PWaveFormatExtensible;
                                       wBitsPS, nChannels: Word;
                                       dwSampleRate: DWORD;
                                       dwChannelMask: DWORD);
begin
   pwfxEx^.Format.wFormatTag           := WAVE_FORMAT_EXTENSIBLE;

   pwfxEx^.Format.nChannels            := nChannels;
   pwfxEx^.Format.nSamplesPerSec       := dwSampleRate;
   pwfxEx^.Format.wBitsPerSample       := wBitsPS;

   pwfxEx^.Format.nBlockAlign          := (wBitsPS * nChannels) div 8;
   pwfxEx^.Format.nAvgBytesPerSec      := dwSampleRate*pwfxex^.Format.nBlockAlign;

   pwfxEx^.Format.cbSize               := sizeof(TWaveFormatExtensible) - sizeof(TWaveFormatEx);

   pwfxEx^.Samples.wValidBitsPerSample := wBitsPS;

   pwfxEx^.dwChannelMask               := dwChannelMask;
   pwfxEx^.SubFormat                   := KSDATAFORMAT_SUBTYPE_PCM;
end;

(*************************************************************************)
procedure pcmFillSilence(pwfx: PWaveFormatEx; lpData: PChar; dwLength: Longint);
var
   Silence: integer;
begin
   if (pwfx^.wBitsPerSample = 16) then
       Silence := 0
   else
       Silence := 128;

   GlobalFillMem(lpData^,dwLength,Silence);
end;

{*************************************************************************}
{* find the zero cross point in pSrc: 8/16 bit, mono/stereo              *}
{*************************************************************************}
{* Channel: 0 = Both, 1 = Left, 2 = Right                                *}
{* Flank  : 0 = None, 1 = Up, 2 = Down                                   *)
(* Level  : LevelThreshold in %                                          *)                                             *}
{*************************************************************************}
function pcmFindZeroCross(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Cardinal;
                          Channel, Flank, Level: Integer): Longint;
var
   SrcNumBytes: Longint;
   BytePos: Cardinal;

begin
   Result := -1;
   if (Flank = 0) or (dwSrcLen = 0) then exit;
   if (Flank = 2) then Level := -Level;
   BytePos:= 0;
   if pwfx^.wBitsperSample = 8 then
   begin
      Level := Trunc(Level*127/100)+128;
      if pwfx^.nChannels = 2 then
      begin
         SrcNumBytes := dwSrcLen and not 1;
         while (SrcNumBytes > 4) do
         begin
            case Channel of
                { both channels }
                0: begin
                      { left }
                      if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+2)^>=Level) then
                      begin
                         Result := BytePos+2;
                         exit;
                      end
                      else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+2)^<=Level) then
                      begin
                         Result := BytePos+2;
                         exit;
                      end;
                      { right }
                      if (Flank=1)and(PByte(pSrc+1)^<Level)and(PByte(pSrc+3)^>=Level) then
                      begin
                         Result := BytePos+3;
                         exit;
                      end
                      else if (Flank=2)and(PByte(pSrc+1)^>Level)and(PByte(pSrc+3)^<=Level) then
                      begin
                         Result := BytePos+3;
                         exit;
                      end;
                   end;
                { the left channel }
                1: if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+2)^>=Level) then
                   begin
                      Result := BytePos+2;
                      exit;
                   end
                   else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+2)^<=Level) then
                   begin
                      Result := BytePos+2;
                      exit;
                   end;
                { the right channel }
                2: if (Flank=1)and(PByte(pSrc+1)^<Level)and(PByte(pSrc+3)^>=Level) then
                   begin
                      Result := BytePos+3;
                      exit;
                   end
                   else if (Flank=2)and(PByte(pSrc+1)^>Level)and(PByte(pSrc+3)^<=Level) then
                   begin
                      Result := BytePos+3;
                      exit;
                   end;
            end;
            inc(BytePos, 2*sizeOf(Byte));
            inc(pSrc, 2*sizeOf(Byte));
            dec(SrcNumBytes, 2*sizeOf(Byte));
         end;
      end
      else
      begin
         SrcNumBytes := dwSrcLen;
         while (SrcNumBytes > 2) do
         begin
            { we have only one channel }
            if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+1)^>=Level) then
            begin
               Result := BytePos+1;
               exit;
            end
            else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+1)^<=Level) then
            begin
               Result := BytePos+1;
               exit;
            end;
            inc(BytePos, sizeOf(Byte));
            inc(pSrc, sizeOf(Byte));
            dec(SrcNumBytes, sizeOf(Byte));
         end;
      end;
   end
   else
   begin
      Level := Level*327;
      if pwfx^.nChannels = 2 then
      begin
         SrcNumBytes := dwSrcLen and not 3;
         while (SrcNumBytes > 8) do
         begin
            case Channel of
                { both channels }
                0: begin
                      { left }
                      if (Flank=1)and(PSmallInt(pSrc)^<Level)and(PSmallInt(pSrc+4)^>=Level) then
                      begin
                         Result := BytePos+4;
                         exit;
                      end
                      else if (Flank=2)and(PSmallInt(pSrc)^>Level)and(PSmallInt(pSrc+4)^<=Level) then
                      begin
                         Result := BytePos+4;
                         exit;
                      end;
                      { right }