Media Share 9/MEDIASHARE_09.ISO/pascal/pslst100.zip/LIST.PAS

Pascal/Delphi Source File | 1993-01-01 | 5KB | 277 lines

{

                                                      ╔══════════════════╗
                                                      ║  List Control    ║
                                                      ║                  ║
                                                      ║    Rev. 1.00     ║
                                                      ╚══════════════════╝

}

{$F-} {$O-} {$A+} {$G-} {$R-}
{$V-} {$B-} {$X-} {$N+} {$E+}

{$I FINAL.PAS}

{$IFDEF FINAL}
  {$I-} {$S-}
  {$D-} {$L-}
{$ENDIF}

Unit List;

Interface

Type

  ListData    = Word;

  SorterType  = Function(FirstItem,SecondItem:ListData):Boolean;

  ListArray   = Array [1..1] of ListData;  {1..??, Range Checking is Off}

  ListArrayPtr= ^ListArray;

  ListObject  = Object

                  Data      :ListArrayPtr;
                  CurPtr    :Word;
                  MaxItems  :Word;
                  TotalItems:Word;

                  Procedure Init     (Resv:Word);
                  Procedure Get      (Var Item:ListData);
                  Procedure Put      (Item:ListData);
                  Procedure Insert   (Item:ListData);
                  Procedure Delete;
                  Procedure ShiftUp;
                  Procedure GotoNext;
                  Procedure GotoPrev;
                  Procedure GotoBegin;
                  Procedure GotoLast;
                  Procedure GotoEnd;
                  Procedure GotoItem (Here:Word);
                  Procedure Hop      (By  :LongInt);
                  Procedure SwapWith (This:Word);
                  Procedure ShellSort;
                  Function  CurPoint :Word;
                  Function  CurSize  :Word;
                  Function  AtBegin  :Boolean;
                  Function  AtLast   :Boolean;
                  Function  AtEnd    :Boolean;
                  Function  Empty    :Boolean;
                  Function  Full     :Boolean;
                  Procedure Done;

                End;

Var
  UserSort : SorterType;

Implementation

Procedure ListObject.Init(Resv:Word);
Begin
  GetMem(Data,Resv*SizeOf(ListData));
  FillChar(Data^,Resv*SizeOf(ListData),0);
  MaxItems   :=Resv;
  TotalItems :=0;
  CurPtr     :=1;
End;

Procedure ListObject.Get(Var Item:ListData);
Begin
  Item:=Data^[CurPtr];
End;

Procedure ListObject.Put(Item:ListData);
Begin
  Data^[CurPtr]:=Item;
  If TotalItems<CurPtr Then TotalItems:=CurPtr;
End;

Procedure ListObject.Insert(Item:ListData);
Begin
  ShiftUp;
  Put(Item);
End;

Procedure ListObject.Delete;

Var
  X:Word;

Begin
  Dec(TotalItems);
  For X:=CurPtr to TotalItems do
    Data^[X]:=Data^[X+1];
  If CurPtr>TotalItems Then CurPtr:=TotalItems;
  If CurPtr=0 Then CurPtr:=1;
End;

Procedure ListObject.ShiftUp;

Var
  X:Word;

Begin
  For X:=TotalItems DownTo CurPtr do
    Data^[X+1]:=Data^[X];
  Inc(TotalItems);
End;

Procedure ListObject.GotoNext;
Begin
  Inc(CurPtr);
End;

Procedure ListObject.GotoPrev;
Begin
  Dec(CurPtr);
End;

Procedure ListObject.GotoBegin;
Begin
  CurPtr:=1;
End;

Procedure ListObject.GotoLast;
Begin
  If TotalItems=0 Then
    CurPtr:=1
  Else
    CurPtr:=TotalItems;
End;

Procedure ListObject.GotoEnd;
Begin
  CurPtr:=TotalItems+1;
End;

Procedure ListObject.GotoItem(Here:Word);
Begin
  CurPtr:=Here;
End;

Procedure ListObject.Hop(By:LongInt);
Begin
  Inc(CurPtr,By);
End;

Procedure ListObject.SwapWith(This:Word);

Var
  Temp2,
  Temp1   :ListData;
  OldP    :Word;

Begin
  OldP:=CurPoint;
  Get(Temp1);
  GotoItem(This);
  Get(Temp2);
  Put(Temp1);
  GotoItem(OldP);
  Put(Temp2);
End;

Procedure ListObject.ShellSort;

Var
  OldPoint    :Word;
  i,j,k       :LongInt;
  DataB,
  DataA       :ListData;

Begin
  OldPoint:=CurPoint;
  k:=TotalItems Div 2;
  While k>0 do
  Begin
    For i:=k+1 to TotalItems do
    Begin
      j:=i-k;
      While j>0 do
      Begin
        GotoItem(j);
        Get(DataA);
        GotoItem(j+k);
        Get(DataB);
        If UserSort(DataA,DataB) Then
        Begin
          Put(DataA);
          GotoItem(j);
          Put(DataB);
          Dec(j,k);
        End
        Else
          j:=0;
      End;
    End;
    k:=k Div 2;
  End;
  GotoItem(OldPoint);
End;

Function ListObject.CurPoint:Word;
Begin
  CurPoint:=CurPtr;
End;

Function ListObject.CurSize:Word;
Begin
  CurSize:=TotalItems;
End;

Function ListObject.AtBegin:Boolean;
Begin
  If CurPtr=1 Then
    AtBegin:=True
  Else
    AtBegin:=False;
End;

Function ListObject.AtLast:Boolean;
Begin
  If CurPtr=TotalItems Then
    AtLast:=True
  Else
    AtLast:=False;
End;

Function ListObject.AtEnd:Boolean;
Begin
  If CurPtr>TotalItems Then
    AtEnd:=True
  Else
    AtEnd:=False;
End;

Function ListObject.Empty:Boolean;
Begin
  If TotalItems=0 Then
    Empty:=True
  Else
    Empty:=False;
End;

Function ListObject.Full:Boolean;
Begin
  If TotalItems=MaxItems Then
    Full:=True
  Else
    Full:=False;
End;

Procedure ListObject.Done;
Begin
  FreeMem(Data,MaxItems*SizeOf(ListData));
  MaxItems    :=0;
  TotalItems  :=0;
  CurPtr      :=0;
End;

End.

{ Copyright 1993, Michael Gallias }