ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PNL003.ZIP/TEXTLIST.PAS

Pascal/Delphi Source File | 1990-05-22 | 5.3 KB | 222 lines

Unit TextList;

{*****************************************************************************
 * This unit creates a basic list of text strings.  It uses TP 5.5's object  *
 * oriented features for program extensibility.                              *
 *****************************************************************************}

Interface

Const
   MaximumTextSize = 65;   {Set this to the maximum text string size}

Type

   TextString  = string[MaximumTextSize];

   TextPointer = ^TextRecord;

   TextRecord  = Record  {This is the main list record}
                    P ,                   {Pointer to previous record}
                    N : TextPointer;      {Pointer to next record    }
                    S : TextString;       {The text value            }
                 End;

   TextObject  = Object

                    {These are the Object's variables}
                    FirstRec,                {Pointer to top of list          }
                    LastRec ,                {Pointer to bottom of list       }
                    ThisRec : TextPointer;   {Pointer to current list item    }
                    EOFRec  ,          {TRUE if attempt to go below last item }
                    TOFRec  : boolean; {TRUE if attempt to go above first item}
                    NoRecs  ,            {Number of records in list           }
                    RecNo   : integer;   {Relative number of current list item}

                    {These are the Object's methods}
                    Procedure Init      ;
                    Procedure Done      ;
                    Procedure AddRec    (T : TextString);
                    Procedure DelRec    ;
                    Procedure ChgRec    (T : TextString);
                    Function  GetRec    : TextString;
                    Procedure TopRec    ;
                    Procedure BottomRec ;
                    Procedure UpRec     (I : word);
                    Procedure DownRec   (I : word);
                 End;

Implementation

Procedure TextObject.Init;
{Initialization routine.  Setup the list parameters.}
Begin
   FirstRec := Nil;
   LastRec  := Nil;
   ThisRec  := Nil;
   EOFRec   := True;
   TOFRec   := True;
   NoRecs   := 0;
   RecNo    := 0;
End;

Procedure TextObject.Done;
{Termination routine.  Deallocate the list and reset the parameters.}
Begin
   ThisRec := FirstRec;
   While ThisRec <> Nil Do
   Begin
      FirstRec := FirstRec^.N;
      Dispose(ThisRec);
      ThisRec := FirstRec;
   End;
   LastRec := Nil;
   EOFRec  := True;
   TOFRec  := True;
   NoRecs  := 0;
   RecNo   := 0;
End;

Procedure TextObject.AddRec (T : TextString);
{Add a new list item below the current item}
Var
   R : TextPointer;
Begin
   New(R);
   Inc(NoRecs);
   Inc(RecNo);
   EOFRec := False;
   TOFRec := False;
   R^.S := T;
   If FirstRec = Nil Then
   Begin
      FirstRec := R;
      R^.P     := Nil;
      R^.N     := Nil;
   End
   Else
   Begin
      R^.N       := ThisRec^.N;
      R^.P       := ThisRec;
      ThisRec^.N := R;
   End;
   If R^.N = Nil Then
      LastRec := R
   Else
      R^.N^.P := R;
   ThisRec := R;
End;

Procedure TextObject.DelRec;
{Delete the current list item}
Var
   R : TextPointer;
Begin
   If ThisRec <> Nil Then
   Begin
      R := ThisRec;
      ThisRec := R^.N;
      If R^.P = Nil Then
         FirstRec := R^.N
      Else
         R^.P^.N := R^.N;
      If R^.N = Nil Then
      Begin
         LastRec := R^.P;
         ThisRec := R^.P;
         EOFRec  := True;
         Dec(RecNo);
      End
      Else
         R^.N^.P := R^.P;
      Dispose(R);
      Dec(NoRecs);
   End;
End;

Procedure TextObject.ChgRec(T : TextString);
{Change the text value of the current list item}
Begin
   If ThisRec <> Nil Then
      ThisRec^.S := T;
End;

Function TextObject.GetRec : TextString;
{Return the text value of the current list item}
Begin
   If ThisRec <> Nil Then
      GetRec := ThisRec^.S
   Else
      GetRec := '<<EMPTY>>';
End;

Procedure TextObject.TopRec;
{Move to the top-most list item}
Begin
   ThisRec := FirstRec;
   If ThisRec <> Nil Then
   Begin
      EOFRec := False;
      TOFRec := False;
      RecNo  := 1;
   End
   Else {the list is empty}
   Begin
      EOFRec := True;
      TOFRec := True;
      RecNo  := 0;
   End;
End;

Procedure TextObject.BottomRec;
{Move to the bottom-most list item}
Begin
   ThisRec := LastRec;
   If ThisRec <> Nil Then
   Begin
      EOFRec := False;
      TOFRec := False;
      RecNo  := NoRecs;
   End
   Else {the list is empty}
   Begin
      RecNo  := 0;
      EOFRec := True;
      TOFRec := True;
   End;
End;

Procedure TextObject.UpRec (I : word);
{Move up the list 'I' items}
Var
   J : word;
Begin
   J := I;
   While (J > 0) and (ThisRec <> FirstRec) Do
   Begin
      ThisRec := ThisRec^.P;
      Dec(J);
      Dec(RecNo);
   End;
   TOFRec := J > 0;
   EOFRec := ThisRec = Nil;
End;

Procedure TextObject.DownRec (I : word);
{Move down the list 'I' items}
Var
   J : word;
Begin
   J := I;
   While (J > 0) and (ThisRec <> LastRec) Do
   Begin
      ThisRec := ThisRec^.N;
      Dec(J);
      Inc(RecNo);
   End;
   EOFRec := J > 0;
   TOFRec := ThisRec = Nil;
End;

Begin
End.