{               Copyright 1991 TechnoJock Software, Inc.               }
{                          All Rights Reserved                         }
{                         Restricted by License                        }

{                             Build # 1.00                             }

Unit totLIST;
{$I TOTFLAGS.INC}

{
 Development Notes:


}
INTERFACE

Uses DOS,
     totSYS, totLOOK, totFAST, totWIN, totINPUT, totLINK, totSTR, totIO1;

TYPE
tListAction = (Finish,Refresh,None);
ListCharFunc = function(var K:word; var X,Y: byte; HiPick:longint): tListAction;
ListMsgFunc = function(HiPick:longint):string;

pBrowseOBJ = ^BrowseOBJ;
BrowseOBJ = object
   vWin: StretchWinPtr;
   vTopPick: longint;         {number of first pick in window}
   vTotPicks: longint;        {total number of picks}
   vListVisible: boolean;     {is list on display}
   vListAssigned: boolean;    {is data assigned to list}
   vActivePick: integer;      {the offset of the active pick from the top}
   vRows: integer;            {total number of visible rows}
   vStartCol : longint;       {string position of first character}
   vEndCol: longint;          {rightmost column for scrolling}
   vRealColWidth: byte;       {max avail column width}
   vLastKey: word;            {last key the user pressed}
   {methods ...}
   constructor Init;
   procedure   SetTopPick(TopPick: longint);
   procedure   SetStartCol(Column: longint);
   procedure   SetEndCol(Column: longint);
   function    Win:StretchWinPtr;
   procedure   DisplayPick(Pick:integer);
   procedure   DisplayAllPicks;
   procedure   ScrollUp;
   procedure   ScrollDown;
   procedure   ScrollPgUp;
   procedure   ScrollPgDn;
   procedure   ScrollFirst;
   procedure   ScrollLast;
   procedure   SlideLeft;
   procedure   SlideRight;
   procedure   ScrollFarRight;
   procedure   ScrollFarLeft;
   procedure   ScrollJumpH(X,Y:byte);
   procedure   ScrollJumpV(X,Y:byte);
   function    LastKey: word;
   procedure   Remove;
   procedure   Show;
   procedure   ResetDimensions;
   procedure   Go;
   function    GetString(Pick, Start,Finish: longint):string;  VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {BrowseOBJ}

pBrowseArrayOBJ = ^BrowseArrayOBJ;
BrowseArrayOBJ = Object (BrowseOBJ)
   vArrayPtr: pointer;
   vStrLength: byte;
   {methods ...}
   constructor Init;
   procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {BrowseArrayOBJ}

pBrowseLinkOBJ = ^BrowseLinkOBJ;
BrowseLinkOBJ = Object (BrowseOBJ)
   vLinkList: ^DLLOBJ;
   {methods ...}
   constructor Init;
   procedure   AssignList(var LinkList: DLLOBJ);
   function    ListPtr: DLLPtr;
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   destructor  Done;    VIRTUAL;
end; {BrowseLinkOBJ}

pBrowseFileOBJ = ^BrowseFileOBJ;
BrowseFileOBJ = Object (BrowseOBJ)
   vStrList: ^StrDLLOBJ;
   {methods ...}
   constructor Init;
   function    AssignFile(Filename: string):integer;
   function    ListPtr: StrDLLPtr;
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   destructor  Done;    VIRTUAL;
end; {BrowseFileOBJ}

pListOBJ = ^ListOBJ;
ListOBJ = object
   vWin: StretchWinPtr;       {pointer to a window}
   vMargin: tByteCoords;      {padding around window border}
   vZone: tByteCoords;        {outer window dimensions}
   vTopPick: longint;         {number of first pick in window}
   vTotPicks: longint;        {total number of picks}
   vAllowToggle: boolean;     {can user select items in list}
   vListVisible: boolean;     {is list on display}
   vListAssigned: boolean;    {is data assigned to list}
   vLastChar: word;           {last key user pressed}
   vColWidth: byte;           {user set column width in list display: 0 = max}
   vNAttr: byte;              {normal attribute/color}
   vSAttr: byte;              {attribute for special items}
   vHAttr: byte;              {highlighted topic attribute/color}
   vActivePick: integer;      {the offset of the active pick from the top}
   vRows: integer;            {total number of visible rows}
   vCols: integer;            {Total number of visible columns}
   vRealColWidth: byte;       {max avail column width}
   vLastColWidth: byte;       {width of right most column}
   vUseLastCol: boolean;      {use the last column for highlighting or too narrow}
   vLastKey: word;            {last key the user pressed}
   vCharHook: ListCharFunc;   {character hook}
   vMsgHook: ListMsgFunc;     {message hook}
   vMsgActive: boolean;       {is Msg hook enabled}
   vDualColors: boolean;      {should list use SAttr and NAttr}
   {methods ...}
   constructor Init;
   procedure   SetTopPick(TopPick: longint);
   procedure   SetActivePick(ThePick: LongInt);
   procedure   SetTagging(On:boolean);
   procedure   SetColors(HAttr,NAttr,SAttr: byte);
   procedure   SetColWidth(Wid: byte);
   procedure   SetCharHook(Func:ListCharFunc);
   procedure   SetMsgHook(Func:ListMsgFunc);
   procedure   SetMsgState(On:boolean);
   procedure   SetDualColors(On:Boolean);
   function    GetHiString:string;
   function    Win:StretchWinPtr;
   procedure   ResetDimensions;
   procedure   DisplayPick(Pick:integer; Hi:boolean);
   procedure   DisplayAllPicks;
   procedure   RefreshList;
   procedure   Remove;
   procedure   ValidateActivePick;
   procedure   ScrollUp;
   procedure   ScrollDown;
   procedure   JumpEngine(Tot, NewValue: longint);
   procedure   ScrollJumpV(X,Y:byte);
   procedure   ScrollJumpH(X,Y:byte);
   procedure   ScrollLeft;
   procedure   ScrollFarLeft;
   procedure   ScrollRight;
   procedure   ScrollFarRight;
   procedure   ScrollPgDn;
   procedure   ScrollPgUp;
   procedure   ScrollFirst;
   procedure   ScrollLast;
   procedure   ToggleSelect;
   function    TargetPick(X,Y:byte): Integer;
   procedure   MouseChoose(KeyX,KeyY:byte);
   function    LastKey: word;
   procedure   Go;
   procedure   Show;
   function    CharTask(var K:word; var X,Y: byte; 
                        HiPick:longint): tListAction;          VIRTUAL;
   function    MessageTask(HiPick:longint):string;             VIRTUAL;
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
   procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
   procedure   TagAll(On:boolean);                             VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {ListOBJ}

pListArrayOBJ = ^ListArrayOBJ;
ListArrayOBJ = object (ListOBJ)
   vArrayPtr: pointer;
   vStrLength: byte;
   vLinkList: ^DLLOBJ;
   {methods ...}
   constructor Init;
   procedure  AssignList(var StrArray; Total:Longint; StrLength:byte;Selectable: boolean);
   procedure  SetTagging(On:boolean);
   function   GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   function   GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
   procedure  SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
   procedure  TagAll(On:boolean);                             VIRTUAL;
   destructor Done;                                           VIRTUAL;
end; {of object ListArrayOBJ}

pListLinkOBJ = ^ListLinkOBJ;
ListLinkOBJ = object (ListOBJ)
   vLinkList: ^DLLOBJ;
   {methods ...}
   constructor Init;
   procedure   AssignList(var LinkList: DLLOBJ);
   function    ListPtr: DLLPtr;
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
   procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
   procedure   TagAll(On:boolean);                             VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {ListLinkOBJ}

pListDirOBJ = ^ListDirOBJ;
ListDirOBJ = object (ListOBJ)
   vFileList: ^FileDLLOBJ;
   vActiveDir: PathStr;
   {methods ...}
   constructor Init;
   procedure   ReadFiles(FileMasks:string; FileAttrib: word);
   function    GetHiString: string;
   procedure   Go;
   function    FileList:FileDLLPtr;
   function    CharTask(var K:word; var X,Y: byte;
                        HiPick:longint): tListAction;          VIRTUAL;
   function    MessageTask(Hi:longint): string;                VIRTUAL;
   function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
   function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
   procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
   procedure   TagAll(On:boolean);                             VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {ListDirOBJ}

pListDirSortOBJ = ^ListDirSortOBJ;
ListDirSortOBJ = object (ListDirOBJ)
   constructor Init;
   function    PromptAndSort: boolean;
   function    CharTask(var K:word; var X,Y: byte;
                        HiPick:longint): tListAction;          VIRTUAL;
   destructor  Done;                                           VIRTUAL;
end; {ListDirSortOBJ}
procedure ListInit;

IMPLEMENTATION
{|||||||||||||||||||||||||||||||||||||||||||||}
{                                             }
{     M i s c.  P r o c s   &   F u n c s     }
{                                             }
{|||||||||||||||||||||||||||||||||||||||||||||}
{$F+}
function NoCharHook(var K:word; var X,Y: byte; HiPick:longint): tListAction;
{}
begin
   NoCharHook := None;
end; {NoCharHook}

function NoMsgHook(HiPick:longint):string;
{}
begin
   NoMsgHook := '';
end; {NoEnterHook}
{$IFNDEF OVERLAY}
   {$F-}
{$ENDIF}

procedure Error(Err:byte);
{routine to display error}
const
   Header = 'totLIST error: ';
var
   Msg : string;
begin
   Case Err of
   1: Msg := 'A list Must be assigned before calling SHOW or GO';
   else  Msg := 'Unknown Error';
   end; {case}
   Writeln(Header,Msg);
{Maybe Add non-fatal compiler directive}
   halt;
end; {Error}
{||||||||||||||||||||||||||||||||||||||||||}
{                                          }
{    B r o w s e O B J   M E T H O D S     }
{                                          }
{||||||||||||||||||||||||||||||||||||||||||}
constructor BrowseOBJ.Init;
{}
begin
   new(vWin,Init);
   vWin^.SetScrollable(true,true);
   vTopPick := 1;
   vTotPicks := 1;
   vListAssigned := false;
   vListVisible := false;
   vStartCol := 1;
   vEndCol := 80;
   vActivePick := 1;
   vRows := 0;
end; {BrowseOBJ.Init}

function BrowseOBJ.Win:StretchWinPtr;
{}
begin
   Win := vWin;
end; {BrowseOBJ.Win}

procedure BrowseOBJ.SetTopPick(TopPick: longint);
{}
begin
   vTopPick := TopPick;
end; {BrowseOBJ.SetTopElement}

procedure BrowseOBJ.SetStartCol(Column: longint);
{}
begin
   vStartCol := Column;
end; {BrowseOBJ.SetStartCol}

procedure BrowseOBJ.SetEndCol(Column: longint);
{}
begin
   if (Column > vStartCol) or (Column = 0) then
      vEndCol := Column
   else
      vEndCol := vStartCol;
end; {BrowseOBJ.SetEndCol}

function BrowseOBJ.GetString(Pick, Start,Finish: longint):string;
{abstract}
begin end;

procedure BrowseOBJ.DisplayPick(Pick:integer);
{}
var
  PickStr: string;
begin
   if pred(vTopPick + Pick) <= vTotPicks then
      PickStr := GetString(pred(vTopPick + Pick),vStartCol,pred(vStartCol)+vRealColWidth)
   else
      PickStr := '';
   PickStr := padleft(PickStr,vRealColWidth,' ');
   Screen.WritePlain(1,Pick,PickStr);
end; {BrowseOBJ.DisplayPick}

procedure BrowseOBJ.DisplayAllPicks;
{}
var I : integer;
begin
   for I := 1 to vRows do
       DisplayPick(I);
end; {BrowseOBJ.DisplayAllPicks}

procedure BrowseOBJ.ScrollUp;
{}
begin
  if vTopPick > 1 then
  begin
     dec(vTopPick);
     DisplayAllPicks;
  end;
end; {BrowseOBJ.ScrollUp}

procedure BrowseOBJ.ScrollDown;
{}
begin
   if vTopPick < vTotPicks then
   begin
      inc(vTopPick);
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollDown}

procedure BrowseOBJ.SlideLeft;
{}
begin
   if vStartCol > 1 then
   begin
      dec(vStartCol);
      DisplayAllPicks;
   end;                      
end; {BrowseOBJ.SlideLeft}

procedure BrowseOBJ.SlideRight;
{}
begin
   if (vEndCol = 0) or (vStartCol < vEndCol) then
   begin
      inc(vStartCol);
      DisplayAllPicks;
   end;
end; {BrowseOBJ.SlideRight}

procedure BrowseOBJ.ScrollPgUp;
{}
begin
   if vTopPick > 1 then
   begin
      dec(vTopPick,vRows);
      if vTopPick < 1 then
         vTopPick := 1;
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollPgUp}

procedure BrowseOBJ.ScrollPgDn;
{}
begin
   if pred(vTopPick + vRows) < vTotPicks then
   begin
      inc(vTopPick,vRows);
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollPgDn}

procedure BrowseOBJ.ScrollFarRight;
{}
var EndCol: longint;
begin
   if (vEndCol = 0) then
      EndCol := 255
   else
      EndCol := vEndCol;
   if (vStartCol < EndCol - pred(vRealColWidth)) then
   begin
      vStartCol := EndCol - pred(vRealColWidth);
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollFarRight}

procedure BrowseOBJ.ScrollFarLeft;
{}
begin
   if vStartCol > 1 then
   begin
      vStartCol := 1;
      DisplayAllPicks;
   end; 
end; {BrowseOBJ.ScrollFarLeft}

procedure BrowseOBJ.ScrollLast;
{}
begin
   if pred(vTopPick) + vRows <> vTotPicks then
   begin
      vTopPick := succ(vTotPicks) - vRows;
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollLast}

procedure BrowseOBJ.ScrollFirst;
{}
begin
   if vTopPick <> 1 then
   begin
      vTopPick := 1;
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollFirst}

procedure BrowseOBJ.ScrollJumpH(X,Y:byte);
{}
var NewStart: longint;
begin
   if X = 1 then
      NewStart := 1
   else if X=Y then
      NewStart := vEndCol
   else
      NewStart := (X * vEndCol) div Y;
   if NewStart <> vStartCol then
   begin
      vStartCol := NewStart;
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollJumpH}

procedure BrowseOBJ.ScrollJumpV(X,Y:byte);
{}
var NewTop: longint;
begin
   if X = 1 then
      NewTop := 1
   else if X=Y then
      NewTop := vTotPicks
   else
      NewTop := (X * vTotPicks) div Y;
   if NewTop <> vTopPick then
   begin
      vTopPick := NewTop;
      DisplayAllPicks;
   end;
end; {BrowseOBJ.ScrollJumpV}

procedure BrowseOBJ.Go;
{}
var
   Finished: boolean;
   Mvisible: boolean;
   K: word;
   X,Y :byte;
   CX,CY,CT,CB:byte;
begin
   Mvisible := Mouse.Visible;
   if Monitor^.ColorOn then
      with Screen do
      begin
         CursSave;
         CX := WhereX;
         CY := WhereY;
         CT := CursTop;
         CB := CursBot;
         CursOff;
      end;
   Show;
   Finished := false;
   repeat
      vWin^.DrawHorizBar(vStartCol,vEndCol);
      vWin^.DrawVertBar(vTopPick,vTotPicks);
      K := Key.GetKey;
      X := Key.LastX;
      Y := Key.LastY;
      vWin^.Winkey(K,X,Y);
      if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
         Finished := true
      else
         case K of
         600: Finished := true; {window close}
         602: begin
            ResetDimensions;
            DisplayAllPicks; {window stretched}
            end;
         610,328: ScrollUp;
         611,336: ScrollDown;
         612,331: SlideLeft;
         613,333: SlideRight;
         337: ScrollPgDn;
         329: ScrollPgUp;
         335: ScrollFarRight;
         327: ScrollFarLeft;
         388: ScrollFirst;
         374: ScrollLast;
         614: ScrollJumpV(X,Y);
         615: ScrollJumpH(X,Y);
         end; {case}
   until Finished;
   vLastKey := K;
   if Mvisible then
      Mouse.Show
   else
      Mouse.Hide;
   if Monitor^.ColorOn then
      with Screen do
      begin
         GotoXY(CX,CY);
         CursSize(CT,CB);
      end;
end; {BrowseOBJ.Go}

procedure BrowseOBJ.Remove;
{}
begin
   vWin^.Remove;
end; {BrowseOBJ.Remove}

function BrowseOBJ.LastKey:word;
{}
begin
   LastKey := vLastKey;
end; {BrowseOBJ.LastKey}

procedure BrowseOBJ.ReSetDimensions;
{}
var S: byte;
begin
   with vWin^ do
   begin
      S := GetStyle;
      case S of
      0: vRows := succ(vBorder.Y2 - vBorder.Y1);
      6: vRows := vBorder.Y2 - vBorder.Y1 - 3;
      else vRows := pred(vBorder.Y2 - vBorder.Y1)
      end; {case}
      if S in[0,6] then
         vRealColWidth := succ(vBorder.X2 - vBorder.X1)
      else
         vRealColWidth := pred(vBorder.X2 - vBorder.X1);
   end; {with}
end; {Browse.ResetDimensions}

procedure BrowseOBJ.Show;
{}
begin
   if vListAssigned = false then
      Error(1)
   else
   begin
      if not vListVisible then
      begin
         vWin^.Draw;
         ResetDimensions;
         DisplayAllPicks;
         vListVisible := true
      end;
   end;
end; {BrowseOBJ.Show}

destructor BrowseOBJ.Done;
{}
begin
   dispose(vWin,Done);
end; {BrowseOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                     }
{    B r o w s e A r r a y O B J    M E T H O D S     }
{                                                     }
{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor BrowseArrayOBJ.Init;
{}
begin
   BrowseObj.Init;
end; {BrowseArrayOBJ.Init}

procedure BrowseArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
{}
var
  L : Longint;
  Dummy: byte;
  Result : integer;
begin
   vArrayPtr := @StrArray;
   vStrLength := StrLength;
   vTotPicks := Total;
   vListAssigned := true;
   vEndCol := StrLength;
end; {BrowseArrayOBJ.AssignList}

function BrowseArrayOBJ.GetString(Pick, Start,Finish: longint):string;
{}
var
  W : word;
  TempStr : String;
  ArrayOffset: word;
begin
   {move array string to Temp}
   W := pred(Pick) * succ(vStrLength);
   ArrayOffset := Ofs(vArrayPtr^) + W;
   Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
   Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
   if Start < 0 then Start := 0;
   if Finish < 0 then Finish := 0;
   {validate Start and Finish Parameters}
   if ((Finish = 0) and (Start = 0))
   or (Start > Finish) then   {get full string}
   begin
      Start := 1;
      Finish := 255;
   end
   else if Finish - Start > 254 then      {too long to fit in string}
      Finish := Start + 254;
   if Finish > vStrLength then
      Finish := vStrLength;
   if (Start > vStrLength) then
      GetString := ''
   else
   begin
      GetString := copy(TempStr,Start,succ(Finish - Start));
   end;
end; {BrowseArrayOBJ.GetString}

destructor BrowseArrayOBJ.Done;
{}
begin
   BrowseObj.Done;
end; {BrowseArrayOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                   }
{    B r o w s e L i n k O B J    M E T H O D S     }
{                                                   }
{|||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor BrowseLinkOBJ.Init;
{}
begin
   BrowseObj.Init;
   vLinkList := nil;
end; {BrowseLinkOBJ.Init}

procedure BrowseLinkOBJ.AssignList(var LinkList: DLLOBJ);
{}
begin
   vLinkList := @LinkList;
   vTotPicks := LinkList.TotalNodes;
   vListAssigned := true;
   vEndCol := LinkList.GetMaxNodeSize;
end; {BrowseLinkOBJ.AssignList}

function BrowseLinkOBJ.GetString(Pick,Start,Finish:longint): string;
{}
var TempPtr : DLLNodePtr;
begin
   TempPtr := vLinkList^.NodePtr(Pick);
   if TempPtr <> Nil then
      vLinkList^.ShiftActiveNode(TempPtr,Pick);
   GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
end; {BrowseLinkOBJ.GetString}

function BrowseLinkOBJ.ListPtr: DLLPtr;
{}
begin
   ListPtr := vLinkList;
end; {BrowseLinkOBJ.ListPtr}

destructor BrowseLinkOBJ.Done; 
{}
begin
   BrowseObj.Done;
end; {BrowseLinkOBJ.Done;}
{|||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                   }
{    B r o w s e F i l e O B J    M E T H O D S     }
{                                                   }
{|||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor BrowseFileOBJ.Init;
{}
begin
   BrowseOBJ.Init;
end; {BrowseFileOBJ.Init}

function BrowseFileOBJ.AssignFile(Filename: string): integer;
{RetCodes:   
         0   OK
         1   File not found
         2   Run out of memory
}
var
   F : text;
   Line : string;
   Result: integer;
begin
   Assign(F,Filename);
   {$I-}
   Reset(F);
   {$I+}
   if IOResult <> 0 then
      AssignFile := 1
   else
   begin
      new(vStrList,Init);
      Result := 0;
      while (eof(F) = false) and (Result = 0) do
      begin
         Readln(F,Line);
         Result := vStrList^.Add(Line);
      end;
      vWin^.SetTitle(filename);
      vListAssigned := true;
      vTotPicks := vStrList^.TotalNodes;
      vEndCol := vStrList^.GetMaxNodeSize;
      if Result = 0 then
         AssignFile := 0
      else
         AssignFile := 1;
   end;
end; {BrowseFileOBJ.AssignFile}

function BrowseFileOBJ.ListPtr:StrDLLPtr;
{}
begin
   ListPtr := vStrList;
end; {BrowseFileOBJ.ListPtr}

function BrowseFileOBJ.GetString(Pick,Start,Finish:longint): string;
{}
var TempPtr : DLLNodePtr;
begin
   TempPtr := vStrList^.NodePtr(Pick);
   if TempPtr <> Nil then
      vStrList^.ShiftActiveNode(TempPtr,Pick);
   GetString := vStrList^.GetStr(TempPtr,Start,Finish);
end; {BrowseFileOBJ.GetString}

destructor BrowseFileOBJ.Done;   
{}
begin
   BrowseOBJ.Done;
   dispose(vStrList,Done);
end; {BrowseFileOBJ.Done}
{||||||||||||||||||||||||||||||||||||||}
{                                      }
{    L i s t O B J   M E T H O D S     }
{                                      }
{||||||||||||||||||||||||||||||||||||||}
constructor ListOBJ.Init;
{}
begin
   new(vWin,Init);
   vWin^.SetScrollable(true,true);
   vTopPick := 1;
   vTotPicks := 1;
   vActivePick := 1;
   vListVisible := false;
   vListAssigned := false;
   vMsgActive := false;
   vCharHook := NoCharHook;
   vMsgHook := NoMsgHook;
   vAllowToggle  := true;
   vColWidth := 0;
   vHAttr := LookTOT^.MenuHiNorm;
   vNAttr := LookTOT^.MenuLoNorm;
   vSAttr := LookTOT^.MenuOff;
   vWin^.SetColors(0,vNattr,0,0);
   vDualColors := false;
end; {ListOBJ.Init}

procedure ListOBJ.SetTopPick(TopPick: longint);
{}
begin
   vTopPick := TopPick;
end; {ListOBJ.SetTopElement}

procedure ListOBJ.SetActivePick(ThePick: longint);
{}
begin
   vActivePick := ThePick;
end; {ListOBJ.SetTopElement}

procedure ListOBJ.SetTagging(On:boolean);
{}
begin
   vAllowToggle := On;
end; {ListOBJ.SetTagging}

procedure ListOBJ.SetDualColors(On:boolean);
{}
begin
   vDualColors := On;
end; {ListOBJ.SetDualColors}

procedure ListOBJ.SetColors(HAttr,NAttr,SAttr: byte);
{}
begin
   vHAttr := HAttr;
   vNAttr := NAttr;
   vSAttr := SAttr;
   vWin^.SetColors(0,vNattr,0,0);
end; {ListOBJ.SetColors}

procedure ListOBJ.SetColWidth(Wid: byte);
{}
begin
   vColWidth := Wid;
end; {ListOBJ.SetColumnWidth}

procedure ListOBJ.SetCharHook(Func:ListCharFunc);
{}
begin
   vCharHook := Func;
end; {ListOBJ.SetCharHook}

procedure ListOBJ.SetMsgHook(Func:ListMsgFunc);
{}
begin
   vMsgHook := Func;
   vMsgActive := true;
end; {ListOBJ.SetMsgHook}

procedure ListOBJ.SetMsgState(On:boolean);
{}
begin
   vMsgActive := On;
end; {ListOBJ.SetMsgState}

function ListOBJ.GetHiString:string;
{}
begin
   GetHiString := GetString(pred(vTopPick+vActivePick),0,0);
end; {ListOBJ.GetHiString}
function ListOBJ.Win:StretchWinPtr;
{}
begin
   Win := vWin;
end; {ListOBJ.Win}

procedure ListOBJ.ResetDimensions;
{adjusts the column and row settings based on the list window coords}
var 
  ListWidth: byte;
  Style: byte;
begin
   with vZone do
      vWin^.GetSize(X1,Y1,X2,Y2,Style);
   if Style = 0 then
      fillchar(vMargin,sizeof(vMargin),#0)
   else
   begin
      vMargin.X1 := 1;
      vMargin.X2 := 1;
      vMargin.Y2 := 1;
      if Style = 6 then
         vMargin.Y1 := 3
      else
         vMargin.Y1 := 1;
   end;
   if vColWidth < 5 then
   begin
      vRealColWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
      vCols := 1;
      vLastColWidth := vRealColWidth;
   end
   else
   begin
      vRealColWidth := vColWidth;
      ListWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
      if vRealColWidth > ListWidth then
         vRealColWidth := ListWidth;
      vCols :=  ListWidth div vRealColWidth;
      vLastColWidth := ListWidth - vCols * vRealColWidth;
      if vLastColWidth = 0 then
         vLastColWidth := vRealColWidth
      else
         Inc(vCols);
   end;
   vUseLastCol := (vCols = 1) or (vLastColWidth = vRealColWidth);
   vRows := succ(vZone.Y2 - vZone.Y1) - vMargin.Y1 - vMargin.Y2;
   if vMsgActive then
      dec(vRows,2);  {make space for message}
end; {ListOBJ.ResetDimensions}

procedure ListOBJ.DisplayPick(Pick:integer; Hi:boolean);
{}
var
  X,Y,Att,Pad,Max,L: byte;
  W : LongInt;
  Partial,
  Selected: boolean;
  PadLeft,PadRight: string[1];
  PickStr : String;
  LeftChar,
  RightChar,
  ToggleOnChar,
  ToggleOffChar : char;
begin
   if vTotPicks = 0 then
      exit;
   LeftChar := LookTOT^.ListLeftChar;
   RightChar := LookTOT^.ListRightChar;
   ToggleOnChar := LookTOT^.ListToggleOnChar;
   ToggleOffChar := LookTOT^.ListToggleOffChar;
   Partial := (vCols > 1) and (Pick > vRows * Pred(vCols))
                          and (vLastColWidth <> vRealColWidth);
   If pred(vTopPick + Pick) > vTotPicks then
   begin
      Att := vNAttr;
      if not Partial then
         PickStr := replicate(vRealColWidth,' ')
      else
         PickStr := replicate(vLastColWidth,' ');
   end
   else
   begin
      Selected := false;
      Pad := ord(LeftChar<>#0) + 2*ord(vAllowToggle);
      if not Partial then
         Pad := Pad + ord(RightChar<>#0);
      if vAllowToggle then
         Selected := GetStatus(pred(vTopPick+Pick), 0);
      if Hi then
         Att := vHAttr
      else
      begin
         if vDualColors and GetStatus(pred(vTopPick+Pick),1) then
            Att := vSAttr
         else
            Att := vNAttr;
      end;
      if (vCols = 1) or (Pick <= vRows * pred(vCols)) then
      begin
         Max := vRealColWidth;
         W := vRealColWidth - pad;
      end
      else
      begin
         Max := vLastColWidth;
         W := vLastColWidth - pad;
      end;
      if W < 0 then
         PickStr := ''
      else
      begin
         PickStr := GetString(pred(vTopPick + Pick),1,W);
         L := length(PickStr);
         If L < W then {pad out the name}
            PickStr := PickStr + replicate(W-L,' ');
      end;
      if vAllowToggle then
      begin
         if Selected then
            PickStr :=  ToggleOnChar+' '+PickStr
         else
            PickStr :=  ToggleOffChar+' '+PickStr;
      end;
      if Hi then
      begin
        if (LeftChar <> #0) then
           PickStr := LeftChar+PickStr;
        if (RightChar <> #0) then
           PickStr := PickStr+RightChar;
      end
      else
      begin
         if (LeftChar = #0) then
            Padleft := ''
         else
            PadLeft := ' ';
         if (RightChar = #0) or Partial then
            PadRight := ''
         else
            PadRight := ' ';
         PickStr := PadLeft+PickStr+PadRight;
      end;
      if length(PickStr) > Max then
         PickStr := copy(PickStr,1,Max);
   end;
   if Pick <= vRows then
      X := 1
   else
      X := succ(vRealColWidth*(pred(Pick) div vRows));
   if Pick mod vRows = 0 then
      Y := vRows
   else
      Y := (Pick mod vRows);
   {now write the pick}
   Screen.WriteAT(X,Y,Att,PickStr);
   if Hi then
   begin
      Screen.GotoXY(X,Y);
      if vMsgActive then
      begin
         PickStr := MessageTask(pred(vTopPick+vActivePick));
         Screen.WriteAt(1,succ(vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1),
                        vWin^.GetTitleAttr,
                        PadCenter(PickStr,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),' '));
      end;
   end;
end; {ListOBJ.DisplayPick}

procedure ListOBJ.DisplayAllPicks;
{}
var
  I,J:integer;
begin
   for I := 1 to vCols do
      for J := 1 to vRows do
          DisplayPick(pred(I)*vRows + J,(pred(I)*vRows + J) = vActivePick);
end; {ListOBJ.DisplayAllPicks}

procedure ListOBJ.ValidateActivePick;
{}
var I,J : Integer;
begin
   if (vUseLastCol) or (vCols = 1) then
      I := vCols*vRows
   else
      I := pred(vCols)*vRows;
   if (vActivePick > I) or (vActivePick < 1) then
      vActivePick := 1;
end; {ListOBJ.ValidateActivePick}

procedure ListOBJ.RefreshList;
{}
begin
   ResetDimensions;
   ValidateActivePick;
   if vMsgActive then
   begin
      Screen.HorizLine(1,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),
                         vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1,
                         Win^.GetBorderAttr,
                         1);
   end;
   DisplayAllPicks;
end; {ListOBJ.RefreshList}

procedure ListOBJ.ScrollDown;
{}
var LastPick : integer;
begin
   if pred(vTopPick + vActivePick) < vTotPicks then {not end of list}
   begin
      if (vUseLastCol) or (vCols = 1) then
         LastPick := vCols*vRows
      else
         LastPick := pred(vCols)*vRows;
      if vActivePick < LastPick then
      begin
         DisplayPick(vActivePick,false);
         inc(vActivePick);
         DisplayPick(vActivePick,True);
      end
      else
      begin
         inc(vTopPick);
         DisplayAllPicks;
      end;
   end;
end; {ListOBJ.ScrollDown}

procedure ListOBJ.ScrollUp;
{}
begin
   if vActivePick = 1 then
   begin
      if vTopPick > 1 then
      begin
         dec(vTopPick);
         DisplayAllPicks;
      end;
   end
   else
   begin
      DisplayPick(vActivePick,false);
      dec(vActivePick);
      DisplayPick(vActivePick,True);
   end;
end; {ListOBJ.ScrollUp}

procedure ListObj.JumpEngine(Tot, NewValue: longint);
{}
var I: Integer;
begin
   if NewValue < 1 then
      NewValue := 1;
   if (Tot < (vCols - ord(not vUseLastCol)) * vRows)
   and (vTopPick <= NewValue) then {full list on display}
   begin
      DisplayPick(vActivePick,false);
      vActivePick := NewValue - pred(vTopPick);
      DisplayPick(vActivePick,True);
   end
   else
   begin
      vTopPick := NewValue;
      vActivePick := 1;
      DisplayAllPicks;
   end;
end; {JumpEngine}

procedure ListOBJ.ScrollJumpV(X,Y:byte);
{}
var
  NewValue: LongInt;
begin
   NewValue := (X * vTotPicks) div Y;
   JumpEngine(vTotPicks,NewValue)
end; {ListOBJ.ScrollJumpV}

procedure ListOBJ.ScrollJumpH(X,Y:byte);
{}
var
  NewValue: LongInt;
begin
   NewValue := (X * vTotPicks) div Y;
   JumpEngine(vTotPicks,NewValue)
end; {ListOBJ.ScrollJumpH}

procedure ListOBJ.ScrollLeft;
{}
begin
   if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
      ScrollUp
   else
      if vActivePick > vRows then {not in first column}
      begin
         DisplayPick(vActivePick,false);
         vActivePick := vActivePick - vRows;
         DisplayPick(vActivePick,True);
      end
      else if vTopPick > vRows then                      {leftmost column}
      begin
         vTopPick := vTopPick - vRows;
         DisplayAllPicks;
      end
      else
      begin
         vTopPick := 1;
         vActivePick := 1;
         DisplayAllPicks;
      end;
end; {ListOBJ.ScrollLeft}

procedure ListOBJ.ScrollRight;
{}
begin
   if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
      ScrollDown
   else
      if (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) {not in last column}
      or (vTopPick + (vRows*(vCols -ord(not vUseLastCol))) >= vTotPicks) then
      begin
         DisplayPick(vActivePick,false);
         vActivePick := vActivePick + vRows;
         if vTopPick + pred(vActivePick) > vTotPicks then
            vActivePick := succ(vTotPicks - vTopPick);
         DisplayPick(vActivePick,True);
      end
      else 
      begin
         vTopPick := vTopPick + vRows;
         if vTopPick + pred(vActivePick) > vTotPicks then
           vActivePick := succ(vTotPicks - vTopPick);
         DisplayAllPicks;
      end;
end; {ListOBJ.ScrollRight}

procedure ListOBJ.ScrollFarRight;
{}
begin
   while (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) do
      inc(vActivePick,vRows);
   while (vTopPick + (vCols -ord(not vUseLastCol)) * vRows < vTotPicks)
   and   (vTopPick + pred(vActivePick) + vRows <= vTotPicks) do
      inc(vTopPick,vRows);
   DisplayAllPicks;
end; {ListOBJ.ScrollFarRight}

procedure ListOBJ.ScrollFarLeft;
{}
begin
   while vActivePick - vRows > 0 do
     dec(vActivePick,vRows);
   vTopPick := 1;
   DisplayAllPicks;
end; {ListOBJ.ScrollFarLeft}

procedure ListOBJ.ScrollPgDn;
{}
begin
   if pred(vTopPick + vRows) < vTotPicks then
   begin
      vTopPick := vTopPick + vRows;
      vActivePick := 1;
      DisplayAllPicks;
   end;
end; {ListOBJ.ScrollPgDn}

procedure ListOBJ.ScrollPgUp;
{}
begin
   if vTopPick > 1 then
   begin
      vTopPick := vTopPick - vRows;
      if vTopPick < 1 then
         vTopPick := 1;
      DisplayAllPicks;
   end;
end; {ListOBJ.ScrollPgUp}

procedure ListOBJ.ScrollLast;
{}
begin
   if vTopPick + pred((vCols -ord(not vUseLastCol)) * vRows) >= vTotPicks then {last node on display}
   begin
      DisplayPick(vActivePick,False);
      vActivePick := succ(vTotPicks - vTopPick);
      DisplayPick(vActivePick,True);
   end
   else
   begin
     vTopPick := vTotPicks;
     vActivePick := 1;
     DisplayAllPicks;
   end;
end; {ListOBJ.ScrollLast}

procedure ListOBJ.ScrollFirst;
{}
begin
   vTopPick := 1;
   vActivePick := 1;
   DisplayAllPicks;
end; {ListOBJ.ScrollFirst}

procedure ListOBJ.ToggleSelect;
{}
begin
   SetStatus(pred(vTopPick+vActivePick), 0,not GetStatus(pred(vTopPick+vActivePick),0));
   if pred(vTopPick + vActivePick) < vTotPicks then
      ScrollDown
   else
      DisplayPick(vActivePick,True);
end; {of ListOBJ.ToggleSelect}

function ListOBJ.TargetPick(X,Y:byte): Integer;
{return the pick number of the pick pointed to by
 the coordinates X,Y. If no pick is at those coordinates, a
 0 is returned}
begin
   if  (X >= vZone.X1 + vMargin.X1)
   and (X <= vZone.X2 - vMargin.X2)
   and (Y >= vZone.Y1 + vMargin.Y1)
   and (Y <= vZone.Y1 + vMargin.Y1 + pred(vRows))
   then
   begin
      X := succ(X - vZone.X1 - vMargin.X1);
      Y := succ(Y - vZone.Y1 - vMargin.Y1);
      if X mod vRealColWidth = 0 then
         X := X div vRealColWidth
      else
         X := succ(X div vRealColWidth);
      if (X < vCols)
      or ((X = vCols) and vUseLastCol) then
      begin
          if vTopPick + pred(pred(X)*vRows + Y) <= vTotPicks then
          begin
             TargetPick := pred(X)*vRows + Y;
             exit;
          end;
      end;
   end;
   TargetPick := 0;
end; {ListOBJ.TargetPick}

procedure ListOBJ.MouseChoose(KeyX,KeyY:byte);
{}
var
   HitPick : integer;
begin
   HitPick := TargetPick(KeyX,KeyY);
   if HitPick <> 0 then
   begin
      DisplayPick(vActivePick,false);
      vActivePick := HitPick;
      SetStatus(pred(vTopPick+vActivePick),0,not GetStatus(pred(vTopPick+vActivePick),0));
      DisplayPick(vActivePick,True);
   end;
end; {ListOBJ.MouseChoose}

procedure ListOBJ.Show;
{}
begin
   if vListAssigned = false then
      Error(1)
   else
   begin
      if not vListVisible then
      begin
         vWin^.Draw;
         RefreshList;
         vListVisible := true
      end;
   end;
end; {ListOBJ.Show}

procedure ListOBJ.Go;
{}
var
   Finished: boolean;
   Mvisible: boolean;
   Kdouble: boolean;
   K: word;
   X,Y :byte;
   CursX,CursY: byte;
   Msg : string;
   CX,CY,CT,CB:byte;

       procedure ProcessAction(Act: tListAction);
       {}
       begin
          case Act of
             Finish: begin
                K := 0;
                Finished := true;
                end;
             Refresh: begin
                K := 0;
                RefreshList;
                end;
             None:; {nothing!}
          end; {case}
       end; {ProcessAction}

begin
   if Monitor^.ColorOn then
      with Screen do
      begin
         CursSave;
         CX := WhereX;
         CY := WhereY;
         CT := CursTop;
         CB := CursBot;
         CursOff;
      end;
   Mvisible := Mouse.Visible;
   Show;
   kDouble := Key.GetDouble;
   if not kDouble then
      Key.SetDouble(true);
   Mouse.Show;
   Finished := false;
   repeat
      CursX := Screen.WhereX;
      CursY := Screen.WhereY;
      vWin^.DrawHorizBar(pred(vTopPick+vActivePick),vTotPicks);
      vWin^.DrawVertBar(pred(vTopPick+vActivePick),vTotPicks);
      Screen.GotoXY(CursX,CursY);
      K := Key.GetKey;
      X := Key.LastX;
      Y := Key.LastY;
      vWin^.Winkey(K,X,Y);
      ProcessAction(CharTask(K,X,Y,pred(vTopPick+vActivePick)));
      if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
         Finished := true
      else if (K = LookTOT^.ListToggleKey) and vAllowToggle then
         ToggleSelect
      else if (K = LookTOT^.ListTagKey) and vAllowToggle then
         TagAll(true)
      else if (K = LookTOT^.ListUnTagKey) and vAllowToggle then
         TagAll(false)
      else
         case K of
         13: if vAllowToggle = false then
                Finished := true
             else
                ToggleSelect;
         600: Finished := true; {window close}
         601: ResetDimensions;
         602: RefreshList;
         610,328: ScrollUp;
         611,336: ScrollDown;
         612,331: ScrollLeft;
         613,333: ScrollRight;
         513: MouseChoose(X,Y);  {leftMouse}
         523: if TargetPick(X,Y) <> 0 then
               begin
                  MouseChoose(X,Y);
                  Finished := True;
               end;
         337: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgDn}
                 ScrollPgDn
              else
                 ScrollRight;
         329: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgUp}
                 ScrollPgUp
              else
                 ScrollLeft;
         335: ScrollFarRight;
         327: ScrollFarLeft;
         388: ScrollFirst;
         374: ScrollLast;
         614: begin  {vertical scroll bar}
                 if X = 1 then
                    ScrollFirst
                 else if X = Y then
                    ScrollLast
                 else
                    ScrollJumpV(X,Y); {vertical scroll bar}
              end;
         615: begin {horizontal scroll bar}
                 if X = 1 then
                    ScrollFirst
                 else if X = Y then
                    ScrollLast
                 else
                    ScrollJumpH(X,Y); {vertical scroll bar}
              end;
         end; {case}
   until Finished;
   vLastKey := K;
   if Mvisible then
      Mouse.Show
   else
      Mouse.Hide;
   if Monitor^.ColorOn then
      with Screen do
      begin
         GotoXY(CX,CY);
         CursSize(CT,CB);
      end;
   Key.SetDouble(KDouble);
end; {ListOBJ.Go}

function ListOBJ.LastKey:word;
{}
begin
   LastKey := vLastKey;
end; {ListOBJ.LastKey}

procedure ListOBJ.Remove;
{}
begin
   vWin^.Remove;
end; {ListOBJ.Remove}

function ListOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction; 
{}
begin
   CharTask := vCharHook(K,X,Y,HiPick);
end; {ListOBJ.CharTask}

function ListOBJ.MessageTask(HiPick:longint):string; 
{}
begin
   MessageTask := vMsgHook(HiPick);
end; {ListOBJ.MessageTask}

function ListOBJ.GetString(Pick, Start,Finish: longint):string;
{abstract}
begin end;

function ListOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
{abstract}
begin end;

procedure ListObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
{abstract}
begin end;

procedure ListOBJ.TagAll(On:boolean);
{}
begin end;

destructor ListOBJ.Done;
{}
begin
   dispose(vWin,Done);
end;  {ListOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                 }
{    L i s t A r r a y O B J    M E T H O D S     }
{                                                 }
{|||||||||||||||||||||||||||||||||||||||||||||||||}
constructor ListArrayOBJ.Init;
{}
begin
   ListObj.Init;
   vLinkList := Nil;
end; {ListArrayOBJ.Init}

procedure ListArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte; Selectable: boolean);
{}
var
  L : Longint;
  Dummy: byte;
  Result : integer;
begin
   vArrayPtr := @StrArray;
   vStrLength := StrLength;
   vTotPicks := Total;
   vListAssigned := true;
   vAllowToggle := Selectable;
   if vAllowToggle then {assign a linked list to record selections}
   begin
      if MemAvail < SizeOf(vLinkList^) then
      begin
         vAllowToggle := False;
         exit;
      end;
      New(vLinkList,Init);
      with vLinkList^ do
      begin
         Dummy := 0;
         For L := 1 to Total do
         begin
            Result := Add(Dummy,0);
            if Result <> 0 then
            begin
               Dispose(vLinkList,Done);
               vAllowToggle := false;
            end;
         end;
      end;
   end;
end; {ListArrayOBJ.AssignList}

procedure ListArrayOBJ.SetTagging(On:boolean);
{}
begin
   if On and (vLinkList <> Nil) then
      vAllowToggle := true
   else
      vAllowToggle := false;
end; {ListOBJ.SetTagging}

function ListArrayOBJ.GetString(Pick, Start,Finish: longint):string;
{}
var
  W : longint;
  TempStr : String;
  ArrayOffset: word;
begin
   {move array string to Temp}
   W := pred(Pick) * succ(vStrLength);
   ArrayOffset := Ofs(vArrayPtr^) + W;
   Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
   Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
   if Start < 0 then Start := 0;
   if Finish < 0 then Finish := 0;
   {validate Start and Finish Parameters}
   if ((Finish = 0) and (Start = 0))
   or (Start > Finish) then   {get full string}
   begin
      Start := 1;
      Finish := 255;
   end
   else if Finish - Start > 254 then      {too long to fit in string}
      Finish := Start + 254;
   if Finish > vStrLength then
      Finish := vStrLength;
   if (Start > vStrLength) then
      GetString := ''
   else
   begin
      GetString := copy(TempStr,Start,succ(Finish - Start));
   end;
end; {ListArrayOBJ.GetString}

function ListArrayOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
{}
begin
   GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos);
end; {ListArrayOBJ.GetStatus}

procedure ListArrayObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
{}
begin
   vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
end; {ListArrayObj.SetStatus}

procedure ListArrayOBJ.TagAll(On:boolean);
{}
var NodeP : DLLNodePtr;
begin
   NodeP := vLinkList^.StartNodePtr;
   while NodeP <> Nil do
   begin
      NodeP^.SetStatus(0,On);
      NodeP := NodeP^.NextPtr;
   end;
   DisplayAllPicks;
end; {ListOBJ.TagAll}

destructor ListArrayOBJ.Done;
{}
begin
   if vLinkList <> nil then
      Dispose(vLinkList,Done);
   ListObj.Done;
end; {ListArrayOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{    L i s t L i n k O B J    M E T H O D S     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}
constructor ListLinkOBJ.Init;
{}
begin
   ListObj.Init;
   vLinkList := nil;
end; {ListLinkOBJ.Init}

procedure ListLinkOBJ.AssignList(var LinkList: DLLOBJ);
{}
begin
   vLinkList := @LinkList;
   vTotPicks := LinkList.TotalNodes;
   vListAssigned := true;
end; {ListLinkOBJ.AssignList}

function ListLinkOBJ.ListPtr: DLLPtr;
{}
begin
   ListPtr := vLinkList;
end; {ListLinkOBJ.ListPtr}

function ListLinkOBJ.GetString(Pick, Start,Finish: longint):string;
{}
var TempPtr : DLLNodePtr;
begin
   TempPtr := vLinkList^.NodePtr(Pick);
   if TempPtr <> Nil then
      vLinkList^.ShiftActiveNode(TempPtr,Pick);
   GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
end; {ListLinkOBJ.GetString}

function ListLinkOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
{}
begin
   GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos);
end; {ListLinkOBJ.GetStatus}

procedure ListLinkObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
{}
begin
   vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
end;  {ListLinkObj.SetStatus}

procedure ListLinkOBJ.TagAll(On:boolean);
{}
var NodeP : DLLNodePtr;
begin
   NodeP := vLinkList^.StartNodePtr;
   while NodeP <> Nil do
   begin
      NodeP^.SetStatus(0,On);
      NodeP := NodeP^.NextPtr;
   end;
   DisplayAllPicks;
end; {ListOBJ.TagAll}

destructor ListLinkOBJ.Done;
{}
begin
   ListObj.Done;
end; {ListLinkOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||}
{                                             }
{    L i s t D i r O B J    M E T H O D S     }
{                                             }
{|||||||||||||||||||||||||||||||||||||||||||||}
constructor ListDirOBJ.Init;
{}
begin
   ListObj.Init;
   new(vFileList,Init);
   vMsgActive := true;
   vDualColors := true;
   vColWidth := 15;
   vWin^.SetSize(10,5,71,20,1);
end; {ListDirOBJ.Init}

procedure ListDirOBJ.ReadFiles(FileMasks:string; FileAttrib: word);
{}
begin
   if FileMasks = '' then
      FileMasks := '*.*';
   vFileList^.SetFileDetails(FileMasks,FileAttrib);
   if (pos(':',Filemasks)=0) and (pos('\',Filemasks)=0) then 
   begin
      GetDir(0,vActiveDir);
      if not (vActiveDir[length(vActiveDir)] in [':','\']) then
         vActiveDir := vActiveDir + '\';
      Filemasks := vActiveDir+Filemasks;
   end;
   Win^.SetTitle(FileMasks);
   vFileList^.FillList;
   vTotPicks := vFileList^.TotalNodes;
   vListAssigned := true;
end; {ListDirOBJ.ReadFiles}

function ListDirOBJ.GetString(Pick, Start,Finish: longint):string;
{}
var TempPtr : DLLNodePtr;
begin
   TempPtr := vFileList^.NodePtr(Pick);
   if TempPtr <> Nil then
      vFileList^.ShiftActiveNode(TempPtr,Pick);
   GetString := vFileList^.GetStr(TempPtr,Start,Finish);
end; {ListDirOBJ.GetString}

function ListDirOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
{}
var
  FileInfo: tFileInfo;
  HitPick : integer;
begin
   CharTask := none;
   if (K = 13) or (K = 513) then
   begin
      if K = 513 then
      begin
         HitPick := TargetPick(X,Y);
         if HitPick <> 0 then
            HiPick := pred(vTopPick+HitPick)
         else
            exit;
      end;
      vFileList^.GetFileRecord(FileInfo,HiPick);
      if SubDirectory(FileInfo.Attr) then
      begin
         {$I-}
         ChDir(FileInfo.FileName);
         {$I+}
         if IOResult = 0 then
         begin
            vFileList^.FillList;
            vTotPicks := vFileList^.TotalNodes;
            vTopPick := 1;
            vActivePick := 1;
            CharTask := Refresh;
            GetDir(0,vActiveDir);
            if not (vActiveDir[length(vActiveDir)] in [':','\']) then
               vActiveDir := vActiveDir + '\';
            Win^.SetTitle(vActiveDir+vFileList^.GetFileMask);
            Win^.Refresh;
         end;
      end
      else if (K= 13) or ((K=513) and (vAllowToggle = false)) then
         CharTask := Finish;
   end;
end; {ListDirOBJ.CharTask}

function ListDirOBJ.GetHiString:string;
{}
begin
   GetHiString := vActiveDir + GetString(pred(vTopPick+vActivePick),0,0);
end; {ListDirOBJ.GetHiString}

function ListDirOBJ.MessageTask(Hi:longint): string;
{}
var TempPtr : DLLNodePtr;
begin
   TempPtr := vFileList^.NodePtr(Hi);
   if TempPtr <> Nil then
      vFileList^.ShiftActiveNode(TempPtr,Hi);
   MessageTask := vFileList^.GetLongStr(TempPtr);
end; {ListDirOBJ.MessageTask}

function ListDirOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
{}
begin
   GetStatus := vFileList^.NodePtr(Pick)^.GetStatus(BitPos);
end; {ListDirOBJ.GetStatus}

procedure ListDirObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
{}
begin
   vFileList^.NodePtr(Pick)^.SetStatus(BitPos,On);
end;  {ListDirObj.SetStatus}

procedure ListDirOBJ.TagAll(On:boolean);
{}
var NodeP : DLLNodePtr;
begin
   NodeP := vFileList^.StartNodePtr;
   while NodeP <> Nil do
   begin
      NodeP^.SetStatus(0,On);
      NodeP := NodeP^.NextPtr;
   end;
   DisplayAllPicks;
end; {ListOBJ.TagAll}

function ListDirOBJ.FileList: FileDLLPtr;
{}
begin
   FileList := vFileList;
end; {ListDirOBJ.FileList}

procedure ListDirOBJ.Go;
{}
var
  D: string;
begin
   GetDir(0,D);
   ListOBJ.Go;
   {$I-}
   ChDir(D);
   {$I+}
   if IOResult <> 0 then
      {whogivesashit};
end; {ListDirOBJ.Go}

destructor ListDirOBJ.Done;
{}
begin
   ListObj.Done;
   dispose(vFileList,Done);
end; {ListDirOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                     }
{    L i s t D i r S o r t O B J    M E T H O D S     }
{                                                     }
{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor ListDirSortOBJ.Init;
{}
begin
   ListDirObj.Init;
end; {ListDirSortOBJ.Init}

function ListDirSortOBJ.PromptAndSort: boolean;
{}
var
  Manager: WinFormOBJ;
  Control:  ControlKeysIOOBJ;
  OK,Cancel: Strip3DIOOBJ;
  SField,SOrder: RadioIOOBJ;
  Result: tAction;
  SortField: byte;
  SortOrder: boolean;
begin
   Control.Init; {Tab, STab, Enter, Esc}
   OK.Init(23,5,'   ~O~K   ',Finished);
   OK.SetHotKey(79);{O}
   Cancel.Init(23,8,' ~C~ancel ',Escaped);
   Cancel.SetHotKey(67); {C}
   with SField do
   begin
      Init(3,2,18,6,'Sort on:');
      AddItem('Nat~u~ral DOS',ord('U'),vFileList^.vSortID = 0);
      AddItem('~N~ame',ord('N'),vFileList^.vSortID = 1);
      AddItem('~E~xt', ord('E'),vFileList^.vSortID = 2);
      AddItem('~S~ize',ord('S'),vFileList^.vSortID = 3);
      AddItem('~T~ime',ord('T'),vFileList^.vSortID = 4);
      SetID(1);
   end;
   with SOrder do
   begin
      Init(3,9,18,3,'Sort Order:');
      AddItem('~A~scending',ord('A'),vFileList^.vSortAscending);
      AddItem('~D~escending',ord('D'),not vFileList^.vSortAscending);
   end;
   with Manager do
   begin
     Init;
     AddItem(Control);
     AddItem(SField);
     AddItem(SOrder);
     AddItem(OK);
     AddItem(Cancel);
     SetActiveItem(1);
     Win^.SetSize(25,2,58,15,1);
     Win^.SetTitle('Directory Sort Options');
     Draw;
     Result := Go;
     SortField := pred(Sfield.GetValue);
     SortOrder := (SOrder.GetValue = 1);
     Control.Done;
     OK.Done;
     Cancel.Done;
     SField.Done;
     SOrder.Done;
     Done;
   end;
   if Result = Finished then
   begin
      vFileList^.Sort(SortField,SortOrder);
      vTopPick := 1;
      vActivePick := 1;
      PromptAndSort := true;
   end
   else
      PromptAndSort := false;
end; {ListDirSortOBJ.PromptAndSort}

function ListDirSortOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
{}
var
  FileInfo: tFileInfo;
  D : string;
  MP: longint;
begin
   CharTask := none;
   if (K = 83) or (K = 115) or (K = 514) then {'S','s',rightbutton}
   begin
      if PromptAndSort then
         CharTask := Refresh
      else
         CharTask := none;
   end
   else
      CharTask := ListDirOBJ.CharTask(K,X,Y,HiPick);
end; {ListDirSortOBJ.CharTask}

destructor ListDirSortOBJ.Done;
{}
begin
   ListDirObj.Done;
end; {ListDirSortOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     U N I T   I N I T I A L I Z A T I O N     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}

procedure ListInit;
{initilizes objects and global variables}
begin
end;

{end of unit - add initialization routines below}
{$IFNDEF OVERLAY}
begin
   ListInit;
{$ENDIF}
end.



