mmfx.pas

一套及时通讯的原码

                 pW^ := (Longint(PrevValL)+pW^+pW^+pW^)shr 2;
                 PrevValL := pW^;
                 inc(pW);
                 dec(Len,sizeOf(SmallInt));
              end;
           end
           else                                       { 8-bit }
           begin
              pB := PByte(Buf);
              while (Len > 0) do
              begin
                 pB^ := (PrevValL+pB^+pB^+pB^) shr 2;
                 PrevValL := pB^;
                 inc(pB);
                 dec(Len,sizeOf(Byte));
              end;
           end;
        end;
        FT_LOWPASS:
        if (DataType and DT_STEREO = DT_STEREO) then  { Stereo }
        begin
           if (DataType and DT_16BIT = DT_16BIT) then { 16-bit }
           begin
              Len := (Len div 4) * 4;
              pW := PSmallInt(Buf);
              while Len > 0 do
              begin
                 pW^ := (Longint(PrevValL)+pW^) shr 1;
                 PrevValL := pW^;
                 inc(pW);
                 pW^ := (Longint(PrevValR)+pW^) shr 1;
                 PrevValR := pW^;
                 inc(pW);
                 dec(Len,2*sizeOf(SmallInt));
              end;
           end
           else                               { 8 bit }
           begin
              Len := Len and $FFFE;
              pB := PByte(Buf);
              while (Len > 0) do
              begin
                 pB^ := (PrevValL+pB^)shr 1;
                 PrevValL := pB^;
                 inc(pB);
                 pB^ := (PrevValR+pB^)shr 1;
                 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
              Len := Len and $FFFE;
              pW := PSmallInt(Buf);
              while (Len > 0) do
              begin
                 pW^ := (Longint(PrevValL)+pW^) shr 1;
                 PrevValL := pW^;
                 inc(pW);
                 dec(Len,sizeOf(SmallInt));
              end;
           end
           else
           begin                                      { 8-bit }
              pB := PByte(Buf);
              while (Len > 0) do
              begin
                 pB^ := (PrevValL+pB^) shr 1;
                 PrevValL := pB^;
                 inc(pB);
                 dec(Len,sizeOf(Byte));
              end;
           end;
        end;
   end;
end;
{$ENDIF}

{========================================================================}
{ -- Reverb --                                                           }
{========================================================================}
function InitReverb(pwfx: PWaveFormatEx; MaxDelay: integer): PReverb;
var
   i: integer;

begin
   Result := GlobalAllocMem(SizeOf(TReverb));
   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;
         Count       := 0;
         InputGain   := 100 * 256 div 100;
         InputPan    := 50 * 256 div 100;
         OutputGain  := 50 * 256 div 100;
         OutputFilter:= False;
         FeedBack    := 0;
         DLineL      := nil;
         DLineR      := nil;
         DLinePos    := 0;
         if (DataType and DT_16BIT = DT_16BIT) then
         begin
            PrevValL  := 0;
            PrevValR  := 0;
         end
         else
         begin
            PrevValL  := 128;
            PrevValR  := 128;
         end;
                                            { 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
            DoneReverb(Result);
         end;
      end;
   end;
end;

{========================================================================}
procedure DoneReverb(var prvb: PReverb);
begin
   if (prvb <> nil) then
   begin
      GlobalFreeMem(Pointer(prvb^.DLineL));
      GlobalFreeMem(Pointer(prvb^.DLineR));
      GlobalFreeMem(Pointer(prvb));
   end;
end;

{========================================================================}
procedure SetReverb(prvb: PReverb; Filter: Boolean; InputGain, InputPan,
                    Outputgain, FeedBack, NumReverbs: integer;
                    NewReverbs: PEchoArray);
var
   i: integer;

begin
   if (prvb <> nil) then
   begin
      with prvb^ do
      begin
         if (DataType and DT_16BIT = DT_16BIT) then
         begin
            PrevValL  := 0;
            PrevValR  := 0;
         end
         else
         begin
            PrevValL  := 128;
            PrevValR  := 128;
         end;

         if (NumReverbs > 8) or (NumReverbs < 0) then exit;

         for i := 0 to NumReverbs-1 do { Check max delay for delay line }
         begin
            if (NewReverbs^[i].Delay > MaxDelay) then
               NewReverbs^[i].Delay := MaxDelay;
         end;

         if (DLineSize > 0) then
         begin
            FillChar(DLineL^,2*DLineSize,0);        { Clear delay lines }
            if (DataType and DT_STEREO = DT_STEREO) then
               FillChar(DLineR^,2*DLineSize,0);
         end;

         for i := 0 to NumReverbs-1 do                 { Adjust reverbs }
         begin
            Reverbs[i].Position := DLineSize-Max(Long(SampleRate)*NewReverbs^[i].Delay div 1000,1);
            Reverbs[i].Gain := NewReverbs^[i].Gain * 256 div 100;
         end;
         Count := NumReverbs;
         DLinePos := 0;
      end;
      prvb^.InputGain:= InputGain * 256 div 100;
      prvb^.InputPan := InputPan * 256 div 100;
      prvb^.OutputGain := OutputGain * 256 div 100;
      prvb^.OutputFilter := Filter;
      prvb^.Feedback := Feedback * 256 div 100;
   end;
end;

{========================================================================}
{                                           FeedBack                     }
{       ______  +--------------------<---------------------------+       }
{  IN  | INP  | |                           Direct Signal  ___   |       }
{  --->| GAIN |-+-------------------->------------------->| + |  |       }
{      |______| |                                         |   |  | OUT   }
{               |                                         |   |--+--->   }
{      +--------+                                         | + |          }
{      |    _________     _________        ___            |___|          }
{      |   |         |   |         |  * a |   |    ______   |            }
{      +-->| Delay 1 |-->| Gain 1  |----->| + |   | OUT  |  |            }
{      |   |_________|   |_________|      |   |-->| GAIN |--+            }
{      |    _________     _________       |   |   |______|               }
{      |   |         |   |         |  * b |   |                          }
{      +-->| Delay 2 |-->| Gain 2  |----->| + |                          }
{      |   |_________|   |_________|      |   |                          }
{      |                                  |   |                          }
{      +--> ....                          |   |                          }
{========================================================================}
{$IFDEF USEASM}
{$L MMREVBL.OBJ}
{$F+}
var
   Reverb: TReverb;
   PrevvalOutL: Longint;
   PrevvalOutR: Longint;

function DoReverb(prvb: PReverb; Buf: PChar; Len: Longint): Boolean; external;
{$F-}
{$ELSE}
function DoReverb(prvb: PReverb; Buf: PChar; Len: Longint): Boolean;
var
   mask,t: integer;
   pW: PSmallint;
   pB: PByte;
   revval,outvalL,outvalR,tempval: Longint;

begin
   { returns true on internal overflow }
   Result := False;
   if (prvb <> nil) and (prvb^.Count > 0) then
   with prvb^ do
   begin
      mask := DLineSize-1;         { Mask to prevent delay line overflow }
      if (DataType and DT_STEREO = DT_STEREO) then    { stereo }
      begin
         if (DataType and DT_16BIT = DT_16BIT) then   { 16-bit }
         begin
            Len := Len div 4 * 4;
            pW := PSmallint(Buf);
            while (Len > 0) do
            begin                                     { Process left }
               outvalL := sar(pW^*InputGain,8);
               outvalR := sar(PSmallInt(PChar(pW)+sizeOf(SmallInt))^*InputGain,8);
               revval := 0;
               for t := 0 to Count-1 do
               begin
                  revval := revval + (Reverbs[t].Gain*DLineL^[Reverbs[t].Position]);
               end;
               revval := sar(PrevValL + sar(revval,8),1);
               PrevValL := revval;
               tempval := outvalL + sar(outvalR*InputPan,8) + sar(revval*Feedback,8);
               revval := outvalL + sar(revval*OutputGain,8);

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

               DLineL^[DLinePos] := tempval;
               pW^ := SmallInt(revval);
               inc(pW);
                                                      { Process right }
               revval := 0;
               for t := 0 to Count-1 do
               begin
                  revval := revval + (reverbs[t].gain*DLineR^[reverbs[t].Position]);
                  Reverbs[t].Position := (reverbs[t].Position + 1) and mask;
               end;
               revval := sar(PrevValR+sar(revval,8),1);
               PrevValR := revval;
               tempval := outvalR + sar(outvalL*InputPan,8) + sar(revval*Feedback,8);
               revval := outvalR + sar(revval*OutputGain,8);
               if (revval > 32767) then
               begin
                  Result := True;
                  revval := 32767
               end
               else if (revval < -32767) then
               begin
                  Result := True;
                  revval := -32767;
               end;
               if (tempval > 32767) then
               begin
                  Result := True;
                  tempval := 32767;
               end
               else if (tempval < -32767) then
               begin
                  Result := True;
                  tempval := -32767;
               end;
               DLineR^[DLinePos] := tempval;
               pW^ := revval;
               inc(pW);

               DLinePos := (DLinePos + 1) and mask;

               dec(Len,2*sizeOf(SmallInt));
            end;
         end
         else                                         { 8-bit stereo }
         begin
            Len := Len and $FFFE;
            pB := PByte(Buf);
            while (Len > 0) do
            begin                                     { Process left }
               outvalL := sar(((pB^-128) shl 8)*InputGain,8);
               outvalR := sar(((PByte(PChar(pB)+sizeOf(Byte))^-128)shl 8)*InputGain,8);
               revval := 0;
               for t := 0 to Count-1 do
               begin
                  revval := revval + (reverbs[t].gain*DLineL^[reverbs[t].position]);
               end;
               revval := sar(PrevValL+sar(revval,8),1);
               PrevValL := revval;
               tempval := outvalL+sar(outvalR*InputPan,8)+sar(revval*Feedback,8);
               revval := outvalL + sar(revval*OutputGain,8);

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