mmfx.pas

一套及时通讯的原码

                  SweepFact := Rate;         { sweep back up          }

               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
               { calc coef for current freq }
               coef := Trunc(8192*(1.0 - wp)/(1.0 + wp));

               inval := pW^ + sar(outL4 * Feedback,8);

               { do 1st filter }
               outL1 := sar(coef*(outL1 + inval),13) - inL1;
               inL1 := inval;

               { do 2nd filter }
               outL2 := sar(coef*(outL2 + outL1),13) - inL2;
               inL2 := outL1;

               { do 3rd filter }
               outL3 := sar(coef*(outL3 + outL2),13) - inL3;
               inL3 := outL2;

               { do 4th filter }
               outL4 := sar(coef*(outL4 + outL3),13) - inL4;
               inL4 := outL3;

               { develop final output mix }
               outval := sar(outL4*WetMix,8) + sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               wp := wp * SweepFact;         { adjust freq of filters }
               if (wp > Max_wp) then         { max?                   }
                  SweepFact := 1.0/Rate      { sweep back down        }
               else if (wp < Min_wp) then    { min?                   }
                  SweepFact := Rate;         { sweep back up          }

               inc(pW);
               dec(Len,sizeOf(SmallInt));
            end;
         end
         else
         begin
            pB := PByte(Buf);
            while Len > 0 do
            begin
               { calc coef for current freq }
               coef := Trunc(8192*(1.0 - wp)/(1.0 + wp));

               inval := (pB^-128)shl 8 + sar(outL4 * Feedback,8);

               { do 1st filter }
               outL1 := sar(coef*(outL1 + inval),13) - inL1;
               inL1 := inval;

               { do 2nd filter }
               outL2 := sar(coef*(outL2 + outL1),13) - inL2;
               inL2 := outL1;

               { do 3rd filter }
               outL3 := sar(coef*(outL3 + outL2),13) - inL3;
               inL3 := outL2;

               { do 4th filter }
               outL4 := sar(coef*(outL4 + outL3),13) - inL4;
               inL4 := outL3;

               { develop final output mix }
               outval := sar(outL4*WetMix,8) + sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               pB^ := (outval shr 8)+128;

               wp := wp * SweepFact;         { adjust freq of filters }
               if (wp > Max_wp) then         { max?                   }
                  SweepFact := 1.0/Rate      { sweep back down        }
               else if (wp < Min_wp) then    { min?                   }
                  SweepFact := Rate;         { sweep back up          }

               inc(pB);
               dec(Len,sizeOf(Byte));
            end;
         end;
      end;
   end;
end;

{========================================================================}
{ -- Flanger --                                                          }
{========================================================================}
function InitFlanger(pwfx: PWaveFormatEx; MaxDelay: integer): PFlanger;
var
   i: integer;

begin
   Result := GlobalAllocMem(SizeOf(TFlanger));
   if (Result <> nil) then
   begin
      {$IFNDEF USEASM}
      MaxDelay := Min(MaxDelay,500);
      {$ENDIF}
      Result^.MaxDelay := MaxDelay;
      with Result^ do
      begin
         DataType    := GetDataType(pwfx);
         SampleRate  := pwfx^.nSamplesPerSec;
         Delay       := 0;
         DLineL      := nil;
         DLineR      := nil;
         DLinePos    := 0;
                                            { Calculate delay line size }
         DLineSize := SampleRate*MaxDelay div 1000;
         i := 0;
         while DLineSize > 2048 do
         begin
            DLineSize := DLineSize shr 1;
            inc(i);
         end;
         DLineSize := 2048;
         while i > 0 do
         begin
            DLineSize := DLineSize shl 1;
            dec(i);
         end;

         DLineL := GlobalAllocMem(DLineSize*sizeOf(Smallint));
         if (DataType and DT_STEREO = DT_STEREO) then
             DLineR := GlobalAllocMem(DLineSize*sizeof(Smallint));

         if (DLineL = nil) or
            ((DLineR = nil) and (DataType and DT_STEREO = DT_STEREO)) then
         begin
            DoneFlanger(Result);
         end;
      end;
   end;
end;

{========================================================================}
procedure DoneFlanger(var pfc: PFlanger);
begin
   if (pfc <> nil) then
   begin
      GlobalFreeMem(Pointer(pfc^.DLineL));
      GlobalFreeMem(Pointer(pfc^.DLineR));
      GlobalFreeMem(Pointer(pfc));
   end;
end;

{========================================================================}
procedure SetFlanger(pfc: PFlanger; iDry,iWet,iFeedBack,
                     iDelay: Longint; iDepth, iRate: Float);
begin
   if (pfc <> nil) then
   begin
      with pfc^ do
      begin
         FeedBack:= iFeedBack * 256 div 100;
         DryMix  := iDry * 256 div 100;
         WetMix  := iWet * 256 div 100;
         Rate    := iRate;
         Depth   := iDepth;
         Step    := Trunc(iRate * 65.536);
         Delay   := iDelay;

         if (Delay > MaxDelay) then
             Delay := MaxDelay;

         if (DLineSize > 0) then
         begin
            FillChar(DLineL^,DLineSize*sizeOf(Smallint),0);        { Clear delay lines }
            if (DataType and DT_STEREO = DT_STEREO) then
               FillChar(DLineR^,DLineSize*sizeOf(Smallint),0);
         end;
         DLinePos := 0;
         ep1 := 0;
         ep2 := 0;
         { init/calc some stuff }
         MaxSweep := DLineSize - (SampleRate * Delay div 1000) - 2;
         MinSweep := Trunc(MaxSweep - Depth * SampleRate / 1000);
         if (MinSweep < 0) then MinSweep := 0;

         LongRec(Sweep).Hi := (MinSweep + MaxSweep) div 2;
         LongRec(Sweep).Lo := 0;
      end;
   end;
end;

{========================================================================}
function DoFlanger(pfc: PFlanger; Buf: PChar; Len: Longint): Boolean;
const
    ifac = 65536;
var
   pW: PSmallInt;
   pB: PByte;
   mask: integer;
   inval,outval: Longint;

begin
   Result := False;
   if (pfc <> nil) then
   with pfc^ do
   begin
      mask := DLineSize-1;
      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
               { interpolate from the 2 read values }
               outval := (DLineL^[ep1]*LongRec(Sweep).Lo+
                          DLineL^[ep2]*(ifac-LongRec(Sweep).Lo))div ifac;

               { store finished input plus feedback }
               inval := pW^ + sar(outval * Feedback,8);

               if (inval > 32767) then
               begin
                  inval  := 32767;
                  Result := True;
               end
               else if (inval < -32768) then
               begin
                  inval  := -32768;
                  Result := True;
               end;

               DLineL^[DLinePos] := inval;

               { develop final output mix }
               outval := sar(outval*WetMix,8) + sar(inval*DryMix,8);

               if (outval > 32767) then
               begin
                  outval := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  outval := -32768;
                  Result := True;
               end;

               pW^ := outval;
               inc(pW);

               { right channel }

               { interpolate from the 2 read values }
               outval := (DLineR^[ep1]*LongRec(Sweep).Lo+
                          DLineR^[ep2]*(ifac-LongRec(Sweep).Lo))div ifac;

               { store finished input plus feedback }
               inval := pW^ + sar(outval * Feedback,8);

               if (inval > 32767) then
               begin
                  inval  := 32767;
                  Result := True;
               end
               else if (inval < -32767) then
               begin
                  inval  := -32767;
                  Result := True;
               end;

               DLineR^[DLinePos] := inval;

               { develop final output mix }
               outval := sar(outval*WetMix,8) + sar(inval*DryMix,8);

               if (outval > 32767) then
               begin
                  outval := 32767;
                  Result := True;
               end
               else if (outval < -32767) then
               begin
                  outval := -32767;
                  Result := True;
               end;

               pW^ := outval;
               inc(pW);

               { update ptrs }
               DLinePos := (DLinePos + 1) and mask;
               sweep := sweep + step;
               ep1 := (DLinePos + LongRec(Sweep).Hi) and mask;
               ep2 := (ep1 - 1) and mask;

               { check for sweep reversal }
               if (LongRec(Sweep).Hi > MaxSweep) or   { see if we hit top of sweep   }
                  (LongRec(Sweep).Hi < MinSweep) then { or if we hit bottom of sweep }
                  Step := -Step;                      { reverse                      }

               dec(Len,2*sizeOf(SmallInt));
            end;
         end
         else                                       { 8 bit }
         begin
            pB := PByte(Buf);
            while (Len > 0) do
            begin
               { left channel }

               { interpolate from the 2 read values }
               outval := (DLineL^[ep1]*LongRec(Sweep).Lo+
                          DLineL^[ep2]*(ifac-LongRec(Sweep).Lo))div ifac;

               { store finished input plus feedback }
               inval := (pB^-128)shl 8 + sar(outval * Feedback,8);

               if (inval > 32767) then
               begin
                  inval  := 32767;
                  Result := True;
               end
               else if (inval < -32767) then
               begin
                  inval  := -32767;
                  Result := True;
               end;

               DLineL^[DLinePos] := inval;

               { develop final output mix }
               outval := sar(outval*WetMix,8) + sar(inval*DryMix,8);

               if (outval > 32767) then
               begin
                  outval := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  outval := -32768;
                  Result := True;
               end;

               pB^ := (out