mmfade.pas

一套及时通讯的原码

            else
               H := Result;
            Result := (L + H) shr 1;
         end;
      end;
   end;
end;

{-- TMMFadeList --------------------------------------------------------}
{ FindPoint gibt genau den Index des Punktes zurueck, oder -1 }
function TMMFadeList.FindFadePoint(Offset: Longint): integer;
var
  i : integer;

begin
   Result := -1;
   i := LocateFadePoint(Offset);
   if (i > 0) and (i <= Count) then
   begin
      if Offset = Points[i-1]^.Offset then
      begin
         Result := i-1;
      end;
   end;
end;

{-- TMMFadeList --------------------------------------------------------}
function TMMFadeList.CalcFadeVolume(Offset: Longint): Longint;
var
   i: integer;
begin
   Result := 0;
   i := LocateFadePoint(Offset);
   if (i > 0) then
   begin
      i := Min(i,Count-1);
      if (i > 0) then
          if Points[i]^.Offset > Points[i-1]^.Offset then
             Result := Points[i-1]^.Volume +
                       MulDiv32(Points[i]^.Volume - Points[i-1]^.Volume,
                                Offset - Points[i-1]^.Offset,
                                Points[i]^.Offset - Points[i-1]^.Offset);
   end;
end;

{-- TMMFadeList --------------------------------------------------------}
procedure TMMFadeList.Sort;
var
   i,j,h: integer;
   p: TMMFadePoint;

begin          { Start Shell-Sort }
   h := 1;
   while h <= Count div 9 do h := h*3 + 1;
   while h > 0 do
   begin
      for i := h to Count-1 do
      begin
         p := Points[i]^;
         j := i;
         while ( j >= h ) and (Points[j-h]^.Offset > p.Offset) do
         begin
            Points[j]^ := Points[j-h]^;
            dec(j, h);
         end;
         Points[j]^ := p;
      end;
      h := h div 3;
   end;
end;

{*************************************************************************}
{$IFDEF USEASM}
{$IFDEF WIN32}{$L MMFADE32.OBJ}{$ELSE}{$L MMFADE16.OBJ}{$ENDIF}
{$F+}
function pcmFade8(nChannles: integer; lpData: PChar; dwSrcLen: Longint;
                  pFade: PMMFadeSeg): TMMFadePoint;
                  {$IFDEF WIN32}pascal;{$ENDIF}external;
function pcmFade16(nChannels: integer; lpData: PChar; dwSrcLen: Longint;
                   pFade: PMMFadeSeg): TMMFadePoint;
                  {$IFDEF WIN32}pascal;{$ENDIF}external;
{$F-}
{$ELSE}
(*************************************************************************)
function pcmFade8(nChannels: integer; lpData: PChar;
                  dwSrcLen: Longint; pFade: PMMFadeSeg): TMMFadePoint;
Label Loop,Next;
var
   ACC, M, R: Longint; { Hilfsvariablen           }
   Dir      : integer; { kann nur +1 oder -1 sein }
   DY,DX    : Longint;
   sVolume  : Longint;
   eVolume  : Longint;
   Count    : Longint;
   pB       : PByte;
   ch       : integer;

begin
   with pFade^ do
   begin
      pB      := Pointer(lpData);             { start with left channel }
      ch      := 1;
      sVolume := ptStart.VolumeL;
      eVolume := ptEnd.VolumeL;

Loop:
      { nichts zu tun ? }
      if (sVolume = VOLUMEBASE) and (eVolume = VOLUMEBASE) then
          goto next;

      Count := Min(ptEnd.Offset-ptStart.Offset,dwSrcLen)div (nChannels);
      if Count < 1 then
         goto Next;

      { silence ? }
      if (sVolume = 0) and (eVolume = 0) then
      begin
         while (Count > 0) do
         begin
            pB^ := 128;
            inc(pB,nChannels);
            dec(Count);
         end;
         goto Next;
      end;

      { Byte Abstand da Delta-T immer positiv da TB rechts ist }
      DX := (ptEnd.Offset-ptStart.Offset) div nChannels;
      { Fehler Accu wird auf 50% initialisiert }
      ACC := DX shr 1;

      DY := eVolume-sVolume;{ Volume-Diff }
      if DY < 0 then DY := -DY;

      M := DY div DX;                { Steigung abgrundet }
      R := DY mod DX;
      Dir := 1;                      { Vorgabe : Anstieg }
      if (eVolume < sVolume) then
      begin
         Dir := -Dir;                { Abstieg }
         M := -M;
      end;

      if (DY = 0) then
      begin                          { ebene Volumekurve }
         while Count > 0 do
         begin
            pB^ := pcmSampleClip8(((pB^-128) * sVolume) div VOLUMEBASE) + 128;
            inc(pB,nChannels);
            dec(Count);
         end;
      end
      else
      begin
         if (M <> 0) then            { grosse Steigung }
         begin
            while Count > 0 do
            begin
               pB^ := pcmSampleClip8(((pB^-128) * sVolume) div VOLUMEBASE) + 128;
               inc(pB,nChannels);

               Inc(sVolume,M);
               Dec(Acc,R);
               if Acc < 0 then
               begin
                  Inc(Acc, DX);
                  inc(sVolume,Dir);
               end;
               dec(Count);
            end;
         end
         else                        { flache Steigung }
         begin
            while Count > 0 do
            begin
               pB^ := pcmSampleClip8(((pB^-128) * sVolume) div VOLUMEBASE) + 128;
               inc(pB,nChannels);

               Dec(Acc,R);
               if Acc < 0 then
               begin
                  Inc(Acc, DX);
                  Inc(sVolume,Dir);
               end;
               dec(Count);
            end;
         end;
      end;

Next:
      if (ch = 1) then
      begin
         inc(ch);
         Result.VolumeL := sVolume;
         if (nChannels = 2) then
         begin
            { go to right channel }
            pB      := Pointer(lpData+sizeOf(Byte));
            sVolume := ptStart.VolumeR;
            eVolume := ptEnd.VolumeR;
            goto Loop;
         end;
      end
      else
      begin
         Result.VolumeR := sVolume;
      end;
   end;
end;

(*************************************************************************)
function pcmFade16(nChannels: integer; lpData: PChar;
                   dwSrcLen: Longint; pFade: PMMFadeSeg): TMMFadePoint;
Label Loop,Next;
var
   ACC, M, R: Longint; { Hilfsvariablen           }
   Dir      : integer; { kann nur +1 oder -1 sein }
   DY,DX    : Longint;
   sVolume  : Longint;
   eVolume  : Longint;
   Count    : Longint;
   pS       : PSmallint;
   ch       : integer;

begin
   with pFade^ do
   begin
      pS      := Pointer(lpData);             { start with left channel }
      ch      := 1;
      sVolume := ptStart.VolumeL;
      eVolume := ptEnd.VolumeL;

Loop:
      { nothing to do ? }
      if (sVolume = VOLUMEBASE) and (eVolume = VOLUMEBASE) then
          goto Next;

      Count := Min(ptEnd.Offset-ptStart.Offset,dwSrcLen)div (2*nChannels);
      if Count < 1 then
         goto Next;

      { silence ? }
      if (sVolume = 0) and (eVolume = 0) then
      begin
         while (Count > 0) do
         begin
            pS^ := 0;
            inc(pS,nChannels);
            dec(Count);
         end;
         goto Next;
      end;

      { Byte Abstand da Delta-T immer positiv da TB rechts ist }
      DX := (ptEnd.Offset-ptStart.Offset) div (2*nChannels);
      { Fehler Accu wird auf 50% initialisiert }
      ACC := DX shr 1;

      Dir := 1;                      { Vorgabe : Anstieg }

      DY := eVolume-sVolume;         { Volume-Diff }
      if DY < 0 then
      begin
         DY := -DY;
         Dir := -Dir;                { Abstieg }
      end;

      M := DY div DX;                { Steigung abgrundet }
      R := DY mod DX;
      if Dir < 0 then M := -M;

      if (DY = 0) then
      begin                          { ebene Volumekurve }
         while Count > 0 do
         begin
            pS^ := pcmSampleClip16((pS^ * sVolume) div VOLUMEBASE);
            inc(pS,nChannels);
            dec(Count);
         end;
      end
      else
      begin
         if (M <> 0) then            { grosse Steigung }
         begin
            while (Count > 0) do
            begin
               pS^ := pcmSampleClip16((pS^ * sVolume) div VOLUMEBASE);
               inc(pS,nChannels);

               sVolume := sVolume + M;
               Dec(Acc,R);
               if Acc < 0 then
               begin
                  Inc(Acc, DX);
                  sVolume := sVolume - 1;
               end;
               dec(Count);
            end;
         end
         else                        { flache Steigung }
         begin
            while Count > 0 do
            begin
               pS^ := pcmSampleClip16((pS^ * sVolume) div VOLUMEBASE);
               inc(pS,nChannels);

               Dec(Acc,R);
               if Acc < 0 then
               begin
                  Inc(Acc, DX);
                  sVolume := sVolume + Dir;
               end;
               dec(Count);
            end;
         end;
      end;

Next:
      if (ch = 1) then
      begin
         inc(ch);
         Result.VolumeL := sVolume;
         if (nChannels = 2) then
         begin
            { go to right channel }
            pS      := Pointer(lpData+sizeOf(Smallint));
            sVolume := ptStart.VolumeR;
            eVolume := ptEnd.VolumeR;
            goto Loop;
         end;
      end
      else
      begin
         Result.VolumeR := sVolume;
      end;
   end;
end;
{$ENDIF}

(*************************************************************************)
function pcmVolumeFade(pwfx: PWaveFormatEx; lpData: PChar;
                       dwSrcLen: TDataSize; FadeList: TMMFadeList): Boolean;
begin
   Result := False;

   if (pwfx = nil) or (pwfx^.wFormatTag <> WAVE_FORMAT_PCM) then exit;

   if (pwfx^.wBitsPerSample = 8) then
   begin
      Result := pcmVolumeFade8(pwfx, lpData, dwSrcLen, FadeList);
   end
   else
   begin
      Result := pcmVolumeFade16(pwfx, lpData, dwSrcLen, FadeList);
   end;
end;

(*************************************************************************)
function pcmVolumeFade8(pwfx: PWaveFormatEx; lpData: PChar;
                        dwSrcLen: TDataSize; FadeList: TMMFadeList): Boolean;
var
   Fade: TMMFadeSeg;
   p   : TMMFadePoint;
   nBytes: Longint;

begin
   Overflow := False;
   if (pwfx^.wFormatTag = 1) then
   with FadeList do
   begin
      CurIndex := Max(LocateFadePoint(StartOffset)-1,0);

      while (dwSrcLen > 0) and (CurIndex < Count) do
      with Points[CurIndex]^ do
      begin
         nBytes := Min(dwSrcLen,(Offset-StartOffset));
         if (nBytes > 0) then
         begin
            { start point }
            Fade.ptStart.Offset  := StartOffset;
            Fade.ptStart.VolumeL := StartVolumeL;
            Fade.ptStart.VolumeR := StartVolumeR;
            { end point }
            Fade.ptEnd.Offset    := Offset;
            Fade.ptEnd.VolumeL   := VolumeL;
            Fade.ptEnd.VolumeR   := VolumeR;

            p := pcmFade8(pwfx^.nChannels,lpData,nBytes,@Fade);
            StartVolumeL := p.VolumeL;
            StartVolumeR := p.VolumeR;

            {$IFDEF WIN32}
            inc(lpData,nBytes);
            {$ELSE}
            incHuge(lpData,nBytes);
            {$ENDIF}
            dec(dwSrcLen,nBytes);

            StartOffset := StartOffset + nBytes;
         end;
         { aktuall segment done ? }
         if StartOffset >= Offset then
            CurIndex := CurIndex+1;
      end;
   end;
   Result := Overflow;
end;

(*************************************************************************)
function pcmVolumeFade16(pwfx: PWaveFormatEx; lpData: PChar;
                         dwSrcLen: TDataSize; FadeList: TMMFadeList): Boolean;
var
   Fade: TMMFadeSeg;
   p   : TMMFadePoint;
   nBytes: Longint;

begin
   Overflow := False;
   if (pwfx^.wFormatTag = 1) then
   with FadeList do
   begin
      CurIndex := Max(LocateFadePoint(StartOffset)-1,0);

      while (dwSrcLen > 0) and (CurIndex < Count) do
      with Points[CurIndex]^ do
      begin
         nBytes := Min(dwSrcLen,(Offset-StartOffset));
         if (nBytes > 0) then
         begin
            { start point }
            Fade.ptStart.Offset  := StartOffset;
            Fade.ptStart.VolumeL := StartVolumeL;
            Fade.ptStart.VolumeR := StartVolumeR;
            { end point }
            Fade.ptEnd.Offset    := Offset;
            Fade.ptEnd.VolumeL   := VolumeL;
            Fade.ptEnd.VolumeR   := VolumeR;

            p := pcmFade16(pwfx^.nChannels,lpData,nBytes,@Fade);
            StartVolumeL := p.VolumeL;
            StartVolumeR := p.VolumeR;

            {$IFDEF WIN32}
            inc(lpData,nBytes);
            {$ELSE}
            incHuge(lpData,nBytes);
            {$ENDIF}
            dec(dwSrcLen,nBytes);

            StartOffset := StartOffset + nBytes;
         end;
         { aktuall segment done ? }
         if StartOffset >= Offset then
            CurIndex := CurIndex+1;
      end;
   end;
   Result := Overflow;
end;

end.