ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TOTSRC.ZIP/TOTIO2.INC

Text File | 1991-02-10 | 8.7 KB | 366 lines

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

{File TOTIO2.INC}

{||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                }
{     L i s t F i e l d O B J   M E T H O D S    }
{                                                }
{||||||||||||||||||||||||||||||||||||||||||||||||}

constructor ListIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
{}
begin
   MultiLineIOOBJ.Init(X1,Y1,width,depth,Title);
   vTopPick := 1;
   vTotPicks := 0;
   vActivePick := 1;
   vListAssigned := false;
   vScrollBarOn := false;
   vActiveField := false;
end; {ListIOOBJ.Init}

function ListIOOBJ.Select(K:word; X,Y:byte):TAction;
{}
var New: byte;
begin
   vScrollBarOn := (vTotPicks >= vRows);
   vActiveField := true;
   Display(HiStatus);
   WriteLabel(HiStatus);
   WriteMessage;
   if (K = 513) or (K=523) then
   begin
      if vScrollBarOn and (X = vBorder.X2) then
        {nothing for now}
      else
      begin
         New := HitItem(Y);
         if New > 0 then
         begin
            WriteItem(vActivePick,false);
            vActivePick := New;
            WriteItem(vActivePick,true);
         end;
      end;
   end;
   Select := none;
end; {ListIOOBJ.Select}

procedure ListIOOBJ.WriteItem(Item:integer; Selected:boolean);
{}
var
  Str: string;
  High,Nor: byte;
  Status: tStatus;
begin
   if vListAssigned then
   begin
      Str := GetString(pred(vTopPick)+Item);
      if Selected then
         Status := HiStatus
      else
         Status := Norm;
      AssignColors(IOTOT^.vList,IOTOT^.vField,Status,High,Nor);
      if (vActiveField = false) and Selected then
         Nor := IOTOT^.ListCol(2);
      Screen.WriteHi(vBorder.X1,vBorder.Y1+pred(Item),High,Nor,
                     padleft(Str,vBorder.X2-vBorder.X1,' '));
      if Selected then
         Screen.GotoXY(vBorder.X1,vBorder.Y1+pred(Item));
      if item = vActivePick then
         ShowItemDetails(pred(vTopPick)+Item);
   end;
end; {ListIOOBJ.WriteItem}

procedure ListIOOBJ.DisplayAllPicks;
{}
var I : integer;
begin
   for I := 1 to vRows do
       WriteItem(I,(I=vActivePick));
end; {ListIOOBJ.DisplayAllPicks}

procedure ListIOOBJ.RefreshScrollBar;
{}
var High,Nor:byte;
begin
   AssignColors(IOTOT^.vList,IOTOT^.vField,Norm,High,Nor);
   with vBorder do
   if vScrollBarOn then
      Screen.WriteVScrollBar(X2,Y1,Y2,Nor,pred(vTopPick+vActivePick),vTotPicks)
   else
      Screen.WriteVert(X2,Y1,Nor,replicate(succ(Y2-Y1),' '));
end; {ListIOOBJ.RefreshScrollBar}

function ListIOOBJ.HitItem(Y:byte):byte;
{returns the row number of the item falling on line Y, else returns 0}
var
  B: integer;
begin
    B := Y - pred(vBorder.Y1);
    if (B > vRows) or (B < 0) or (B+pred(vTopPick)>vTotPicks) then
       HitItem := 0
    else
       HitItem := B;
end; {ListIOOBJ.HitItem}

procedure ListIOOBJ.ScrollJump(Y:byte);
{}
var
  Tot: integer;
begin
   Tot := vBorder.Y2 - succ(vBorder.Y1);
   Y := Y - vBorder.Y1;
   if vTopPick + Y <= vTotPicks then
   begin
      if vTotPicks <= vRows then
      begin
         WriteItem(vActivePick,false);
         vActivePick := (Y * vTotPicks) div Tot;
         WriteItem(vActivePick,true);
      end
      else
      begin
         vTopPick := (Y * vTotPicks) div Tot;
         vActivePick := 1;
         DisplayAllPicks;
      end;
   end;
end; {of proc ListIOOBJ.ScrollJump}

procedure ListIOOBJ.ScrollUp;
{}
begin
   if vActivePick = 1 then
   begin
      if vTopPick > 1 then
      begin
         dec(vTopPick);
         DisplayAllPicks;
      end;
   end
   else
   begin
      WriteItem(vActivePick,false);
      dec(vActivePick);
      WriteItem(vActivePick,True);
   end;
end; {of proc ListIOOBJ.ScrollUp}

procedure ListIOOBJ.ScrollDown;
{}
begin
   if pred(vTopPick) + vActivePick < vTotPicks then
   begin
      if vActivePick < vRows then
      begin
         WriteItem(vActivePick,false);
         inc(vActivePick);
         WriteItem(vActivePick,True);
      end
      else
      begin
         inc(vTopPick);
         DisplayAllPicks;
      end;
   end;
end; {of proc ListIOOBJ.ScrollDown}

procedure ListIOOBJ.ScrollPgUp;
{}
begin
   if vTopPick > 1 then
   begin
      vTopPick := vTopPick - vRows;
      if vTopPick < 1 then
         vTopPick := 1;
      DisplayAllPicks;
   end
   else if vActivePick <> 1 then
   begin
      WriteItem(vActivePick,false);
      vActivePick := 1;
      WriteItem(vActivePick,True);
   end;
end; {of proc ListIOOBJ.ScrollPgUp}

procedure ListIOOBJ.ScrollPgDn;
{}
begin
   if pred(vTopPick + vRows) < vTotPicks then
   begin
      vTopPick := vTopPick + vRows;
      vActivePick := 1;
      DisplayAllPicks;
   end
   else if vActivePick + pred(vTopPick) < vTotPicks then
   begin
      WriteItem(vActivePick,false);
      vActivePick := vTotPicks - pred(vTopPick);
      WriteItem(vActivePick,True);
   end;
end; {of proc ListIOOBJ.ScrollPgDn}

procedure ListIOOBJ.ScrollHome;
{}
begin
   if (vTopPick <> 1) or (vActivePick <> 1) then
   begin
      vTopPick := 1;
      vActivePick := 1;
      DisplayAllPicks;
   end;
end; {of proc ListIOOBJ.ScrollHome}

procedure ListIOOBJ.ScrollEnd;
{}
begin
   if vTopPick + pred(vRows) >= vTotPicks then {last node on display}
   begin
      WriteItem(vActivePick,False);
      vActivePick := succ(vTotPicks - vTopPick);
      WriteItem(vActivePick,True);
   end
   else
   begin
     vTopPick := vTotPicks - pred(vRows);
     vActivePick := vRows;
     DisplayAllPicks;
   end;
end; {of proc ListIOOBJ.ScrollEnd}

procedure ListIOOBJ.Display(Status:tStatus);
{}
var
  BorderCol : byte;
  Style: byte;
  I : integer;
begin
   MultiLineIOOBJ.Display(Status);
   for I := 1 to vRows do
(*
      WriteItem(I,((I=vActivePick) and (Status=HiStatus)));
*)
      WriteItem(I,(I=vActivePick));

   if Status <> HiStatus then
      vScrollBarOn := false;
   RefreshScrollBar;
end; {ListIOOBJ.Display}

procedure ListIOOBJ.AdjustMouseKey(var InKey: word;X,Y:byte);
{}
begin
   if (X = vBorder.X2) and (vScrollBarOn) then {probably on scroll bar}
   begin
      if Y = vBorder.Y2 then
         InKey := 611
      else if Y = vBorder.Y1 then
         InKey := 610
      else if (Y > vBorder.Y1) and (Y < vBorder.Y2) then
         Inkey := 614;
   end;
end; {ListIOOBJ.AdjustMouseKey}

function ListIOOBJ.TargetPick(X,Y:byte): longint;
{}
var Pick:integer;
begin
   Pick := 0;
   if (X >= vBorder.X1) and (X <= vBorder.X2) then
   begin
      Pick := Y - pred(vBorder.Y1);
      if (Pick > 0)
      and (Pick <= vRows)
      and (Pick + pred(vTopPick) <= vTotPicks) then
         {OK}
      else
         Pick := 0;
   end;
   TargetPick := Pick;
end; {ListIOOBJ.TargetPick}

procedure ListIOOBJ.MouseChoose(X,Y:byte);
{}
var Pick:integer;
begin
   Pick := TargetPick(X,Y);
   if (Pick <> 0) and (Pick <> vActivePick) then
   begin
      WriteItem(vActivePick,false);
      vActivePick  := Pick;
      WriteItem(vActivePick,True);
   end;
end; {ListIOOBJ.MouseChoose}

function ListIOOBJ.SelectPick(InKey:word;X,Y:byte): tAction;
{Semi-abstract}
begin
   SelectPick := NextField;
end; {ListIOOBJ.SelectPick}

function ListIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
{}
var
  NextAction: tAction;
begin
   NextAction := none;
   if InKey = 513 then
      AdjustMousekey(Inkey,X,Y);
   case InKey of
      610,
      328: ScrollUp;
      32,
      611,
      336: ScrollDown;
      513: MouseChoose(X,Y);
      337: ScrollPgDn;
      329: ScrollPgUp;
      335: ScrollEnd;
      327: ScrollHome;
      614: begin  {vertical scroll bar}
              if Y = succ(vBorder.Y1) then
                 ScrollHome
              else if Y = pred(vBorder.Y2) then
                 ScrollEnd
              else
                 ScrollJump(Y); {vertical scroll bar}
           end;
      13,
      523: NextAction := SelectPick(Inkey,X,Y);
   end; {case}
   RefreshScrollBar;
   ProcessKey := NextAction;
end; {ListIOOBJ.ProcessKey}

function ListIOOBJ.GetValue: integer;
{}
begin
   GetValue := pred(vTopPick) + vActivePick;
end; {ListIOOBJ.GetValue}

function ListIOOBJ.Suspend:boolean;
{}
begin
   vScrollBarOn := false;
   vActiveField := false;
   Suspend := VisibleIOOBJ.Suspend;
end; {ListIOOBJ.Suspend}

procedure ListIOOBJ.ShowItemDetails(HiPick: integer);
{abstract}
begin end;
function ListIOOBJ.GetString(Pick:integer): string;
{abstract}
begin end;

destructor ListIOOBJ.Done;
{}
begin
   MultiLineIOOBJ.Done;
end; {ListIOOBJ.Done}