mmdelay.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: 15.08.98 - 14:20:44 $                                        =}
{========================================================================}
unit MMDelay;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Controls,
    MMSystem,
    MMRegs,
    MMObj,
    MMDSPObj,
    MMUtils,
    MMWaveIO,
    MMPCMSup,
    MMFX;


type
   EMMDelayError = class(Exception);

   {-- TMMDelay ---------------------------------------------------------}
   TMMDelay = class(TMMDSPComponent)
   private
      FEnabled       : Boolean;
      FOpen          : Boolean;
      FPDelay        : PDelay;
      FMaxDelay      : integer;
      FDelayLeft     : integer;
      FDelayRight    : integer;
      FCleanup       : Longint;

      procedure SetEnabled(aValue: Boolean);
      procedure SetDelays(index: integer; aValue: integer);

   protected
      procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
      procedure Update; virtual;
      procedure Opened; override;
      procedure Closed; override;
      procedure Started; override;
      procedure BufferReady(lpwh: PWaveHdr); override;
      procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

   public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      procedure Open;
      procedure Close;
      procedure Process(Buffer: PChar; Length: integer);
      function  CleanUp(Buffer: PChar; Length: integer): Longint;

   published
      property Input;
      property Output;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      property MaxDelay: integer index 0 read FMaxDelay write SetDelays default 250;
      property DelayLeft: integer index 1 read FDelayLeft write SetDelays default 1;
      property DelayRight: integer index 2 read FDelayRight write SetDelays default 1;
   end;

implementation

{== TMMDelay ============================================================}
constructor TMMDelay.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FEnabled    := True;
   FOpen       := False;

   FPDelay     := nil;
   FMaxDelay   := 250;
   FDelayLeft  := 1;
   FDelayRight := 1;
end;

{-- TMMDelay ------------------------------------------------------------}
destructor TMMDelay.Destroy;
begin
   Close;

   inherited Destroy;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      if FEnabled then Update;
   end;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.SetDelays(index: integer; aValue: integer);
begin
   case index of
      0: if (aValue = FMaxDelay) then exit else
         begin
            FMaxDelay := aValue;
         end;
      1: if (aValue = FDelayLeft) then exit else
         begin
            FDelayLeft := MinMax(aValue,1,FMaxDelay);
            Update;
         end;
      2: if (aValue = FDelayRight) then exit else
         begin
            FDelayRight := MinMax(aValue,1,FMaxDelay);
            Update;
         end;
   end;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMDelayError.Create(LoadResStr(IDS_INVALIDFORMAT));
   end;
   inherited SetPWaveFormat(aValue);
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Open;
begin
   if not FOpen then
   begin
      if pcmIsValidFormat(PWaveFormat) then
      begin
         FPDelay := InitDelay(PWaveFormat, FMaxDelay);
         if (FPDelay = nil) then OutOfMemoryError
         else
         begin
            FOpen := True;
            Update;
         end;
      end;
   end;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Close;
begin
   if FOpen then
   begin
      FOpen := False;
      DoneDelay(FPDelay);
   end;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Process(Buffer: PChar; Length: integer);
begin
   { process the buffer trough the delay line }
   if (FPDelay <> nil) then DoDelay(FPDelay, Buffer, Length);
end;

{-- TMMDelay ------------------------------------------------------------}
function TMMDelay.CleanUp(Buffer: PChar; Length: integer): Longint;
begin
   { process the remaining delayed bytes in the delay lines }
   if (FPDelay <> nil) and (FCleanup > 0) then
   begin
      FCleanup := Max(FCleanup - Length,0);
      FillChar(Buffer^, Length, 0);
      Process(Buffer, Length);
   end;
   { return the remaining bytes to process }
   Result := FCleanup;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Update;
begin
   { setup the delay lines with the params }
   if FOpen then
   begin
      FCleanup := 0;
      if (FDelayLeft > FCleanUp) then FCleanUp := FDelayLeft;
      if (FDelayRight > FCleanUp) then FCleanUp := FDelayRight;

      if (FCleanup > 0) then
      begin
         { convert cleanup time to bytes }
         FCleanup := wioTimeToBytes(PWaveFormat,FCleanup);
      end;
      { now update the delay lines }
      SetDelay(FPDelay, FDelayLeft, FDelayRight);
   end;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Opened;
begin
   Open;

   inherited Opened;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Closed;
begin
   Close;

   inherited Closed;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.Started;
begin
   Update;

   inherited Started;
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.BufferReady(lpwh: PWaveHdr);
begin
   if Enabled and FOpen then
   begin
      Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
   end;

   inherited BufferReady(lpwh);
end;

{-- TMMDelay ------------------------------------------------------------}
procedure TMMDelay.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
var
   aLength: Longint;
begin
   inherited BufferLoad(lpwh, MoreBuffers);

   if Enabled and FOpen then
   begin
      if not MoreBuffers then
      begin
         aLength := lpwh^.dwBufferLength;
         if Cleanup(lpwh^.lpData, aLength) > 0 then MoreBuffers := True;
         lpwh^.dwBytesRecorded := aLength;
      end
      else Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
   end;
end;

end.