开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMPCMSup.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：62k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMPCMSup.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.html               =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 12.11.98 - 20:57:03 $                                        =}
  24. {========================================================================}
  25. unit MMPCMSup;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.     Windows,
  34. {$ELSE}
  35.     WinTypes,
  36.     WinProcs,
  37. {$ENDIF}
  38.     SysUtils,
  39.     Forms,
  40.     MMSystem,
  41.     MMUtils,
  42.     MMMath,
  43.     MMRegs,
  44.     MMWaveIO,
  45.     MMAbout;
  47. type
  48.     {$IFDEF WIN32}
  49.     TDataSize = Longint;
  50.     {$ELSE}
  51.     {$IFDEF USEASM}
  52.     TDataSize = Longint;
  53.     {$ELSE}
  54.     TDataSize = integer;
  55.     {$ENDIF}
  56.     {$ENDIF}
  58. const
  59.     Overflow      : Boolean = False;
  61. type
  62.     PMMMixPool    = ^TMMMixPool;
  63.     TMMMixPool    = record
  64.         dwLeftVolume : Longint;  { master volumes                     }
  65.         dwRightVolume: Longint;
  66.         lpBuffers    : array[0..0] of PChar;
  67.     end;
  69. {------------------------------------------------------------------------}
  70. function  pcmSampleClip8(Sample: Smallint): Shortint;
  71. function  pcmSampleClip16(Sample: Longint): Smallint;
  73. {------------------------------------------------------------------------}
  74. function  pcmSampleVolume8(Sample: ShortInt; Volume: Longint): Shortint;
  75. function  pcmSampleVolume16(Sample: Smallint; Volume: Longint): Smallint;
  77. {------------------------------------------------------------------------}
  78. function  pcmVolume(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize;
  79.                     LeftVolume, RightVolume: Longint): Boolean;
  81. function  pcmVolume8M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
  82.                       {$IFDEF WIN32}pascal;{$ENDIF}
  83. function  pcmVolume8S(lpData: PChar; dwSrcLen: TDataSize;
  84.                       LeftVolume, RightVolume: Longint): Boolean;
  85.                       {$IFDEF WIN32}pascal;{$ENDIF}
  86. function  pcmVolume16M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
  87.                        {$IFDEF WIN32}pascal;{$ENDIF}
  88. function  pcmVolume16S(lpData: PChar; dwSrcLen: TDataSize;
  89.                        LeftVolume, RightVolume: Longint): Boolean;
  90.                        {$IFDEF WIN32}pascal;{$ENDIF}
  92. {------------------------------------------------------------------------}
  93. procedure pcmReverse(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize);
  95. {------------------------------------------------------------------------}
  96. function pcmPitchChange(pwfx: PWaveFormatEx; pSrc,pDst: PChar;
  97.                         var SrcLen,DstLen,IncValue: Longint; Factor: Longint): Longint;
  99. function pcmPitchChange8M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  100.                           Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}
  102. function pcmPitchChange8S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  103.                           Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}
  105. function pcmPitchChange16M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  106.                            Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}
  108. function pcmPitchChange16S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  109.                            Factor: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}
  111. {------------------------------------------------------------------------}
  112. function  pcmAllocMixPool(NumTracks: integer): PMMMixPool;
  114. function  pcmMixIt(pwfx: PWaveFormatEx;
  115.                    pDst: PChar; pTemp: PChar;
  116.                    const pSrc: PMMMixPool; NumWaves: integer;
  117.                    dwSrcLen: Longint): Boolean;
  119. function  pcmMixIt8(pDst: PChar; pTemp: PSmallint;
  120.                     const pSrc: PMMMixPool; NumWaves: integer;
  121.                     dwSrcLen: Longint): Boolean;
  122.                     {$IFDEF WIN32}pascal;{$ENDIF}
  124. function  pcmMixIt16(pDst: PChar; pTemp: PLongint;
  125.                      const pSrc: PMMMixPool; NumWaves: integer;
  126.                      dwSrcLen: Longint): Boolean;
  127.                      {$IFDEF WIN32}pascal;{$ENDIF}
  129. {------------------------------------------------------------------------}
  130. function  pcmIsValidFormat(pwfx: PWaveFormatEx): Boolean;
  132. procedure pcmBuildWaveHeader(pwfx: PWaveFormatEx;wBitsPS,nChannels: Word;
  133.                              dwSampleRate: Longint);
  135. procedure pcmBuildWaveFormatExtensible(pwfxEx: PWaveFormatExtensible;
  136.                                        wBitsPS, nChannels: Word;
  137.                                        dwSampleRate: DWORD;
  138.                                        dwChannelMask: DWORD);
  140. procedure pcmFillSilence(pwfx: PWaveFormatEx; lpData: PChar; dwLength: Longint);
  142. function  pcmFindZeroCross(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Cardinal;
  143.                            Channel, Flank, Level: Integer): Longint;
  145. procedure pcmCalcStatistics(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  146.                             var AvgL, AvgR, RmsL, RmsR: SmallInt);
  148. procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  149.                       var PeakL, PeakR: SmallInt); {$IFDEF WIN32}pascal;{$ENDIF}
  151. procedure pcmFindMinMax(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  152.                       var MinL, MaxL, MinR, MaxR: SmallInt); {$IFDEF WIN32}pascal;{$ENDIF}
  154. procedure pcmFindSilenceEnd(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  155.                             Threshold: Longint; var SilenceEnd: Longint);
  157. procedure pcmFindSilenceStart(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  158.                               Threshold: Longint; var SilenceStart: Longint);
  160. function  pcmConvertSizeOutputData(pwfDst, pwfSrc: PPCMWaveFormat;
  161.                                    NumBytesSrc: Longint): Longint; {$IFDEF WIN32}pascal;{$ENDIF}
  163. function  pcmConvert(pwfDst: PPCMWaveFormat; pDst: PChar;
  164.                      pwfSrc: PPCMWaveFormat; pSrc: PChar;
  165.                      dwSrcLen: Cardinal): Cardinal; {$IFDEF WIN32}pascal;{$ENDIF}
  167. function  pcmBitsPerSampleAlign(nDstBitsPS: Word; pDst: PChar;
  168.                                 nSrcBitsPS: Word; pSrc: PChar;
  169.                                 dwSrcLen: Cardinal): Cardinal;
  171. function  pcmChannelAlign(nDstChannels: Word; pDst: PChar;
  172.                           nSrcChannels: Word; pSrc: PChar;
  173.                           nBitsPS: Word; dwSrcLen: Cardinal): Cardinal;
  175. procedure pcmAvgSample8(pDst, pSrc: PChar; nSkip, nChannels: Word);
  176. procedure pcmAvgSample16(pDst, pSrc: PChar; nSkip, nChannels: Word);
  177. procedure pcmRepSample8(pDst, pSrc: PChar; nRep, nChannels: Word);
  178. procedure pcmRepSample16(pDst, pSrc: PChar; nRep, nChannels: Word);
  180. function  pcmSamplesPerSecAlign(nDstSPS: Longint; pDst: PChar;
  181.                                nSrcSPS: Longint; pSrc: PChar;
  182.                                nBitsPS, nChannels: Word;
  183.                                dwSrcLen: Cardinal): Cardinal;
  185. implementation
  187. Uses MMMulDiv;
  189. {*************************************************************************}
  190. {* the code below provides 'support' routines for building/verifying     *}
  191. {* PCM wave headers                                                      *)
  192. {*************************************************************************}
  193. function pcmIsValidFormat(pwfx: PWaveFormatEx): Boolean;
  194. begin
  195.    Result := False;
  196.    if (pwfx = Nil) then exit;
  198.    if (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;
  200.    if ((pwfx^.wBitsPerSample <> 8) and (pwfx^.wBitsPerSample <> 16)) then exit;
  202.    if ((pwfx^.nChannels <> 1) and (pwfx^.nChannels <> 2)) then exit;
  204.    if ((pwfx^.nSamplesPerSec < 4000) or (pwfx^.nSamplesPerSec > 100000)) then
  205.       exit;
  207.    Result := True;
  208. end;
  210. (*************************************************************************)
  211. procedure pcmBuildWaveHeader(pwfx: PWaveFormatEx; wBitsPS, nChannels: Word;
  212.                              dwSampleRate: Longint);
  213. begin
  214.      { fill in the info for our destination format... }
  215.      pwfx^.wFormatTag     := WAVE_FORMAT_PCM;
  216.      pwfx^.nChannels      := nChannels;
  217.      pwfx^.nSamplesPerSec := dwSampleRate;
  218.      pwfx^.wBitsPerSample := wBitsPS;
  220.      { set nAvgBytesPerSec and nBlockAlign }
  221.      pwfx^.nBlockAlign    := (wBitsPS * nChannels) div 8;
  222.      pwfx^.nAvgBytesPerSec:= pwfx^.nBlockAlign * pwfx^.nSamplesPerSec;
  223.      pwfx^.cbSize := 0;
  224. end;
  226. (*************************************************************************)
  227. procedure pcmBuildWaveFormatExtensible(pwfxEx: PWaveFormatExtensible;
  228.                                        wBitsPS, nChannels: Word;
  229.                                        dwSampleRate: DWORD;
  230.                                        dwChannelMask: DWORD);
  231. begin
  232.    pwfxEx^.Format.wFormatTag           := WAVE_FORMAT_EXTENSIBLE;
  234.    pwfxEx^.Format.nChannels            := nChannels;
  235.    pwfxEx^.Format.nSamplesPerSec       := dwSampleRate;
  236.    pwfxEx^.Format.wBitsPerSample       := wBitsPS;
  238.    pwfxEx^.Format.nBlockAlign          := (wBitsPS * nChannels) div 8;
  239.    pwfxEx^.Format.nAvgBytesPerSec      := dwSampleRate*pwfxex^.Format.nBlockAlign;
  241.    pwfxEx^.Format.cbSize               := sizeof(TWaveFormatExtensible) - sizeof(TWaveFormatEx);
  243.    pwfxEx^.Samples.wValidBitsPerSample := wBitsPS;
  245.    pwfxEx^.dwChannelMask               := dwChannelMask;
  246.    pwfxEx^.SubFormat                   := KSDATAFORMAT_SUBTYPE_PCM;
  247. end;
  249. (*************************************************************************)
  250. procedure pcmFillSilence(pwfx: PWaveFormatEx; lpData: PChar; dwLength: Longint);
  251. var
  252.    Silence: integer;
  253. begin
  254.    if (pwfx^.wBitsPerSample = 16) then
  255.        Silence := 0
  256.    else
  257.        Silence := 128;
  259.    GlobalFillMem(lpData^,dwLength,Silence);
  260. end;
  262. {*************************************************************************}
  263. {* find the zero cross point in pSrc: 8/16 bit, mono/stereo              *}
  264. {*************************************************************************}
  265. {* Channel: 0 = Both, 1 = Left, 2 = Right                                *}
  266. {* Flank  : 0 = None, 1 = Up, 2 = Down                                   *)
  267. (* Level  : LevelThreshold in %                                          *)                                             *}
  268. {*************************************************************************}
  269. function pcmFindZeroCross(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Cardinal;
  270.                           Channel, Flank, Level: Integer): Longint;
  271. var
  272.    SrcNumBytes: Longint;
  273.    BytePos: Cardinal;
  275. begin
  276.    Result := -1;
  277.    if (Flank = 0) or (dwSrcLen = 0) then exit;
  278.    if (Flank = 2) then Level := -Level;
  279.    BytePos:= 0;
  280.    if pwfx^.wBitsperSample = 8 then
  281.    begin
  282.       Level := Trunc(Level*127/100)+128;
  283.       if pwfx^.nChannels = 2 then
  284.       begin
  285.          SrcNumBytes := dwSrcLen and not 1;
  286.          while (SrcNumBytes > 4) do
  287.          begin
  288.             case Channel of
  289.                 { both channels }
  290.                 0: begin
  291.                       { left }
  292.                       if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+2)^>=Level) then
  293.                       begin
  294.                          Result := BytePos+2;
  295.                          exit;
  296.                       end
  297.                       else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+2)^<=Level) then
  298.                       begin
  299.                          Result := BytePos+2;
  300.                          exit;
  301.                       end;
  302.                       { right }
  303.                       if (Flank=1)and(PByte(pSrc+1)^<Level)and(PByte(pSrc+3)^>=Level) then
  304.                       begin
  305.                          Result := BytePos+3;
  306.                          exit;
  307.                       end
  308.                       else if (Flank=2)and(PByte(pSrc+1)^>Level)and(PByte(pSrc+3)^<=Level) then
  309.                       begin
  310.                          Result := BytePos+3;
  311.                          exit;
  312.                       end;
  313.                    end;
  314.                 { the left channel }
  315.                 1: if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+2)^>=Level) then
  316.                    begin
  317.                       Result := BytePos+2;
  318.                       exit;
  319.                    end
  320.                    else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+2)^<=Level) then
  321.                    begin
  322.                       Result := BytePos+2;
  323.                       exit;
  324.                    end;
  325.                 { the right channel }
  326.                 2: if (Flank=1)and(PByte(pSrc+1)^<Level)and(PByte(pSrc+3)^>=Level) then
  327.                    begin
  328.                       Result := BytePos+3;
  329.                       exit;
  330.                    end
  331.                    else if (Flank=2)and(PByte(pSrc+1)^>Level)and(PByte(pSrc+3)^<=Level) then
  332.                    begin
  333.                       Result := BytePos+3;
  334.                       exit;
  335.                    end;
  336.             end;
  337.             inc(BytePos, 2*sizeOf(Byte));
  338.             inc(pSrc, 2*sizeOf(Byte));
  339.             dec(SrcNumBytes, 2*sizeOf(Byte));
  340.          end;
  341.       end
  342.       else
  343.       begin
  344.          SrcNumBytes := dwSrcLen;
  345.          while (SrcNumBytes > 2) do
  346.          begin
  347.             { we have only one channel }
  348.             if (Flank=1)and(PByte(pSrc)^<Level)and(PByte(pSrc+1)^>=Level) then
  349.             begin
  350.                Result := BytePos+1;
  351.                exit;
  352.             end
  353.             else if (Flank=2)and(PByte(pSrc)^>Level)and(PByte(pSrc+1)^<=Level) then
  354.             begin
  355.                Result := BytePos+1;
  356.                exit;
  357.             end;
  358.             inc(BytePos, sizeOf(Byte));
  359.             inc(pSrc, sizeOf(Byte));
  360.             dec(SrcNumBytes, sizeOf(Byte));
  361.          end;
  362.       end;
  363.    end
  364.    else
  365.    begin
  366.       Level := Level*327;
  367.       if pwfx^.nChannels = 2 then
  368.       begin
  369.          SrcNumBytes := dwSrcLen and not 3;
  370.          while (SrcNumBytes > 8) do
  371.          begin
  372.             case Channel of
  373.                 { both channels }
  374.                 0: begin
  375.                       { left }
  376.                       if (Flank=1)and(PSmallInt(pSrc)^<Level)and(PSmallInt(pSrc+4)^>=Level) then
  377.                       begin
  378.                          Result := BytePos+4;
  379.                          exit;
  380.                       end
  381.                       else if (Flank=2)and(PSmallInt(pSrc)^>Level)and(PSmallInt(pSrc+4)^<=Level) then
  382.                       begin
  383.                          Result := BytePos+4;
  384.                          exit;
  385.                       end;
  386.                       { right }
  387.                       if (Flank=1)and(PSmallInt(pSrc+4)^<Level)and(PSmallInt(pSrc+8)^>=Level) then
  388.                       begin
  389.                          Result := BytePos+8;
  390.                          exit;
  391.                       end
  392.                       else if (Flank=2)and(PSmallInt(pSrc+4)^>Level)and(PSmallInt(pSrc+8)^<=Level) then
  393.                       begin
  394.                          Result := BytePos+8;
  395.                          exit;
  396.                       end;
  397.                    end;
  398.                 { the left channel }
  399.                 1: if (Flank=1)and(PSmallInt(pSrc)^<Level)and(PSmallInt(pSrc+4)^>=Level) then
  400.                    begin
  401.                       Result := BytePos+4;
  402.                       exit;
  403.                    end
  404.                    else if (Flank=2)and(PSmallInt(pSrc)^>Level)and(PSmallInt(pSrc+4)^<=Level) then
  405.                    begin
  406.                       Result := BytePos+4;
  407.                       exit;
  408.                    end;
  409.                 { the right channel }
  410.                 2: if (Flank=1)and(PSmallInt(pSrc+4)^<Level)and(PSmallInt(pSrc+8)^>=Level) then
  411.                    begin
  412.                       Result := BytePos+8;
  413.                       exit;
  414.                    end
  415.                    else if (Flank=2)and(PSmallInt(pSrc+4)^>Level)and(PSmallInt(pSrc+8)^<=Level) then
  416.                    begin
  417.                       Result := BytePos+8;
  418.                       exit;
  419.                    end;
  420.             end;
  421.             inc(BytePos, 2*sizeOf(SmallInt));
  422.             inc(pSrc, 2*sizeOf(SmallInt));
  423.             dec(SrcNumBytes, 2*sizeOf(SmallInt));
  424.          end;
  425.       end
  426.       else
  427.       begin
  428.          SrcNumBytes := dwSrcLen and not 1;
  429.          while (SrcNumBytes > 4) do
  430.          begin
  431.             { we have only one channel }
  432.             if (Flank=1)and(PSmallInt(pSrc)^<Level)and(PSmallInt(pSrc+2)^>=Level) then
  433.             begin
  434.                Result := BytePos+2;
  435.                exit;
  436.             end
  437.             else if (Flank=2)and(PSmallInt(pSrc)^>Level)and(PSmallInt(pSrc+2)^<=Level) then
  438.             begin
  439.                Result := BytePos+2;
  440.                exit;
  441.             end;
  442.             inc(BytePos, sizeOf(SmallInt));
  443.             inc(pSrc, sizeOf(SmallInt));
  444.             dec(SrcNumBytes, sizeOf(SmallInt));
  445.          end;
  446.       end;
  447.    end;
  448. end;
  450. {*************************************************************************}
  451. { Computes the RMS amplitude in pSrc: 8/16 bit, mono/stereo              *}
  452. {*************************************************************************}
  453. procedure pcmCalcStatistics(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  454.                             var AvgL, AvgR, RmsL, RmsR: SmallInt);
  455. var
  456.    Samples,SrcBytes: Longint;
  457.    SumL, SumR,
  458.    SumL2,SumR2: Extended;
  459.    s: Smallint;
  461. begin
  462.    SumL := 0;
  463.    SumR := 0;
  464.    SumL2 := 0;
  465.    SumR2 := 0;
  467.    AvgL := 0;
  468.    AvgR := 0;
  469.    RmsL := 0;
  470.    RmsR := 0;
  472.    Samples := 0;
  474.    if pwfx^.wBitsperSample = 8 then
  475.    begin
  476.       if pwfx^.nChannels = 2 then
  477.       begin
  478.          SrcBytes := dwSrcLen and not 1;
  479.          while (SrcBytes > 0) do
  480.          begin
  481.             { the left channel }
  482.             s := (PByte(pSrc)^ - 128);
  483.             SumL := SumL + s;
  484.             SumL2:= SumL2 + Long(s)*s;
  486.             { the right channel }
  487.             s := (PByte(pSrc+1)^ - 128);
  488.             SumR := SumR + s;
  489.             SumR2:= SumR2 + Long(s)*s;
  491.             inc(Samples);
  493.             inc(pSrc, 2*sizeOf(Byte));
  494.             dec(SrcBytes, 2*sizeOf(Byte));
  495.          end;
  497.          if Samples > 0 then
  498.          begin
  499.             AvgL := Round(SumL/Samples);
  500.             if AvgL <> 0 then
  501.                RmsL := Round(Sqrt(SumL2/Samples-(Long(AvgL)*AvgL)));
  503.             AvgR := Round(SumR/Samples);
  504.             if AvgR <> 0 then
  505.                RmsR := Round(Sqrt(SumR2/Samples-(Long(AvgR)*AvgR)));
  506.          end;
  507.       end
  508.       else
  509.       begin
  510.          SrcBytes := dwSrcLen;
  511.          while (SrcBytes > 0) do
  512.          begin
  513.             { we have only one channel }
  514.             s := (PByte(pSrc)^ - 128);
  515.             SumL := SumL + s;
  516.             SumL2:= SumL2 + Long(s)*s;
  518.             inc(Samples);
  520.             inc(pSrc, sizeOf(Byte));
  521.             dec(SrcBytes, sizeOf(Byte));
  522.          end;
  524.          if Samples > 0 then
  525.          begin
  526.             AvgL := Round(SumL/Samples);
  527.             if AvgL <> 0 then
  528.                RmsL := Round(Sqrt(SumL2/Samples-(Long(AvgL)*AvgL)));
  529.          end;
  530.          AvgR := AvgL;
  531.          RmsR := RmsL;
  532.       end;
  533.    end
  534.    else
  535.    begin
  536.       if pwfx^.nChannels = 2 then
  537.       begin
  538.          SrcBytes := dwSrcLen and not 1;
  539.          while (SrcBytes > 0) do
  540.          begin
  541.             { the left channel }
  542.             s := PSmallint(pSrc)^;
  543.             SumL := SumL + s;
  544.             SumL2:= SumL2 + Long(s)*s;
  546.             { the right channel }
  547.             s := PSmallint(pSrc+2)^;
  548.             SumR := SumR + s;
  549.             SumR2:= SumR2 + Long(s)*s;
  551.             inc(Samples);
  553.             inc(pSrc, 2*sizeOf(SmallInt));
  554.             dec(SrcBytes, 2*sizeOf(Smallint));
  555.          end;
  557.          if Samples > 0 then
  558.          begin
  559.             AvgL := Round(SumL/Samples);
  560.             if AvgL <> 0 then
  561.                RmsL := Round(Sqrt(SumL2/Samples-(Long(AvgL)*AvgL)));
  563.             AvgR := Round(SumR/Samples);
  564.             if AvgR <> 0 then
  565.                RmsR := Round(Sqrt(SumR2/Samples-(Long(AvgR)*AvgR)));
  566.          end;
  567.       end
  568.       else
  569.       begin
  570.          SrcBytes := dwSrcLen and not 1;
  571.          while (SrcBytes > 0) do
  572.          begin
  573.             { we have only one channel }
  574.             s := PSmallint(pSrc)^;
  575.             SumL := SumL + s;
  576.             SumL2:= SumL2 + Long(s)*s;
  578.             inc(Samples);
  580.             inc(pSrc, sizeOf(SmallInt));
  581.             dec(SrcBytes, sizeOf(SmallInt));
  582.          end;
  584.          if Samples > 0 then
  585.          begin
  586.             AvgL := Round(SumL/Samples);
  587.             if AvgL <> 0 then
  588.                RmsL := Round(Sqrt(SumL2/Samples-(Long(AvgL)*AvgL)));
  589.          end;
  591.          AvgR := AvgL;
  592.          RmsR := RmsL;
  593.       end;
  594.    end;
  595. end;
  597. {*************************************************************************}
  598. function pcmVolume(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize;
  599.                    LeftVolume, RightVolume: Longint): Boolean;
  600. begin
  601.    Result := False;
  603.    if (pwfx = nil) or (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;
  605.    if (pwfx^.wBitsPerSample = 8) then
  606.    begin
  607.       if (pwfx^.nChannels = 1) then
  608.           Result := pcmVolume8M(lpData, dwSrcLen, LeftVolume)
  609.       else
  610.           Result := pcmVolume8S(lpData, dwSrcLen, LeftVolume, RightVolume);
  611.    end
  612.    else
  613.    begin
  614.       if (pwfx^.nChannels = 1) then
  615.           Result := pcmVolume16M(lpData, dwSrcLen, LeftVolume)
  616.       else
  617.           Result := pcmVolume16S(lpData, dwSrcLen, LeftVolume, RightVolume);
  618.    end;
  619. end;
  621. {*************************************************************************}
  622. procedure pcmReverse(pwfx: PWaveFormatEx; lpData: PChar; dwSrcLen: TDataSize);
  623. var
  624.    Temp: Longint;
  625.    lpSource,pTemp: PChar;
  626. begin
  627.    if (pwfx = nil) or (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;
  629.    pTemp := @Temp;
  631.    if (pwfx^.wBitsPerSample = 8) then
  632.    begin
  633.       if (pwfx^.nChannels = 1) then
  634.       begin
  635.          lpSource := (lpData+dwSrcLen-sizeOf(Byte));
  636.          dwSrcLen := dwSrcLen div 2;
  637.          while (dwSrcLen > 0) do
  638.          begin
  639.             PByte(pTemp)^   := PByte(lpData)^;
  640.             PByte(lpData)^  := PByte(lpSource)^;
  641.             PByte(lpSource)^:= PByte(pTemp)^;
  642.             inc(lpData,sizeOf(Byte));
  643.             dec(lpSource,sizeOf(Byte));
  644.             dec(dwSrcLen,sizeOf(Byte));
  645.          end;
  646.       end
  647.       else
  648.       begin
  649.          lpSource := (lpData+dwSrcLen-sizeOf(Word));
  650.          dwSrcLen := dwSrcLen div 2;
  651.          while (dwSrcLen > 0) do
  652.          begin
  653.             PWord(pTemp)^   := PWord(lpData)^;
  654.             PWord(lpData)^  := PWord(lpSource)^;
  655.             PWord(lpSource)^:= PWord(pTemp)^;
  656.             inc(lpData,sizeOf(Word));
  657.             dec(lpSource,sizeOf(Word));
  658.             dec(dwSrcLen,sizeOf(Word));
  659.          end;
  660.       end;
  661.    end
  662.    else
  663.    begin
  664.       if (pwfx^.nChannels = 1) then
  665.       begin
  666.          lpSource := (lpData+dwSrcLen-sizeOf(Smallint));
  667.          dwSrcLen := dwSrcLen div 2;
  668.          while (dwSrcLen > 0) do
  669.          begin
  670.             PSmallint(pTemp)^   := PSmallint(lpData)^;
  671.             PSmallint(lpData)^  := PSmallint(lpSource)^;
  672.             PSmallint(lpSource)^:= PSmallint(pTemp)^;
  673.             inc(lpData,sizeOf(Smallint));
  674.             dec(lpSource,sizeOf(Smallint));
  675.             dec(dwSrcLen,sizeOf(Smallint));
  676.          end;
  677.       end
  678.       else
  679.       begin
  680.          lpSource := (lpData+dwSrcLen-sizeOf(Longint));
  681.          dwSrcLen := dwSrcLen div 2;
  682.          while (dwSrcLen > 0) do
  683.          begin
  684.             PLongint(pTemp)^   := PLongint(lpData)^;
  685.             PLongint(lpData)^  := PLongint(lpSource)^;
  686.             PLongint(lpSource)^:= PLongint(pTemp)^;
  687.             inc(lpData,sizeOf(Longint));
  688.             dec(lpSource,sizeOf(Longint));
  689.             dec(dwSrcLen,sizeOf(Longint));
  690.          end;
  691.       end;
  692.    end;
  693. end;
  695. {*************************************************************************}
  696. function pcmPitchChange(pwfx: PWaveFormatEx; pSrc,pDst: PChar;
  697.                         var SrcLen,DstLen,IncValue: Longint; Factor: Longint): Longint;
  698. begin
  699.    Result := 0;
  701.    if (pwfx = nil) or (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;
  703.    if (pwfx^.wBitsPerSample = 8) then
  704.    begin
  705.       if (pwfx^.nChannels = 1) then
  706.           Result := pcmPitchChange8M(pSrc, pDst, SrcLen, DstLen, IncValue, Factor)
  707.       else
  708.           Result := pcmPitchChange8S(pSrc, pDst, SrcLen, DstLen, IncValue, Factor);
  709.    end
  710.    else
  711.    begin
  712.       if (pwfx^.nChannels = 1) then
  713.           Result := pcmPitchChange16M(pSrc, pDst, SrcLen, DstLen, IncValue, Factor)
  714.       else
  715.           Result := pcmPitchChange16S(pSrc, pDst, SrcLen, DstLen, IncValue, Factor);
  716.    end;
  717. end;
  719. {*************************************************************************}
  720. procedure pcmFindSilenceEnd(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  721.                             Threshold: Longint; var SilenceEnd: Longint);
  722. var
  723.    SrcNumBytes: Longint;
  724. begin
  725.    SilenceEnd := -1;
  726.    if (Threshold < 0) then Threshold := 0;
  727.    if pwfx^.wBitsperSample = 8 then
  728.    begin
  729.       if pwfx^.nChannels = 2 then
  730.       begin
  731.          SrcNumBytes := dwSrcLen and not 1;
  732.          while (SrcNumBytes > 0) do
  733.          begin
  734.             if (abs(PByte(pSrc)^ - 128) > Threshold) or      { the left channel }
  735.                (abs(PByte(pSrc+1)^ - 128) > Threshold) then  { the right channel }
  736.             begin
  737.                SilenceEnd := dwSrcLen-SrcNumBytes;
  738.                exit;
  739.             end;
  740.             inc(pSrc, 2*sizeOf(Byte));
  741.             dec(SrcNumBytes, 2*sizeOf(Byte));
  742.          end;
  743.       end
  744.       else
  745.       begin
  746.          SrcNumBytes := dwSrcLen;
  747.          while (SrcNumBytes > 0) do
  748.          begin
  749.             { we have only one channel }
  750.             if (abs(PByte(pSrc)^ -128) > Threshold) then
  751.             begin
  752.                SilenceEnd := dwSrcLen-SrcNumBytes;
  753.                exit;
  754.             end;
  755.             inc(pSrc, sizeOf(Byte));
  756.             dec(SrcNumBytes, sizeOf(Byte));
  757.          end;
  758.       end;
  759.    end
  760.    else
  761.    begin
  762.       if pwfx^.nChannels = 2 then
  763.       begin
  764.          SrcNumBytes := dwSrcLen and not 3;
  765.          while (SrcNumBytes > 0) do
  766.          begin
  767.             if (abs(PSmallint(pSrc)^) > Threshold) or      { the left channel }
  768.                (abs(PSmallint(pSrc+2)^) > Threshold) then  { the right channel }
  769.             begin
  770.                SilenceEnd := dwSrcLen-SrcNumBytes;
  771.                exit;
  772.             end;
  773.             inc(pSrc, 2*sizeOf(SmallInt));
  774.             dec(SrcNumBytes, 2*sizeOf(SmallInt));
  775.          end;
  776.       end
  777.       else
  778.       begin
  779.          SrcNumBytes := dwSrcLen and not 1;
  780.          while (SrcNumBytes > 0) do
  781.          begin
  782.             { we have only one channel }
  783.             if (abs(PSmallint(pSrc)^) > Threshold) then
  784.             begin
  785.                SilenceEnd := dwSrcLen-SrcNumBytes;
  786.                exit;
  787.             end;
  788.             inc(pSrc, sizeOf(SmallInt));
  789.             dec(SrcNumBytes, sizeOf(SmallInt));
  790.          end;
  791.       end;
  792.    end;
  793. end;
  795. {*************************************************************************}
  796. procedure pcmFindSilenceStart(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  797.                               Threshold: Longint; var SilenceStart: Longint);
  798. var
  799.    SrcNumBytes: Longint;
  800. begin
  801.    SilenceStart := -1;
  802.    if (Threshold < 0) then Threshold := 0;
  804.    if pwfx^.wBitsperSample = 8 then
  805.    begin
  806.       if pwfx^.nChannels = 2 then
  807.       begin
  808.          SrcNumBytes := dwSrcLen and not 1;
  809.          while (SrcNumBytes > 0) do
  810.          begin
  811.             if (abs(PByte(pSrc)^ - 128) <= Threshold) and     { the left channel }
  812.                (abs(PByte(pSrc+1)^ - 128) <= Threshold) then  { the right channel }
  813.             begin
  814.                if (SilenceStart = -1) then
  815.                    SilenceStart := dwSrcLen-SrcNumBytes;
  816.             end
  817.             else
  818.             begin
  819.                SilenceStart := -1;
  820.             end;
  821.             inc(pSrc, 2*sizeOf(Byte));
  822.             dec(SrcNumBytes, 2*sizeOf(Byte));
  823.          end;
  824.       end
  825.       else
  826.       begin
  827.          SrcNumBytes := dwSrcLen;
  828.          while (SrcNumBytes > 0) do
  829.          begin
  830.             { we have only one channel }
  831.             if (abs(PByte(pSrc)^ -128) <= Threshold) then
  832.             begin
  833.                if (SilenceStart = -1) then
  834.                    SilenceStart := dwSrcLen-SrcNumBytes;
  835.             end
  836.             else
  837.             begin
  838.                SilenceStart := -1;
  839.             end;
  840.             inc(pSrc, sizeOf(Byte));
  841.             dec(SrcNumBytes, sizeOf(Byte));
  842.          end;
  843.       end;
  844.    end
  845.    else
  846.    begin
  847.       if pwfx^.nChannels = 2 then
  848.       begin
  849.          SrcNumBytes := dwSrcLen and not 3;
  850.          while (SrcNumBytes > 0) do
  851.          begin
  852.             if (abs(PSmallint(pSrc)^) <= Threshold) and     { the left channel }
  853.                (abs(PSmallint(pSrc+2)^) <= Threshold) then  { the right channel }
  854.             begin
  855.                if (SilenceStart = -1) then
  856.                    SilenceStart := dwSrcLen-SrcNumBytes;
  857.             end
  858.             else
  859.             begin
  860.                SilenceStart := -1;
  861.             end;
  862.             inc(pSrc, 2*sizeOf(SmallInt));
  863.             dec(SrcNumBytes, 2*sizeOf(SmallInt));
  864.          end;
  865.       end
  866.       else
  867.       begin
  868.          SrcNumBytes := dwSrcLen and not 1;
  869.          while (SrcNumBytes > 0) do
  870.          begin
  871.             { we have only one channel }
  872.             if (abs(PSmallint(pSrc)^) <= Threshold) then
  873.             begin
  874.                if (SilenceStart = -1) then
  875.                    SilenceStart := dwSrcLen-SrcNumBytes;
  876.             end
  877.             else
  878.             begin
  879.                SilenceStart := -1;
  880.             end;
  881.             inc(pSrc, sizeOf(SmallInt));
  882.             dec(SrcNumBytes, sizeOf(SmallInt));
  883.          end;
  884.       end;
  885.    end;
  886. end;
  888. {*************************************************************************}
  889. {$IFDEF USEASM}
  890. {$IFDEF WIN32}{$L MMPCM32.OBJ}{$ELSE}{$L MMPCM16.OBJ}{$ENDIF}
  891. {$F+}
  892. function  pcmSampleClip8(Sample: SmallInt): ShortInt; external;
  893. function  pcmSampleClip16(Sample: Longint): SmallInt; external;
  895. function  pcmSampleVolume8(Sample: Shortint; Volume: Longint): ShortInt; external;
  896. function  pcmSampleVolume16(Sample: Smallint; Volume: Longint): SmallInt; external;
  898. function  pcmVolume8M(lpData: PChar; dwSrcLen, Volume: Longint): Boolean; external;
  899. function  pcmVolume8S(lpData: PChar; dwSrcLen, LeftVolume, RightVolume: Longint): Boolean; external;
  900. function  pcmVolume16M(lpData: PChar; dwSrcLen, Volume: Longint): Boolean; external;
  901. function  pcmVolume16S(lpData: PChar; dwSrcLen, LeftVolume, RightVolume: Longint): Boolean; external;
  903. procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  904.                       var PeakL, PeakR: SmallInt); external;
  905. procedure pcmFindMinMax(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  906.                       var MinL, MaxL, MinR, MaxR: SmallInt); external;
  907. function  pcmConvertSizeOutputData(pwfDst, pwfSrc: PPCMWaveFormat;
  908.                                    NumBytesSrc: Longint): Longint; external;
  910. function  pcmConvert(pwfDst: PPCMWaveFormat; pDst: PChar;
  911.                      pwfSrc: PPCMWaveFormat; pSrc: PChar;
  912.                      dwSrcLen: Cardinal): Cardinal; external;
  913. {$F-}
  914. {$ELSE}
  915. (*************************************************************************)
  916. function pcmSampleClip8(Sample: SmallInt): ShortInt;
  917. const
  918.      ClipValue = 127;
  919. begin
  920.    if (Sample < -ClipValue) then
  921.    begin
  922.       Result := -ClipValue;
  923.       Overflow := True;
  924.    end
  925.    else if (Sample > ClipValue) then
  926.    begin
  927.       Result := ClipValue;
  928.       Overflow := True;
  929.    end
  930.    else
  931.        Result := Sample;
  932. end;
  934. (*************************************************************************)
  935. function pcmSampleClip16(Sample: Longint): SmallInt;
  936. const
  937.      ClipValue = 32767;
  938. begin
  939.    if (Sample < -ClipValue) then
  940.    begin
  941.       Result := -ClipValue;
  942.       Overflow := True;
  943.    end
  944.    else if (Sample > ClipValue) then
  945.    begin
  946.       Result := ClipValue;
  947.       Overflow := True;
  948.    end
  949.    else
  950.        Result := Sample;
  951. end;
  953. (*************************************************************************)
  954. function pcmSampleVolume8(Sample: ShortInt; Volume: Longint): ShortInt;
  955. begin
  956.    Result := 128 + ((Sample-128) * Volume) div VOLUMEBASE;
  957. end;
  959. (*************************************************************************)
  960. function pcmSampleVolume16(Sample: Smallint; Volume: Longint): Smallint;
  961. begin
  962.    Result := (Sample * Volume) div VOLUMEBASE;
  963. end;
  965. (*************************************************************************)
  966. function pcmVolume8M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
  967. var
  968.    s: Smallint;
  969. begin
  970.    Overflow := False;
  971.    while (dwSrcLen > 0) do
  972.    begin
  973.       s := 128+((PByte(lpData)^-128) * Volume) div VOLUMEBASE;
  974.       PByte(lpData)^ := pcmSampleClip8(s);
  975.       inc(lpData, sizeOf(Byte));
  976.       dec(dwSrcLen, sizeOf(Byte));
  977.    end;
  978.    Result := Overflow;
  979. end;
  981. (*************************************************************************)
  982. function pcmVolume8S(lpData: PChar; dwSrcLen: TDataSize; LeftVolume, RightVolume: Longint): Boolean;
  983. var
  984.    s: Smallint;
  985. begin
  986.    Overflow := False;
  987.    dwSrcLen := dwSrcLen and not 1;
  988.    while (dwSrcLen > 0) do
  989.    begin
  990.       s := 128+((PByte(lpData)^-128) * LeftVolume) div VOLUMEBASE;
  991.       PByte(lpData)^ := pcmSampleClip8(s);
  992.       inc(lpData, sizeOf(Byte));
  994.       s := 128+((PByte(lpData)^-128) * RightVolume) div VOLUMEBASE;
  995.       PByte(lpData)^ := pcmSampleClip8(s);
  996.       inc(lpData, sizeOf(Byte));
  998.       dec(dwSrcLen, 2*sizeOf(Byte));
  999.    end;
  1000.    Result := Overflow;
  1001. end;
  1003. (*************************************************************************)
  1004. function pcmVolume16M(lpData: PChar; dwSrcLen: TDataSize; Volume: Longint): Boolean;
  1005. var
  1006.    s: Longint;
  1007. begin
  1008.    Overflow := False;
  1009.    dwSrcLen := dwSrcLen and not 1;
  1010.    while (dwSrcLen > 0) do
  1011.    begin
  1012.       s := (PSmallint(lpData)^ * Volume) div VOLUMEBASE;
  1013.       PSmallint(lpData)^ := pcmSampleClip16(s);
  1014.       inc(lpData, sizeOf(Smallint));
  1015.       dec(dwSrcLen, sizeOf(Smallint));
  1016.    end;
  1017.    Result := Overflow;
  1018. end;
  1020. (*************************************************************************)
  1021. function pcmVolume16S(lpData: PChar; dwSrcLen: TDataSize; LeftVolume, RightVolume: Longint): Boolean;
  1022. var
  1023.    s: Longint;
  1024. begin
  1025.    Overflow := False;
  1026.    dwSrcLen := dwSrcLen and not 3;
  1027.    while (dwSrcLen > 0) do
  1028.    begin
  1029.       s := (PSmallint(lpData)^ * LeftVolume) div VOLUMEBASE;
  1030.       PSmallint(lpData)^ := pcmSampleClip16(s);
  1031.       inc(lpData, sizeOf(Smallint));
  1033.       s := (PSmallint(lpData)^ * RightVolume) div VOLUMEBASE;
  1034.       PSmallint(lpData)^ := pcmSampleClip16(s);
  1035.       inc(lpData, sizeOf(Smallint));
  1037.       dec(dwSrcLen, 2*sizeOf(Smallint));
  1038.    end;
  1039.    Result := Overflow;
  1040. end;
  1042. {*************************************************************************}
  1043. {* find the peak value in pSrc: 8/16 bit, mono/stereo                    *}
  1044. {*************************************************************************}
  1045. procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  1046.                       var PeakL, PeakR: SmallInt);
  1047. var
  1048.    SrcNumBytes,sd: Longint;
  1049.    pL,pR,sw: Smallint;
  1051. begin
  1052.    PeakL := 0;
  1053.    PeakR := 0;
  1054.    pR    := 0;
  1055.    pL    := 0;
  1056.    if pwfx^.wBitsperSample = 8 then
  1057.    begin
  1058.       if pwfx^.nChannels = 2 then
  1059.       begin
  1060.          SrcNumBytes := dwSrcLen and not 1;
  1061.          while (SrcNumBytes > 0) do
  1062.          begin
  1063.             { the left channel }
  1064.             sw := PByte(pSrc)^ - 128;
  1065.             if abs(sw) > pL then
  1066.             begin
  1067.                PeakL := sw;
  1068.                pL := Min(abs(sw),127);
  1069.             end;
  1071.             { the right channel }
  1072.             sw := PByte(pSrc+1)^ - 128;
  1073.             if abs(sw) > pR then
  1074.             begin
  1075.                PeakR := sw;
  1076.                pR := Min(abs(sw),127);
  1077.             end;
  1079.             inc(pSrc, 2*sizeOf(Byte));
  1080.             dec(SrcNumBytes, 2*sizeOf(Byte));
  1081.          end;
  1082.          PeakL := PeakL + 128;
  1083.          PeakR := PeakR + 128;
  1084.       end
  1085.       else
  1086.       begin
  1087.          SrcNumBytes := dwSrcLen;
  1088.          while (SrcNumBytes > 0) do
  1089.          begin
  1090.             { we have only one channel }
  1091.             sw := PByte(pSrc)^ -128;
  1092.             if abs(sw) > pL then
  1093.             begin
  1094.                PeakL := sw;
  1095.                pL := Min(abs(sw),127);
  1096.             end;
  1098.             inc(pSrc, sizeOf(Byte));
  1099.             dec(SrcNumBytes, sizeOf(Byte));
  1100.          end;
  1101.          PeakL := PeakL + 128;
  1102.          PeakR := PeakL;
  1103.       end;
  1104.    end
  1105.    else
  1106.    begin
  1107.       if pwfx^.nChannels = 2 then
  1108.       begin
  1109.          SrcNumBytes := dwSrcLen and not 3;
  1110.          while (SrcNumBytes > 0) do
  1111.          begin
  1112.             { the left channel }
  1113.             sd := PSmallint(pSrc)^;
  1114.             if abs(sd) > pL then
  1115.             begin
  1116.                PeakL := sd;
  1117.                pL := Min(abs(sd),32767);
  1118.             end;
  1120.             { the right channel }
  1121.             sd := PSmallint(pSrc+2)^;
  1122.             if abs(sd) > pR then
  1123.             begin
  1124.                PeakR := sd;
  1125.                pR := Min(abs(sd),32767);
  1126.             end;
  1128.             inc(pSrc, 2*sizeOf(SmallInt));
  1129.             dec(SrcNumBytes, 2*sizeOf(SmallInt));
  1130.          end;
  1131.       end
  1132.       else
  1133.       begin
  1134.          SrcNumBytes := dwSrcLen and not 1;
  1135.          while (SrcNumBytes > 0) do
  1136.          begin
  1137.             { we have only one channel }
  1138.             sd := PSmallint(pSrc)^;
  1139.             if abs(sd) > pL then
  1140.             begin
  1141.                PeakL := sd;
  1142.                pL := Min(abs(sd),32767);
  1143.             end;
  1145.             inc(pSrc, sizeOf(SmallInt));
  1146.             dec(SrcNumBytes, sizeOf(SmallInt));
  1147.          end;
  1148.          PeakR := PeakL;
  1149.       end;
  1150.    end;
  1151. end;
  1153. {*************************************************************************}
  1154. {* find the signed Min/Max value in pSrc: 8/16 bit, mono/stereo                *}
  1155. {*************************************************************************}
  1156. procedure pcmFindMinMax(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: TDataSize;
  1157.                       var MinL, MaxL, MinR, MaxR: SmallInt);
  1158. var
  1159.    SrcNumBytes: Longint;
  1160.    i, MinIdx_L, MaxIdx_L, MinIdx_R, MaxIdx_R: integer;
  1162. begin
  1163.    MinIdx_L := 0;
  1164.    MaxIdx_L := 0;
  1165.    MinIdx_R := 0;
  1166.    MaxIdx_R := 0;
  1167.    i := 0;
  1168.    if pwfx^.wBitsperSample = 8 then
  1169.    begin
  1170.       MinL := 128;
  1171.       MaxL := 128;
  1172.       MinR := 128;
  1173.       MaxR := 128;
  1174.       if pwfx^.nChannels = 2 then
  1175.       begin
  1176.          SrcNumBytes := dwSrcLen and not 1;
  1177.          if (SrcNumBytes > 0) then
  1178.          begin
  1179.             MinL := 127;
  1180.             MaxL := -128;
  1181.             MinR := 127;
  1182.             MaxR := -128;
  1183.             while (SrcNumBytes > 0) do
  1184.             begin
  1185.                { the left channel }
  1186.                if PByte(pSrc)^ -128 < MinL then
  1187.                begin
  1188.                   MinL := PByte(pSrc)^ -128;
  1189.                   MinIdx_L := i;
  1190.                end;
  1192.                if PByte(pSrc)^ -128 > MaxL then
  1193.                begin
  1194.                   MaxL := PByte(pSrc)^ -128;
  1195.                   MaxIdx_L := i;
  1196.                end;
  1198.                { the right channel }
  1199.                if PByte(pSrc+1)^ -128 < MinR then
  1200.                begin
  1201.                   MinR := PByte(pSrc+1)^ -128;
  1202.                   MinIdx_R := i;
  1203.                end;
  1205.                if PByte(pSrc+1)^ -128 > MaxR then
  1206.                begin
  1207.                   MaxR := PByte(pSrc+1)^ -128;
  1208.                   MaxIdx_R := i;
  1209.                end;
  1210.                inc(pSrc, 2*sizeOf(Byte));
  1211.                dec(SrcNumBytes, 2*sizeOf(Byte));
  1212.                inc(i);
  1213.             end;
  1214.             if MaxIdx_L < MinIdx_L then SwapSmall(MinL, MaxL);
  1215.             if MaxIdx_R < MinIdx_R then SwapSmall(MinR, MaxR);
  1216.             MinL := MinL + 128;
  1217.             MaxL := MaxL + 128;
  1218.             MinR := MinR + 128;
  1219.             MaxR := MaxR + 128;
  1220.          end;
  1221.       end
  1222.       else
  1223.       begin
  1224.          SrcNumBytes := dwSrcLen;
  1225.          if (SrcNumBytes > 0) then
  1226.          begin
  1227.             MinL := 127;
  1228.             MaxL := -128;
  1230.             while (SrcNumBytes > 0) do
  1231.             begin
  1232.                { we have only one channel }
  1233.                if PByte(pSrc)^ -128 < MinL then
  1234.                begin
  1235.                   MinL := PByte(pSrc)^ -128;
  1236.                   MinIdx_L := i;
  1237.                end;
  1239.                if PByte(pSrc)^ -128 > MaxL then
  1240.                begin
  1241.                   MaxL := PByte(pSrc)^ -128;
  1242.                   MaxIdx_L := i;
  1243.                end;
  1245.                inc(pSrc, sizeOf(Byte));
  1246.                dec(SrcNumBytes, sizeOf(Byte));
  1247.                inc(i);
  1248.             end;
  1249.             if MaxIdx_L < MinIdx_L then SwapSmall(MinL, MaxL);
  1250.             MinL := MinL + 128;
  1251.             MaxL := MaxL + 128;
  1252.             MinR := MinL;
  1253.             MaxR := MaxL;
  1254.          end;
  1255.       end;
  1256.    end
  1257.    else
  1258.    begin
  1259.       MinL := 0;
  1260.       MaxL := 0;
  1261.       MinR := 0;
  1262.       MaxR := 0;
  1264.       if pwfx^.nChannels = 2 then
  1265.       begin
  1266.          SrcNumBytes := dwSrcLen and not 3;
  1267.          if (SrcNumBytes > 0) then
  1268.          begin
  1269.             MinL := 32767;
  1270.             MaxL := -32768;
  1271.             MinR := 32767;
  1272.             MaxR := -32768;
  1273.             while (SrcNumBytes > 0) do
  1274.             begin
  1275.                { the left channel }
  1276.                if PSmallInt(pSrc)^ < MinL then
  1277.                begin
  1278.                   MinL := PSmallint(pSrc)^;
  1279.                   MinIdx_L := i;
  1280.                end;
  1282.                if PSmallInt(pSrc)^ > MaxL then
  1283.                begin
  1284.                   MaxL := PSmallint(pSrc)^;
  1285.                   MaxIdx_L := i;
  1286.                end;
  1288.                { the right channel }
  1289.                if PSmallint(pSrc+2)^ < MinR then
  1290.                begin
  1291.                   MinR := PSmallint(pSrc+2)^;
  1292.                   MinIdx_R := i;
  1293.                end;
  1295.                if PSmallint(pSrc+2)^ > MaxR then
  1296.                begin
  1297.                   MaxR := PSmallint(pSrc+2)^;
  1298.                   MaxIdx_R := i;
  1299.                end;
  1301.                inc(pSrc, 2*sizeOf(SmallInt));
  1302.                dec(SrcNumBytes, 2*sizeOf(SmallInt));
  1303.                inc(i);
  1304.             end;
  1305.             if MaxIdx_L < MinIdx_L then SwapSmall(MinL, MaxL);
  1306.             if MaxIdx_R < MinIdx_R then SwapSmall(MinR, MaxR);
  1307.          end;
  1308.       end
  1309.       else
  1310.       begin
  1311.          { we have only one channel }
  1312.          SrcNumBytes := dwSrcLen and not 1;
  1313.          if (SrcNumBytes > 0) then
  1314.          begin
  1315.             MinL := 32767;
  1316.             MaxL := -32768;
  1317.             while (SrcNumBytes > 0) do
  1318.             begin
  1319.                { we have only one channel }
  1320.                if PSmallInt(pSrc)^ < MinL then
  1321.                begin
  1322.                   MinL := PSmallint(pSrc)^;
  1323.                   MinIdx_L := i;
  1324.                end;
  1326.                if PSmallInt(pSrc)^ > MaxL then
  1327.                begin
  1328.                   MaxL := PSmallint(pSrc)^;
  1329.                   MaxIdx_L := i;
  1330.                end;
  1332.                inc(pSrc, sizeOf(SmallInt));
  1333.                dec(SrcNumBytes, sizeOf(SmallInt));
  1334.                inc(i);
  1335.             end;
  1336.             if MaxIdx_L < MinIdx_L then SwapSmall(MinL, MaxL);
  1337.             MinR := MinL;
  1338.             MaxR := MaxL;
  1339.          end;
  1340.       end;
  1341.    end;
  1342. end;
  1344. {*************************************************************************}
  1345. {* all formats: 8/16 bit, Mono/Stereo, frequency: 1..$FFFFFF             *}
  1346. {*************************************************************************}
  1347. function pcmConvertSizeOutputData(pwfDst, pwfSrc: PPCMWaveFormat;
  1348.                                   NumBytesSrc: Longint): Longint;
  1349. Var
  1350.    nSamples: Longint;
  1351. begin
  1352.    (* OutSamples := (SrcSamples * DstSampleRate) div SrcSampleRate *)
  1353.    nSamples := wioBytesToSamples(PWaveFormatEx(pwfSrc), NumBytesSrc);
  1354.    nSamples := muldiv32(nSamples, pwfDst^.wf.nSamplesPerSec, pwfSrc^.wf.nSamplesPerSec);
  1355.    Result := wioSamplesToBytes(PWaveFormatEx(pwfDst), nSamples);
  1356. end;
  1358. {*************************************************************************}
  1359. {* convert all: 8/16 bit, Mono/Stereo, frequency: 1..$FFFFFF             *}
  1360. {*************************************************************************}
  1361. function pcmConvert(pwfDst: PPCMWaveFormat; pDst: PChar;
  1362.                     pwfSrc: PPCMWaveFormat; pSrc: PChar;
  1363.                     dwSrcLen: Cardinal): Cardinal;
  1364. Var
  1365.    newSample16: array[0..1] of SmallInt;
  1366.    newSample8: array[0..1] of Byte;
  1367.    dwSrcSampleRate, dwDstSampleRate: Longint;
  1368.    wSrcChannels, wDstChannels: Word;
  1369.    wSrcBytesPS, wDstBytesPS: Word;                     { Bytes per Sample }
  1370.    dwNumSamples, dwSum: Longint;
  1371.    dwTotalDst: integer;
  1373.    fBPSUp: Boolean; { convert BPS up }
  1374.    fBPSDown: Boolean; { convert BPS down }
  1375.    i: integer;
  1377. {-------------------}
  1378. Procedure ReadSample;
  1379. Var
  1380.    ch: integer;
  1381. begin
  1382.    { get the source sample(s) }
  1383.    for ch := 0 to wSrcChannels-1 do
  1384.    begin
  1385.       if fBPSUp then
  1386.       begin
  1387.          newSample16[ch] := (PByte(pSrc)^ shl 8) xor $8000;
  1388.          inc(pSrc);
  1389.       end
  1390.       else if fBPSDown then
  1391.       begin
  1392.          newSample8[ch] := ((PSmallInt(pSrc)^ xor $8000) + $0080) shr 8;
  1393.          inc(pSrc,2);
  1394.       end
  1395.       else if (wSrcBytesPS <= 1) then
  1396.       begin
  1397.          newSample8[ch] := PByte(pSrc)^;
  1398.          inc(pSrc);
  1399.       end
  1400.       else
  1401.       begin
  1402.          newSample16[ch] := PSmallint(pSrc)^;
  1403.          inc(pSrc,2);
  1404.       end;
  1405.    end;
  1406. end;
  1408. {--------------------}
  1409. procedure WriteSample;
  1410. Var
  1411.    ch: integer;
  1412. begin
  1413.    for ch := 0 to wDstChannels-1 do
  1414.    begin
  1415.       if fBPSDown or (wDstBytesPS <= 1) then
  1416.       begin
  1417.          if (wSrcChannels = wDstChannels) then
  1418.             PByte(pDst)^ := newSample8[ch]
  1419.          else if (wSrcChannels < wDstChannels) then
  1420.             PByte(pDst)^ := newSample8[0]
  1421.          else { mix the two channels }
  1422.             PByte(pDst)^ := MinMax(Word(newSample8[0]) + newSample8[1],0,255);
  1423.          inc(pDst);
  1424.  inc(dwTotalDst);
  1425.       end
  1426.       else
  1427.       begin
  1428.          if (wSrcChannels = wDstChannels) then
  1429.             PSmallInt(pDst)^ := newSample16[ch]
  1430.          else if (wSrcChannels < wDstChannels) then
  1431.             PSmallInt(pDst)^ := newSample16[0]
  1432.          else { mix the two channels }
  1433.             PSmallInt(pDst)^ := MinMax(Longint(newSample16[0]) + newSample16[1],-32768,32765);
  1434.          inc(pDst,2);
  1435.  inc(dwTotalDst, 2);
  1436.       end;
  1437.    end;
  1438. end;
  1440. {-- MAIN --}
  1441. begin
  1442.    fBPSup := False;
  1443.    fBPSDown := False;
  1445.    wSrcBytesPS := pwfSrc^.wBitsPerSample shr 3;
  1446.    wDstBytesPS := pwfDst^.wBitsPerSample shr 3;
  1448.    wSrcChannels := pwfSrc^.wf.nChannels;
  1449.    wDstChannels := pwfDst^.wf.nChannels;
  1451.    dwSrcSampleRate := pwfSrc^.wf.nSamplesPerSec;
  1452.    dwDstSampleRate := pwfDst^.wf.nSamplesPerSec;
  1454.    { if wave formats are the same just return the input buffer }
  1455.    if ((wSrcChannels = wDstChannels) and
  1456.        (dwSrcSampleRate = dwDstSampleRate) and
  1457.        (wSrcBytesPS = wDstBytesPS)) then
  1458.    begin
  1459.       move(pSrc^, pDst^, dwSrcLen);
  1460.       Result := dwSrcLen;
  1461.       exit;
  1462.    end;
  1464.    dwNumSamples := dwSrcLen div wSrcBytesPS div wSrcChannels;
  1466.    if (wSrcBytesPS <= 1) and (wDstBytesPS >  1) then fBPSUp := True;
  1467.    if (wSrcBytesPS >  1) and (wDstBytesPS <= 1) then fBPSDown := True;
  1469.    dwTotalDst := 0;
  1471.    { PCM format (8 or 16 bit, mono/stereo, and sample rate). }
  1472.    if (dwSrcSampleRate > dwDstSampleRate) then
  1473.    begin
  1474.        { down sampling, skip samples }
  1475.        dwSum := dwSrcSampleRate div 2;
  1476.        for i := 0 to dwNumSamples-1 do
  1477.        begin
  1478.           ReadSample;
  1480.           dwSum := dwSum - dwDstSampleRate;
  1481.           if dwSum < 0 then
  1482.           begin
  1483.              WriteSample;
  1485.              dwSum := dwSum + dwSrcSampleRate;
  1486.           end;
  1487.        end;
  1488.    end
  1489.    else
  1490.    begin
  1491.        { up sampling, repeat samples }
  1492.        dwSum := dwDstSampleRate div 2;
  1493.        for i := 0 to dwNumSamples-1 do
  1494.        begin
  1495.           ReadSample;
  1497.           while dwSum >= 0 do
  1498.           begin
  1499.              WriteSample;
  1501.              dwSum := dwSum - dwSrcSampleRate;
  1502.           end;
  1504.           dwSum := dwSum + dwDstSampleRate;
  1505.        end;
  1506.    end;
  1508.    Result := dwTotalDst;
  1509. end;
  1510. {$ENDIF}
  1512. {*************************************************************************}
  1513. {* only standard: 8/16 bit PCM                                           *}
  1514. {*************************************************************************}
  1515. function pcmBitsPerSampleAlign(nDstBitsPS: Word; pDst: PChar;
  1516.                                nSrcBitsPS: Word; pSrc: PChar;
  1517.                                dwSrcLen: Cardinal): Cardinal;
  1518. Var
  1519.    i: integer;
  1520.    dwNumSamples: Longint;
  1521.    dwTotalDst: Longint;
  1523. begin
  1524.    if (nSrcBitsPS = nDstBitsPS) then
  1525.    begin
  1526.       move(pSrc^, pDst^, dwSrcLen);
  1527.       Result := dwSrcLen;
  1528.       exit;
  1529.    end;
  1531.    dwNumSamples := dwSrcLen div (nSrcBitsPS shr 3);
  1532.    dwTotalDst := 0;
  1534.    if (nSrcBitsPS > nDstBitsPS) then
  1535.    begin                                   { convert from 16 bit to 8 bit }
  1536.       for i := 0 to dwNumSamples-1 do
  1537.       begin
  1538.        PByte(pDst)^ := (PSmallInt(pSrc)^ div 256) + 128;
  1539.         inc(pSrc, 2);
  1540.         inc(pDst);
  1541.         inc(dwTotalDst);
  1542.       end;
  1543.    end
  1544.    else
  1545.    begin                                   { convert from 8 bit to 16 bit }
  1546.       for i := 0 to dwNumSamples-1 do
  1547.       begin
  1548.          PSmallInt(pDst)^ := Smallint(PByte(pSrc)^-128) * 256;
  1549.          inc(pSrc);
  1550.          inc(pDst, 2);
  1551.          inc(dwTotalDst, 2);
  1552.       end;
  1553.    end;
  1555.    Result := dwTotalDst;
  1556. end;
  1558. {*************************************************************************}
  1559. {* only standard: Mono/Stereo PCM                                        *}
  1560. {*************************************************************************}
  1561. function pcmChannelAlign(nDstChannels: Word; pDst: PChar;
  1562.                          nSrcChannels: Word; pSrc: PChar;
  1563.                          nBitsPS: Word; dwSrcLen: Cardinal): Cardinal;
  1564. Var
  1565.    i: integer;
  1566.    dwNumSamples: Longint;
  1567.    dwTotalDst: Longint;
  1569. begin
  1570.    if (nSrcChannels = nDstChannels) then
  1571.    begin
  1572.       move(pSrc^, pDst^, dwSrcLen);
  1573.       Result := dwSrcLen;
  1574.       exit;
  1575.    end;
  1577.    dwNumSamples := dwSrcLen div (nBitsPS shr 3) div nSrcChannels;
  1578.    dwTotalDst := 0;
  1580.    if (nSrcChannels < nDstChannels) then     { convert from mono to stereo }
  1581.    begin
  1582.       if (nBitsPS = 8) then                                       { 8 bit }
  1583.       begin
  1584.  for i := 0 to dwNumSamples-1 do
  1585.  begin
  1586.     PByte(pDst)^ := PByte(pSrc)^;
  1587.             PByte(pDst+1)^ := PByte(pSrc)^;
  1588.             inc(pSrc);
  1589.             inc(pDst, 2);
  1590.             inc(dwTotalDst, 2);
  1591.          end;
  1592.       end
  1593.       else                                                       { 16 bit }
  1594.       begin
  1595.  for i := 0 to dwNumSamples-1 do
  1596.  begin
  1597.     PSmallInt(pDst)^ := PSmallInt(pSrc)^;
  1598.             PSmallInt(pDst+2)^ := PSmallInt(pSrc)^;
  1599.             inc(pSrc, 2);
  1600.             inc(pDst, 4);
  1601.             inc(dwTotalDst, 4);
  1602.          end;
  1603.       end;
  1604.    end
  1605.    else                                     { convert from stereo to mono }
  1606.    begin
  1607.       if (nBitsPS = 8) then                                       { 8 bit }
  1608.       begin
  1609.  for i := 0 to dwNumSamples-1 do
  1610.  begin
  1611.             { mix the two channels }
  1612.             PByte(pDst)^ := MinMax(Word(PByte(pSrc)^)+Word(PByte(pSrc+1)^),0, 255);
  1613.             inc(pSrc, 2);
  1614.             inc(pDst);
  1615.             inc(dwTotalDst);
  1616.          end;
  1617.       end
  1618.       else                                                       { 16 bit }
  1619.       begin
  1620.          for i := 0 to dwNumSamples-1 do
  1621.  begin
  1622.     PSmallInt(pDst)^ := MinMax(Longint(PSmallInt(pSrc)^) + Longint(PSmallInt(pSrc+2)^),-32765, 32765);
  1623.             inc(pSrc, 4);
  1624.             inc(pDst, 2);
  1625.             inc(dwTotalDst, 2);
  1626.          end;
  1627.       end;
  1628.    end;
  1630.    Result := dwTotalDst;
  1631. end;
  1633. (*************************************************************************)
  1634. (* this routine averages the 8 bit samples along the different channels  *)
  1635. (*************************************************************************)
  1636. procedure pcmAvgSample8(pDst, pSrc: PChar; nSkip, nChannels: Word);
  1637. Var
  1638.    lpB: PByte;
  1639.    sum, i,j: integer;
  1641. begin
  1642.      for i := 0 to nChannels-1 do
  1643.      begin
  1644.         lpB := PByte(pSrc);
  1645.         inc(pSrc);
  1646. sum := 0;
  1647. for j := 0 to nSkip-1 do
  1648.         begin
  1649.    sum := sum + (lpB^ - 128);
  1650.            inc(lpB, nChannels);
  1651.         end;
  1652.         PByte(pDst)^ := (sum div nSkip) + 128;
  1653.         inc(pDst);
  1654.      end;
  1655. end;
  1657. (*************************************************************************)
  1658. (* this routine averages the 16 bit samples along the different channels *)
  1659. (*************************************************************************)
  1660. procedure pcmAvgSample16(pDst, pSrc: PChar; nSkip, nChannels: Word);
  1661. Var
  1662.    lpW: PSmallInt;
  1663.    sum: Longint;
  1664.    i,j: integer;
  1666. begin
  1667.      for i := 0 to nChannels-1 do
  1668.      begin
  1669.         lpW := PSmallInt(pSrc);
  1670.         inc(PSmallInt(pSrc));
  1671. sum := 0;
  1672.         for j := 0 to nSkip-1 do
  1673.         begin
  1674.    sum := sum + lpW^;
  1675.    inc(lpW, nChannels);
  1676.         end;
  1677. PSmallInt(pDst)^ := sum div nSkip;
  1678.         inc(PSmallInt(pDst));
  1679.      end;
  1680. end;
  1682. (*************************************************************************)
  1683. (* this routine interpolates the 8 Bit samples along the diff. channels  *)
  1684. (*************************************************************************)
  1685. procedure pcmRepSample8(pDst, pSrc: PChar; nRep, nChannels: Word);
  1686. Var
  1687.    lpB: PByte;
  1688.    diff, val: integer;
  1689.    i, j: integer;
  1691. begin
  1692.      if (nRep > 1) then
  1693.      begin
  1694.         lpB := PByte(pDst);
  1695.         for i := 0 to nChannels-1 do
  1696.         begin
  1697.    PByte(pDst) := lpB;
  1698.            inc(lpB);
  1699.            diff := (PByte(pSrc+nChannels)^ - PByte(pSrc)^) div nRep;
  1700.            PByte(pDst)^ := pByte(pSrc)^;
  1701.    val := PByte(pSrc)^;
  1702.    inc(pDst, nChannels);
  1704.            {diff := 0; remove interpolation }
  1706.            for j := 1 to nRep-1 do
  1707.            begin
  1708.               inc(val, diff);
  1709.               PByte(pDst)^ := val;
  1710.               inc(pDst, nChannels);
  1711.            end;
  1713.    inc(pSrc);
  1714.         end;
  1715.      end;
  1716. end;
  1718. (*************************************************************************)
  1719. (* this routine interpolates the 8 Bit samples along the diff. channels  *)
  1720. (*************************************************************************)
  1721. procedure pcmRepSample16(pDst, pSrc: PChar; nRep, nChannels: Word);
  1722. Var
  1723.    lpW: PSmallInt;
  1724.    diff, val: integer;
  1725.    i, j: integer;
  1727. begin
  1728.      if (nRep > 1) then
  1729.      begin
  1730.         lpW := PSmallInt(pDst);
  1731.         for i := 0 to nChannels-1 do
  1732.         begin
  1733.            PSmallInt(pDst) := lpW;
  1734.            inc(lpW);
  1735.            diff := (PSmallInt(pSrc+2*nChannels)^ - PSmallInt(pSrc)^) div nRep;
  1736.            PSmallInt(pDst)^ := PSmallInt(pSrc)^;
  1737.            val := PSmallInt(pSrc)^;
  1738.    inc(PSmallInt(pDst), nChannels);
  1740.            { diff := 0; remove interpolation }
  1742.            for j := 1 to nRep-1 do
  1743.            begin
  1744.       inc(val,diff);
  1745.       PSmallInt(pDst)^ := val;
  1746.               inc(PSmallInt(pDst), nChannels);
  1747.            end;
  1749.            inc(PSmallInt(pSrc));
  1750.         end;
  1751.      end;
  1752. end;
  1754. {*************************************************************************}
  1755. {* only standard: 11025Khz, 22050Khz, 44100Khz PCM !!!                   *}
  1756. {*************************************************************************}
  1757. function pcmSamplesPerSecAlign(nDstSPS: Longint; pDst: PChar;
  1758.                                nSrcSPS: Longint; pSrc: PChar;
  1759.                                nBitsPS, nChannels: Word;
  1760.                                dwSrcLen: Cardinal): Cardinal;
  1761. Var
  1762.    i,j: integer;
  1763.    SampleSize: DWORD;
  1764.    nRep,nSkip: DWORD;
  1765.    dwNumSamples,dwNewNumSamples: DWORD;
  1766.    dwTotalDst: Longint;
  1767.    pTmp: PChar;
  1769. begin
  1770.    if (nSrcSPS = nDstSPS) then
  1771.    begin
  1772.       move(pSrc^, pDst^, dwSrcLen);
  1773.       Result := dwSrcLen;
  1774.       exit;
  1775.    end;
  1777.    SampleSize := (nBitsPS shr 3) * nChannels;
  1778.    dwNumSamples := dwSrcLen div SampleSize;
  1780.    nSkip := 0;
  1781.    nRep := 0;
  1782.    dwTotalDst := 0;
  1784.    if (nDstSPS > nSrcSPS) then
  1785.    begin      
  1786.       { then need to add in extra samples }
  1787.       nRep := nDstSPS div nSrcSPS;
  1788.       dwNewNumSamples := dwNumSamples * nRep;
  1789.    end
  1790.    else
  1791.    begin
  1792.       { replace the sample with the average of nSkip samples }
  1793.       nSkip :=  nSrcSPS div nDstSPS;
  1794.       dwNewNumSamples := dwNumSamples div DWORD(Max(nSkip,1));
  1795.    end;
  1797.    if (nRep > 0) then
  1798.    begin
  1799.       if nBitsPS = 8 then
  1800.       begin
  1801.          for i := 1 to dwNumSamples-1 do
  1802.          begin
  1803.     { this routine should interpolate the 8 Bit samples }
  1804.     pcmRepSample8(pDst, pSrc, nRep, nChannels);
  1805.     inc(pSrc, SampleSize);
  1806.             inc(pDst, nRep * SampleSize);
  1807.             inc(dwTotalDst, nRep * SampleSize);
  1808.          end;
  1809.       end
  1810.       else
  1811.       begin
  1812.          for i := 1 to dwNumSamples-1 do
  1813.          begin
  1814.     { this routine should interpolate the 16 Bit samples }
  1815.     pcmRepSample16(pDst, pSrc, nRep, nChannels);
  1816.     inc(pSrc, SampleSize);
  1817.             inc(pDst, nRep * SampleSize);
  1818.             inc(dwTotalDst, nRep * SampleSize);
  1819.          end;
  1820.       end;
  1822.       { up sample last sample without filtering }
  1823.       for i := 0 to nRep-1 do
  1824.       begin
  1825.          pTmp := pSrc;
  1826.          for j := 0 to SampleSize-1 do
  1827.          begin
  1828.             pDst^ := pTmp^;
  1829.             inc(pTmp);
  1830.             inc(pDst);
  1831.             inc(dwTotalDst);
  1832.          end;
  1833.       end;
  1834.    end
  1835.    else
  1836.    begin
  1837.       if nBitsPS = 8 then
  1838.       begin
  1839.          for i := 1 to dwNewNumSamples-1 do
  1840.          begin
  1841.             { this routine should average the 8 Bit samples }
  1842.     pcmAvgSample8(pDst, pSrc, nSkip, nChannels);
  1843.     inc(pSrc, nSkip * SampleSize);
  1844.     inc(pDst, SampleSize);
  1845.     inc(dwTotalDst, SampleSize);
  1846.          end;
  1847.       end
  1848.       else
  1849.       begin
  1850.          for i := 1 to dwNewNumSamples-1 do
  1851.          begin
  1852.             { this routine should average the 16 Bit samples }
  1853.     pcmAvgSample16(pDst, pSrc, nSkip, nChannels);
  1854.     inc(pSrc, nSkip * SampleSize);
  1855.     inc(pDst, SampleSize);
  1856.     inc(dwTotalDst, SampleSize);
  1857.          end;
  1858.       end;
  1860.       { just copy the last sample }
  1861.       for i := 0 to SampleSize-1 do
  1862.       begin
  1863.         pDst^:= pSrc^;
  1864.          inc(pSrc);
  1865.          inc(pDst);
  1866.          inc(dwTotalDst);
  1867.       end;
  1868.    end;
  1870.    Result := dwTotalDst;
  1871. end;
  1873. (*************************************************************************)
  1874. function pcmAllocMixPool(NumTracks: integer): PMMMixPool;
  1875. begin
  1876.    Result := GlobalAllocMem(sizeOf(TMMMixPool)+NumTracks*sizeOf(PChar));
  1877.    if Result = nil then OutOfMemoryError;
  1878. end;
  1880. {*************************************************************************}
  1881. function pcmMixIt(pwfx: PWaveFormatEx;
  1882.                   pDst: PChar; pTemp: PChar;
  1883.                   const pSrc: PMMMixPool; NumWaves: integer;
  1884.                   dwSrcLen: Longint): Boolean;
  1885. begin
  1886.    Result := False;
  1887.    if (pwfx = nil) or (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;
  1889.    if (pwfx^.wBitsPerSample = 8) then
  1890.    begin
  1891.       Result := pcmMixIt8(pDst,Pointer(pTemp),pSrc,NumWaves,dwSrcLen);
  1892.    end
  1893.    else
  1894.    begin
  1895.       Result := pcmMixIt16(pDst,Pointer(pTemp),pSrc,NumWaves,dwSrcLen);
  1896.    end;
  1897. end;
  1899. {*************************************************************************}
  1900. {$IFDEF WIN32}{$L MMMIX32.OBJ}{$ELSE}{$L MMMIX16.OBJ}{$ENDIF}
  1901. {$F+}
  1902. function pcmMixIt8(pDst: PChar; pTemp: PSmallint;
  1903.                    const pSrc: PMMMixPool; NumWaves: integer;
  1904.                    dwSrcLen: Longint): Boolean; external;
  1905. function pcmMixIt16(pDst: PChar; pTemp: PLongint;
  1906.                     const pSrc: PMMMixPool; NumWaves: integer;
  1907.                     dwSrcLen: Longint): Boolean; external;
  1908. {$F-}
  1910. {*************************************************************************}
  1911. {$IFDEF WIN32}{$L MMPITC32.OBJ}{$ELSE}{$L MMPITC16.OBJ}{$ENDIF}
  1912. {$F+}
  1913. function pcmPitchChange8M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  1914.                           Factor: Longint): Longint; external;
  1916. function pcmPitchChange8S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  1917.                           Factor: Longint): Longint; external;
  1919. function pcmPitchChange16M(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  1920.                            Factor: Longint): Longint; external;
  1922. function pcmPitchChange16S(pSrc,pDst: PChar; var SrcLen,DstLen,IncValue: Longint;
  1923.                            Factor: Longint): Longint; external;
  1924. {$F-}
  1926. end.