home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
pascal
/
pslst100.zip
/
LIST.PAS
< prev
next >
Wrap
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 }