mmfx.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 - 13:22:36 $                                        =}
{========================================================================}
unit MMFX;

{$I COMPILER.INC}

interface

uses
    Windows,
    SysUtils,
    MMSystem,
    MMUtils,
    MMRegs,
    MMMulDiv,
    MMMath;

{========================================================================}
const
     { constants for the DataType fields }
     DT_8BIT   = $00;  { x0 b }
     DT_16BIT  = $01;  { x1 b }
     DT_MONO   = $00;  { 0x b }
     DT_STEREO = $02;  { 1x b }

     { constants for channels }
     CH_BOTH   = $00;
     CH_LEFT   = $01;
     CH_RIGHT  = $02;

function GetDataType(pwfx: PWaveFormatEx): integer;

{========================================================================}
const
    FT_NONE        = 0;
    FT_SOFTLOWPASS = 1;
    FT_LOWPASS     = 2;
                           
type
    PSimpleFilter = ^TSimpleFilter;
    TSimpleFilter = packed record
       FilterType: integer;       { FT_NON,FT_SOFTLOWPASS,FT_LOWPASS    }
       DataType  : integer;       { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       PrevValL  : SmallInt;      { internal, last sample left channel  }
       PrevValR  : SmallInt;      { internal, last sample right channel }
    end;

function  InitSimpleLowPass(pwfx: PWaveFormatEx): PSimpleFilter;
procedure DoneSimpleLowPass(var pf: PSimpleFilter);
procedure SetSimpleLowPass(pf: PSimpleFilter; FilterTyp: integer);
procedure DoSimpleLowPass(pf: PSimpleFilter; Buf: PChar; Len: Longint); pascal;

{========================================================================}
const
    MaxEchos = 8;
type
    PEcho = ^TEcho;
    TEcho = record
       Delay: Longint;            { delay (ms) for this echo line       }
       Gain : Longint;            { mix volume (%) for this echo        }
    end;

    PEchoArray = ^TEchoArray;
    TEchoArray = array[0..MaxEchos-1] of TEcho;

    PReverbParm = ^TReverbParm;   { Internal for the reverb engine      }
    TReverbParm = record
       Position : Longint;
       Gain     : Longint;
    end;

    PReverb = ^TReverb;
    TReverb = packed record
       InputGain   : Longint;     { Input Gain for the signal (%)       }
       InputPan    : Longint;     { Inp. Pan add 0..100 % to other chan.}
       OutputGain  : Longint;     { mix gain for the echos (%)          }
       OutputFilter: LongBool;    { enable/disable Low pass filter      }
       FeedBack    : Longint;     { Feedback value for reverb (%)       }
       DataType    : integer;     { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       SampleRate  : Longint;     { SampleRate for the samples          }
       Count       : integer;     { number of reverbs 0..8              }
       Reverbs     : array[0..MaxEchos-1] of TReverbParm;
       DLineL      : PSmallArray; { Left DelayLine                      }
       DLineR      : PSmallArray; { Right DelayLine                     }
       DLineSize   : Longint;     { max size for DelayLine              }
       DLinePos    : Longint;     { current write position in DelayLine }
       PrevValL    : Longint;     { internal, last sample left channel  }
       PrevValR    : Longint;     { internal, last sample right channel }
       MaxDelay    : integer;     { the maximal allowed delay (ms)      }
    end;

function  InitReverb(pwfx: PWaveFormatEx; MaxDelay: integer): PReverb;
procedure DoneReverb(var prvb: PReverb);
procedure SetReverb(prvb: PReverb; Filter: Boolean; InputGain, InputPan,
                    OutputGain, FeedBack, NumReverbs: integer;
                    NewReverbs: PEchoArray);
function DoReverb(prvb: PReverb; Buf: PChar; Len: Longint): Boolean; pascal;

{========================================================================}
type
    PDelay = ^TDelay;
    TDelay = packed record
       DataType    : integer;     { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       SampleRate  : Longint;     { SampleRate for the samples          }
       DLineL      : PSmallArray; { Left DelayLine                      }
       DLineR      : PSmallArray; { Right DelayLine                     }
       DLineSize   : Longint;     { max size for DelayLine              }
       DLinePos    : Longint;     { current write position in DelayLine }
       PositionL   : Longint;     { current read position in DelayLine  }
       PositionR   : Longint;     { current read position in DelayLine  }
       MaxDelay    : integer;     { the maximal allowed delay (ms)      }
    end;

function  InitDelay(pwfx: PWaveFormatEx; MaxDelay: integer): PDelay;
procedure DoneDelay(var pdel: PDelay);
procedure SetDelay(pdel: PDelay; DelayLeft, DelayRight: integer);
procedure DoDelay(pdel: PDelay; Buf: PChar; Len: Longint); pascal;

{========================================================================}
type
    PPhaser = ^TPhaser;
    TPhaser = packed record
       DataType    : integer;     { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       Channel     : integer;     { on which channel do the phase shift }
       SampleRate  : Longint;     { SampleRate for the samples          }
       Position    : Longint;     { current outp.position in DelayLine  }
       Delay       : integer;     { the current delay                   }
       DLine       : PSmallArray; { DelayLine                           }
       DLineSize   : Longint;     { max size for DelayLine              }
       DLinePos    : Longint;     { current inp. position in DelayLine  }
       MaxDelay    : integer;     { the maximal allowed delay (ms)      }
       Started     : LongBool;    { new phaser has started              }
       RealTime    : LongBool;    { do special things for realtime phase}
    end;

function  InitPhaser(pwfx: PWaveFormatEx; MaxDelay: integer; RealTime: Boolean): PPhaser;
procedure DonePhaser(var pph: PPhaser);
procedure SetPhaser(pph: PPhaser; iDelay: integer; iChannel: integer);
procedure DoPhaser(pph: PPhaser; Buf: PChar; Len: Longint); pascal;

{========================================================================}
type
    PPhaseShift = ^TPhaseShift;
    TPhaseShift = packed record
       DataType    : integer;     { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       SampleRate  : Longint;     { SampleRate for the samples          }
       FeedBack    : Longint;     { Feedback value for phaseshift (%)   }
       DryMix      : Longint;     { dry (unaffected) signal mix (%)     }
       WetMix      : Longint;     { wet (affected) signal mix (%)       }
       Sweep       : Float;       { base frequency of sweep             }
       Rate        : Float;       { rate of sweep in cycles per second  }
       Depth       : Float;       { sweep range in octaves              }
                                  { internal variables                  }
       wp,Min_wp,Max_wp,SweepFact: Float;
       inL1,outL1,inL2,outL2,inL3,outL3,inL4,outL4: Longint;
       inR1,outR1,inR2,outR2,inR3,outR3,inR4,outR4: Longint;
    end;

function  InitPhaseShift(pwfx: PWaveFormatEx): PPhaseShift;
procedure DonePhaseShift(var pps: PPhaseShift);
procedure SetPhaseShift(pps: PPhaseShift; iDry,iWet,iFeedBack: Longint;
                        iSweep,iDepth,iRate: Float);
function  DoPhaseShift(pps: PPhaseShift; Buf: PChar; Len: Longint): Boolean;

{========================================================================}
type
    PFlanger = ^TFlanger;
    TFlanger = packed record
       DataType    : integer;     { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       SampleRate  : Longint;     { SampleRate for the samples          }
       FeedBack    : Longint;     { Feedback value for phaseshift (%)   }
       DryMix      : Longint;     { dry (unaffected) signal mix (%)     }
       WetMix      : Longint;     { wet (affected) signal mix (%)       }
       Rate        : Float;       { rate of sweep in cycles per second  }
       Depth       : Float;       { sweep range in octaves              }
       Delay       : integer;     { the current delay (ms)              }
       DLineL      : PSmallArray; { Left DelayLine                      }
       DLineR      : PSmallArray; { Right DelayLine                     }
       DLineSize   : Longint;     { max size for DelayLine              }
       DLinePos    : Longint;     { current position in DelayLine       }
       MaxDelay    : integer;     { the maximal allowed delay (ms)      }
                                  { internal variables                  }
       ep1,ep2: integer;
       Sweep,MinSweep,MaxSweep,Step: Longint;
    end;

function  InitFlanger(pwfx: PWaveFormatEx; MaxDelay: integer): PFlanger;
procedure DoneFlanger(var pfc: PFlanger);
procedure SetFlanger(pfc: PFlanger; iDry,iWet,iFeedBack,
                     iDelay: Longint; iDepth, iRate: Float);
function  DoFlanger(pfc: PFlanger; Buf: PChar; Len: Longint): Boolean;

{========================================================================}
const
     MAX_XTAB = 512;      { crossfade lookup table size for pitch change }

type
    PFadeArray   = ^TFadeArray;
    TFadeArray   = array[0..MAX_XTAB-1] of Float;

    PPitchChange = ^TPitchChange;
    TPitchChange = packed record
       DataType    : integer;      { DT_8BIT,DT_16BIT,DT_MONO,DT_STEREO  }
       SampleRate  : Longint;      { SampleRate for the samples          }
       FeedBack    : Longint;      { Feedback value for phaseshift (%)   }
       DryMix      : Longint;      { dry (unaffected) signal mix (%)     }
       WetMix      : Longint;      { wet (affected) signal mix (%)       }
       Rate        : Float;        { rate of sweep in cycles per second  }
       Depth       : integer;      { sweep range in octaves              }
       Delay       : integer;      { the current delay (ms)              }
       DLineL      : PLongArray;   { Left DelayLine                      }
       DLineR      : PLongArray;   { Right DelayLine                     }
       DLineSize   : Longint;      { max size for DelayLine              }
       MaxDelay    : integer;      { the maximal allowed delay (ms)      }
                                   { internal variables                  }
       fp,ep1,ep2,ep3,ep4: integer;
       MinSweep,MaxSweep: integer;
       Step,XFade,XFadeCnt,Active,ActiveCnt: integer;
       BlendA,BlendB: Float;
       FadeA,FadeB: PFadeArray;
       Fade_Out,Fade_In: TFadeArray;
       Sweep: Longint;
       SweepUp,ChanA: Boolean;
    end;

function  InitPitchChange(pwfx: PWaveFormatEx; MaxDelay: integer): PPitchChange;
procedure DonePitchChange(var ppc: PPitchChange);
procedure SetPitchChange(ppc: PPitchChange; iDry,iWet,iFeedBack,
                         iDelay,iDepth: Longint; iRate: Float);
procedure DoPitchChange(ppc: PPitchChange; Buffer: PChar; Len: Longint); pascal;

implementation

{========================================================================}
function GetDataType(pwfx: PWaveFormatEx): Integer;
begin
   Result := -1;
   if (pwfx <> Nil) and (pwfx^.wFormatTag = WAVE_FORMAT_PCM) then
   begin
      Result := 0;
      if (pwfx^.wBitsPerSample = 16) then Result := Result or DT_16BIT;
      if (pwfx^.nChannels = 2) then Result := Result or DT_STEREO;
   end;
end;

{========================================================================}
{ -- Simple Low Pass --                                                  }
{========================================================================}
function InitSimpleLowPass(pwfx: PWaveFormatEx): PSimpleFilter;
begin
   Result := GlobalAllocMem(sizeOf(TSimpleFilter));
   if (Result <> nil) then
   with Result^ do
   begin
      FilterType:= FT_NONE;
      DataType  := GetDataType(pwfx);
      if (DataType and DT_16BIT = DT_16BIT) then
      begin
         PrevValL  := 0;
         PrevValR  := 0;
      end
      else
      begin
         PrevValL  := 128;
         PrevValR  := 128;
      end;
   end;
end;

{========================================================================}
procedure DoneSimpleLowPass(var pf: PSimpleFilter);
begin
   GlobalFreeMem(Pointer(pf));
end;

{========================================================================}
procedure SetSimpleLowPass(pf: PSimpleFilter; FilterTyp: integer);
begin
   if (pf <> nil) then
   with pf^ do
   begin
      FilterType:= FilterTyp;
      if (DataType and DT_16BIT = DT_16BIT) then
      begin
         PrevValL  := 0;
         PrevValR  := 0;
      end
      else
      begin
         PrevValL  := 128;
         PrevValR  := 128;
      end;
   end;
end;

{========================================================================}
{ Simple Low Pass Filter                                                 }
{                                                                        }
{ Algorithm: Type 1: y(n) := (x(n) + x(n-1))/2                           }
{            Type 2: y(n) := (x(n)*3 + x(n-1))/4                         }
{========================================================================}
{$IFDEF USEASM}
{$L MMSLOWL.OBJ}
{$F+}
procedure DoSimpleLowPass(pf: PSimpleFilter; Buf: PChar; Len: Longint); external;
{$F-}
{$ELSE}
procedure DoSimpleLowPass(pf: PSimpleFilter; Buf: PChar; Len: Longint);
var
   pW: PSmallInt;
   pB: PByte;

begin
   if (pf <> nil) then
   with pf^ do
   case FilterType of
        FT_SOFTLOWPASS:
        if (DataType and DT_STEREO = DT_STEREO) then  { Stereo }
        begin
           if (DataType and DT_16BIT = DT_16BIT) then { 16-bit }
           begin
              pW := PSmallInt(Buf);
              while (Len > 0) do
              begin
                 pW^ := (Longint(PrevValL)+pW^+pW^+pW^) shr 2;
                 PrevValL := pW^;
                 inc(pW);
                 pW^ := (Longint(PrevValR)+pW^+pW^+pW^) shr 2;
                 PrevValR := pW^;
                 inc(pW);
                 dec(Len,2*sizeOf(SmallInt));
              end;
           end
           else
           begin                                      { 8-bit }
              pB := PByte(Buf);
              while (Len > 0) do
              begin
                 pB^ := (PrevValL+pB^+pB^+pB^) shr 2;
                 PrevValL := pB^;
                 inc(pB);
                 pB^ := (PrevValR+pB^+pB^+pB^) shr 2;
                 PrevValR := pB^;
                 inc(pB);
                 dec(Len,2*sizeOf(Byte));
              end;
           end;
        end
        else                                          { Mono }
        begin
           if (DataType and DT_16BIT = DT_16BIT) then { 16-bit }
           begin
              pW := PSmallInt(Buf);
              while (Len > 0) do
              begin