mmcutlst.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/index.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: 21.10.98 - 02:09:50 $                                        =}
{========================================================================}
unit MMCutLst;

{$I COMPILER.INC}

interface

uses
    MMObj,
    MMUtils,
    Classes;

type
   PMMCutRegion = ^TMMCutRegion;
   TMMCutRegion = record
      dwStartPos     : Longint;  // startpos in samples
      dwStartPosBytes: Longint;  // startpos in bytes
      dwLength       : Longint;  // length in bytes
      dwLengthBytes  : Longint;  // length in bytes
      dwLoops        : Longint;  // number of loops (-1 = no loop, 0 = infinitive)
   end;                          // not implemented yet...

const
   { Maximum List size }
   MaxRgnListSize = Maxint div (sizeOf(TMMCutRegion));

type
   PMMCutArray = ^TMMCutArray;
   TMMCutArray = array[0..MaxRgnListSize-1] of TMMCutRegion;

   TMMCutList = class(TMMObject)
   private
     FList       : PMMCutArray;
     FCount      : Integer;
     FCapacity   : Integer;

  protected
    procedure Error; virtual;
    procedure Grow; virtual;
    function  Add(Region: TMMCutRegion): Integer;
    procedure Insert(Index: Integer; Region: TMMCutRegion);
    function  Get(Index: Integer): PMMCutRegion;
    procedure Put(Index: Integer; Region: PMMCutRegion);
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetCount(NewCount: Integer);

  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure  Clear; virtual;

    procedure  Assign(Source: TPersistent); override;

    function   AddRegion(Region: TMMCutRegion): Boolean;
    function   Remove(Region: PMMCutRegion): Integer;
    procedure  Delete(Index: Integer);
    function   IndexOf(Region: PMMCutRegion): Integer;

    function   LocateRegion(Offset: Longint): integer;
    function   FindRegion(Offset: Longint): integer;
    function   QueryRegion(Offset: Longint): Boolean;

    function   First: PMMCutRegion;
    function   Last: PMMCutRegion;
    function   Expand: TMMCutList;

    procedure  SetParams(Index: integer; StartPos, Length: Longint);

    property   Capacity: Integer read FCapacity write SetCapacity;
    property   Count: Integer read FCount write SetCount;
    property   Regions[Index: Integer]: PMMCutRegion read Get write Put; default;
    property   List: PMMCutArray read FList;
  end;

implementation

uses
    Consts
    {$IFDEF DELPHI6}
    ,RTLConsts
    {$ENDIF}
    ;

{------------------------------------------------------------------------}
function CompareRegions(Region1,Region2: PMMCutRegion): Boolean;
begin
   Result := (Region1^.dwStartPos = Region2^.dwStartPos) and
             (Region1^.dwLength   = Region2^.dwLength);
end;

{------------------------------------------------------------------------}
{$IFDEF DELPHI3}
procedure ListError(const Ident: string);
begin
   raise EListError.Create(Ident);
end;
{$ELSE}
procedure ListError(Ident: Word);
begin
   raise EListError.CreateRes(Ident);
end;
{$ENDIF}

{------------------------------------------------------------------------}
procedure ListIndexError;
begin
   ListError(SListIndexError);
end;

{== TMMCutList ========================================================}
constructor TMMCutList.Create;
begin
   inherited Create;

   FList := nil;
end;

{-- TMMCutList --------------------------------------------------------}
destructor TMMCutList.Destroy;
begin
   OnChange := nil;
   OnChanging := nil;

   Clear;

   inherited Destroy;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Error;
begin
   ListIndexError;
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.Add(Region: TMMCutRegion): Integer;
begin
   Changing;
   Result := FCount;
   if Result = FCapacity then Grow;
   FList^[Result] := Region;
   Inc(FCount);
   Changed;
end;

{-- TMMCutList --------------------------------------------------------}
{ AddRegion f黦t einen Punkt in die Liste ein }
function TMMCutList.AddRegion(Region: TMMCutRegion): Boolean;
var
  i: integer;

begin
   Result := False;

   if QueryRegion(Region.dwStartPos) then   { can we insert the region ?}
   begin
      i := LocateRegion(Region.dwStartPos);
      if (i < 0) or (i >= Count) then
         Add(Region)
      else
         Insert(i, Region);

      Result := True;
   end;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Clear;
begin
   Changing;
   SetCount(0);
   SetCapacity(0);
   Changed;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Delete(Index: Integer);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   Changing;
   Dec(FCount);
   if Index < FCount then
     System.Move(FList^[Index + 1], FList^[Index],
                 (FCount - Index) * SizeOf(TMMCutRegion));
   Changed;
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.Expand: TMMCutList;
begin
   if FCount = FCapacity then Grow;
   Result := Self;
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.First: PMMCutRegion;
begin
   Result := Get(0);
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.Get(Index: Integer): PMMCutRegion;
begin
   if (Index < 0) or (Index >= FCount) then Error;
   Result := @FList^[Index];
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Grow;
var
  Delta: Integer;
begin
   if FCapacity > 8 then
      Delta := 16
   else if FCapacity > 4 then
      Delta := 8
   else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.IndexOf(Region: PMMCutRegion): Integer;
begin
   Result := 0;
   while (Result < FCount) and not CompareRegions(@FList^[Result],Region) do Inc(Result);
   if Result = FCount then Result := -1;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Insert(Index: Integer; Region: TMMCutRegion);
begin
   if (Index < 0) or (Index > FCount) then Error;
   Changing;
   if FCount = FCapacity then Grow;
   if Index < FCount then
      System.Move(FList^[Index], FList^[Index + 1],
                 (FCount - Index) * SizeOf(TMMCutRegion));
   FList^[Index] := Region;
   Inc(FCount);
   Changed;
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.Last: PMMCutRegion;
begin
   Result := Get(FCount-1);
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Put(Index: Integer; Region: PMMCutRegion);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   Changing;
   FList^[Index] := Region^;
   Changed;
end;

{-- TMMCutList --------------------------------------------------------}
function TMMCutList.Remove(Region: PMMCutRegion): Integer;
begin
   Result := IndexOf(Region);
   if Result <> -1 then Delete(Result);
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.SetCapacity(NewCapacity: Integer);
begin
   if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then Error;

   if NewCapacity <> FCapacity then
   begin
     {$IFDEF WIN32}
     ReallocMem(FList, NewCapacity * SizeOf(TMMCutRegion));
     if NewCapacity = 0 then FList := nil;
     {$ELSE}
     if NewCapacity = 0 then
     begin
        GlobalFreePtr(FList);
        FList := nil;
     end
     else
     begin
        if FCapacity = 0 then
           FList := GlobalAllocPtr(HeapAllocFlags, NewCapacity*sizeOf(TMMCut))
        else
           FList := GlobalReallocPtr(FList, NewCapacity*sizeOf(TMMCut), HeapAllocFlags);
        if FList = nil then
           raise EStreamError.Create(LoadStr(SMemoryStreamError));
     end;
     {$ENDIF}
     FCapacity := NewCapacity;
   end;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.SetCount(NewCount: Integer);
begin
   if (NewCount < 0) or (NewCount > MaxListSize) then Error;

   if NewCount > FCapacity then SetCapacity(NewCount);
   if NewCount > FCount then
      FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(TMMCutRegion), 0);
   FCount := NewCount;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.SetParams(Index: integer; StartPos, Length: Longint);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   BeginUpdate;
   try
      Regions[Index]^.dwStartPos := StartPos;
      Regions[Index]^.dwLength   := Length;
   finally
      EndUpdate;
   end;
end;

{-- TMMCutList --------------------------------------------------------}
procedure TMMCutList.Assign(Source: TPersistent);
var
   i: integer;
   p: TMMCutRegion;

begin
   if (Source is TMMCutList) or (Source = nil) then
   begin
      if (Source <> Self) then
      begin
         BeginUpdate;
         try
            Clear;
            if (Source <> nil) then
            begin
               for i := 0 to TMMCutList(Source).Count-1 do
               begin
                  p := TMMCutList(Source).Regions[i]^;
                  Add(p);
               end;
            end;

         finally
            EndUpdate;
         end;
      end;
   end
   else inherited assign(Source);
end;

{-- TMMCutList --------------------------------------------------------}
{ LocateRegion gibt den Index der ersten Region, die rechts von Offset liegt,
  zurueck. Ist die Liste leer: -1 , gibt es kein rechtes Element mehr: Count(!) }
function TMMCutList.LocateRegion(Offset: Longint): integer;
var
   L, H : integer;

begin
   if (Count = 0) then
   begin
      Result := -1;
   end
   else
   begin
      if Regions[Count-1]^.dwStartPos <= Offset then
      begin
         Result := Count;
      end
      else
      begin
         L := 0;
         H := Count-1;
         Result := H shr 1;
         while L < H do
         begin
            if (Regions[Result]^.dwStartPos <= Offset) then
               L := Result+1
            else
               H := Result;
            Result := (L + H) shr 1;
         end;
      end;
   end;
end;

{-- TMMCutList --------------------------------------------------------}
{ QueryRegion returns true if a new Region is allowed at "Offset"         }
function TMMCutList.QueryRegion(Offset: Longint): Boolean;
begin
   Result := FindRegion(Offset) = -1;
end;

{-- TMMCutList --------------------------------------------------------}
{ FindRegion gibt genau den Index der Region zurueck, oder -1 }
function TMMCutList.FindRegion(Offset: Longint): integer;
var
  i : integer;
begin
   i := LocateRegion(Offset);
   if (i <= 0) or (i > Count) then
   begin
      Result := -1;
   end
   else if inMinMax(Offset,Regions[i-1].dwStartPos,Regions[i-1].dwStartPos+Regions[i-1].dwLength-1) then
   begin
      Result := i-1;
   end
   else
   begin
      Result := -1;
   end;
end;

end.