mmfx.pas

一套及时通讯的原码

                  tempval := -32767;
               end;

               DLineL^[DLinePos] := tempval;
               pB^ := (revval shr 8) + 128;
               inc(pB);
                                                      { 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;
               pB^ := (revval shr 8) + 128;
               inc(pB);

               DLinePos := (DLinePos+1) and mask;

               dec(Len,2*sizeOf(Byte));
            end;
         end;
      end
      else                                            { Mono reverb }
      begin
         if (dataType and DT_16BIT = DT_16BIT) then   { 16-bit Mono }
         begin
            Len := Len and $FFFE;
            pW := PSmallint(Buf);
            while (Len > 0) do
            begin
               outvalL := sar(pW^*InputGain,8);
               revval := 0;
               for t := 0 to Count-1 do
               begin
                  revval := revval + (reverbs[t].gain*DLineL^[reverbs[t].position]);
                  reverbs[t].position := (reverbs[t].position + 1) and mask;
               end;
               revval := sar(PrevValL+sar(revval,8),1);
               PrevValL := revval;
               tempval := outvalL+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^ := revval;
               inc(pW);

               DLinePos := (DLinePos+1) and mask;

               dec(Len,sizeOf(SmallInt));
            end;
         end
         else
         begin
            pB := PByte(Buf);                         { 8-bit Mono }
            while (Len > 0) do
            begin
               outvalL := sar(((pB^-128) shl 8)*InputGain,8);
               revval := 0;
               for t := 0 to Count-1 do
               begin
                  revval := revval + (reverbs[t].gain*DLineL^[reverbs[t].position]);
                  reverbs[t].position := (reverbs[t].position + 1) and mask;
               end;
               revval := sar(PrevValL+sar(revval,8),1);
               PrevValL := revval;
               tempval := outvalL+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;
               pB^ := (revval shr 8) + 128;
               inc(pB);

               DLinePos := (DLinePos+1) and mask;

               dec(Len,sizeOf(Byte));
            end;
         end;
      end;
   end;
end;
{$ENDIF}

{========================================================================}
{ -- Delay --                                                            }
{========================================================================}
function InitDelay(pwfx: PWaveFormatEx; MaxDelay: integer): PDelay;
var
   i: integer;

begin
   Result := GlobalAllocMem(SizeOf(TDelay));
   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;
         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
            DoneDelay(Result);
         end;
      end;
   end;
end;

{========================================================================}
procedure DoneDelay(var pdel: PDelay);
begin
   if (pdel <> nil) then
   begin
      GlobalFreeMem(Pointer(pdel^.DLineL));
      GlobalFreeMem(Pointer(pdel^.DLineR));
      GlobalFreeMem(Pointer(pdel));
   end;
end;

{========================================================================}
procedure SetDelay(pdel: PDelay; DelayLeft, DelayRight: integer);
begin
   if (pdel <> nil) then
   begin
      with pdel^ do
      begin
         { Check max delay for delay line }
         if (DelayLeft > MaxDelay) then
             DelayRight := MaxDelay;
         if (DelayRight > MaxDelay) then
             DelayRight := 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;

         PositionL := DLineSize-Max(Long(SampleRate)*DelayLeft div 1000,1);
         PositionR := DLineSize-Max(Long(SampleRate)*DelayRight div 1000,1);

         DLinePos := 0;
      end;
   end;
end;

{========================================================================}
{$IFDEF USEASM}
{$L MMDELL.OBJ}
{$F+}
var
   Delay: TDelay;

procedure DoDelay(pdel: PDelay; Buf: PChar; Len: Longint); external;
{$F-}
{$ELSE}
procedure DoDelay(pdel: PDelay; Buf: PChar; Len: Longint);
var
   mask: integer;
   pW: PSmallint;
   pB: PByte;

begin
   if (pdel <> nil) then
   with pdel^ 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 }
               DLineL^[DLinePos] := pW^;
               pW^ := DLineL^[PositionL];
               PositionL := (PositionL + 1) and mask;
               inc(pW);
                                                      { Process right }
               DLineR^[DLinePos] := pW^;
               pW^ := DLineR^[PositionR];
               PositionR := (PositionR + 1) and mask;
               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 }
               DLineL^[DLinePos] := (pB^-128) shl 8;
               pB^ := (DLineL^[PositionL] shr 8)+128;
               PositionL := (PositionL + 1) and mask;
               inc(pB);
                                                      { Process right }
               DLineR^[DLinePos] := (pB^-128) shl 8;
               pB^ := (DLineR^[PositionR] shr 8)+128;
               PositionR := (PositionR + 1) and mask;
               inc(pB);

               DLinePos := (DLinePos + 1) and mask;

               dec(Len,2*sizeOf(Byte));
            end;
         end;
      end
      else                                            { Mono reverb }
      begin
         if (dataType and DT_16BIT = DT_16BIT) then   { 16-bit Mono }
         begin
            Len := Len and $FFFE;
            pW := PSmallint(Buf);
            while (Len > 0) do
            begin
               DLineL^[DLinePos] := pW^;
               pW^ := DLineL^[PositionL];
               PositionL := (PositionL + 1) and mask;
               inc(pW);

               DLinePos := (DLinePos + 1) and mask;

               dec(Len,sizeOf(SmallInt));
            end;
         end
         else
         begin
            pB := PByte(Buf);                         { 8 -bit Mono }
            while (Len > 0) do
            begin
               DLineL^[DLinePos] := (pB^-128) shl 8;
               pB^ := (DLineL^[PositionL] shr 8)+128;
               PositionL := (PositionL + 1) and mask;
               inc(pB);

               DLinePos := (DLinePos + 1) and mask;

               dec(Len,sizeOf(Byte));
            end;
         end;
      end;
   end;
end;
{$ENDIF}

{========================================================================}
{ -- Phaser --                                                           }
{========================================================================}
function InitPhaser(pwfx: PWaveFormatEx; MaxDelay: integer; RealTime: Boolean): PPhaser;
var
   i: integer;

begin
   Result := GlobalAllocMem(SizeOf(TPhaser));
   if (Result <> nil) then
   begin
      {$IFNDEF USEASM}
      MaxDelay := Min(MaxDelay,500);
      {$ENDIF}
      Result^.MaxDelay := MaxDelay;
      Result^.RealTime := RealTime;
      with Result^ do
      begin
         DataType    := GetDataType(pwfx);
         Channel     := CH_BOTH;
         SampleRate  := pwfx^.nSamplesPerSec;
         Delay       := 0;
         Position    := 0;
         Started     := False;
         DLine       := nil;
         DLinePos    := -1;
                                            { Calculate delay line size }
         DLineSize := SampleRate*MaxDelay div 1000;
         i := 0;
         while DLineSize > 2048 do
         begin
            DLineSize := DLineSize shr 1;
            inc(i);