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

{                             Build # 1.00                             }

Unit totIO2;
{$I TOTFLAGS.INC}

{
 Development Notes:

}

INTERFACE

uses DOS, CRT,
     totSYS, totLOOK, totFAST, totSTR, totINPUT, totWIN,
     totIO1, totMSG,  totLINK, totReal, totDATE;

CONST
   NumberError: array[1..2] of string[60] =
   (' The number you entered is out of range. ',
   ' Enter a number in the following range: ');
   DateError: array[1..6] of string[60] = 
   (' The date you entered is invalid. ',
    ' Enter a date in the format:',
    ' The date you entered is too early. ',
    ' The earliest acceptable date is: ',
    ' The date you entered is too late. ',
    ' The latest acceptable date is: ');

TYPE
pSingleLineIOOBJ = ^SingleLineIOOBJ;
SingleLineIOOBJ = object (VisibleIOOBJ)
   vInsert: boolean;      {is field initially in insert mode}
   vRules: byte;          {erasedefault, jumpiffull..... etc.}
   vFirstKey: boolean;    {has the user entered a key yet}
   vDispChar: char;       {character displayed when key is pressed}
   vPad : Char;           {character used to pad empty part of field}
   {methods ...}
   constructor Init;
   procedure   SetIns(InsOn:boolean);
   procedure   SetRules(Rules:byte);
   procedure   SetDispChar(Ch:char);
   procedure   SetPadChar(Pad:char);
   procedure   SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
   procedure   InsertAction(InsOn:boolean);                     VIRTUAL;
   destructor  Done;                                            VIRTUAL;
end;  {SingleLineIOOBJ}

pCharIOOBJ = ^CharIOOBJ;
CharIOOBJ = object (SingleLineIOOBJ)
   vFieldLen: byte;
   vMaxlen : byte;
   vInputStr: StrScreen;
   vCursor: tCursPos;     {cursleft cursright cursprevious}
   vCursorStr: byte;      {position of cursor in string}
   vJust: tJust;          {left center right}
   {methods ...}
   constructor Init(X,Y,FieldLen: byte);
   procedure   SetJust(Just:tJust);
   procedure   SetCursor(Curs: tCursPos);
   procedure   ClearMessage;
   function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
   function    CharOK(var Ch:char): boolean;                    VIRTUAL;
   procedure   Erase;                                           VIRTUAL;
   procedure   CursorEnd;                                       VIRTUAL;
   procedure   CursorHome;                                      VIRTUAL;
   procedure   CursorLeft;                                      VIRTUAL;
   procedure   CursorRight;                                     VIRTUAL;
   procedure   DeleteChar;                                      VIRTUAL;
   procedure   Backspace;                                       VIRTUAL;
   procedure   MoveCursor;                                      VIRTUAL;
   function    ProcessEnter:tAction;                            VIRTUAL;
   procedure   ReDisplay(Status:tStatus);                       VIRTUAL;
   procedure   PosCursor;                                       VIRTUAL;
   procedure   Display(Status:tStatus);                         VIRTUAL;
   procedure   ProcessChar(Ch:char);                            VIRTUAL;
   procedure   Activate;                                        VIRTUAL;
   function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
   function    Suspend:boolean;                                 VIRTUAL;
   destructor  Done;                                            VIRTUAL;
end; {object CharIOOBJ}

pStringIOOBJ = ^StringIOOBJ;
StringIOOBJ = object (CharIOOBJ)
   vCase: tCase;            {lower upper proper}
   vForceCase: boolean;     {adjust case of characters during input}
   {methods ...}
   constructor Init(X,Y,FieldLen: byte);
   procedure   SetCase(Cas:tCase);
   procedure   SetForceCase(On:boolean);
   procedure   SetValue(Str:string);
   function    GetValue: string;
   procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {StringIOOBJ}

pPictureIOOBJ = ^PictureIOOBJ;
PictureIOOBJ = object (StringIOOBJ)
   vPicture: string[80];
   vCursorScr: byte;          {position of cursor including format characters}
   vAllowChar: string[40];    {allowable characters}
   vDisAllowChar: string[40]; {disallowed characters}
   {methods ...}
   constructor Init(X,Y: byte;Pic:string);
   function    InputChars: byte;
   function    CursorOffset(InputPos:byte):byte;
   procedure   SetAllowChar(Str:string);
   procedure   SetDisallowChar(Str:string);
   function    GetValue: string;
   function    GetPicValue: string;
   function    CharOK(var Ch:char):boolean;                 VIRTUAL;
   procedure   Erase;                                       VIRTUAL;
   procedure   CursorEnd;                                   VIRTUAL;
   procedure   CursorHome;                                  VIRTUAL;
   procedure   CursorLeft;                                  VIRTUAL;
   procedure   CursorRight;                                 VIRTUAL;
   procedure   DeleteChar;                                  VIRTUAL;
   procedure   Backspace;                                   VIRTUAL;
   procedure   PosCursor;                                   VIRTUAL;
   procedure   MoveCursor;                                  VIRTUAL;
   procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {PictureIOOBJ}

pLateralIOOBJ = ^LateralIOOBJ;
LateralIOOBJ = object (StringIOOBJ)
   vStartChar: byte;         {the number of the first visible character}
   {methods ...}
   constructor Init(X,Y,FieldLen,MaxLen: byte);
   function    CursorOffset(InputPos:byte):byte;
   function    GetValue: string;
   procedure   Erase;                                       VIRTUAL;
   procedure   CursorEnd;                                   VIRTUAL;
   procedure   CursorHome;                                  VIRTUAL;
   procedure   CursorLeft;                                  VIRTUAL;
   procedure   CursorRight;                                 VIRTUAL;
   procedure   DeleteChar;                                  VIRTUAL;
   procedure   Backspace;                                   VIRTUAL;
   procedure   PosCursor;                                   VIRTUAL;
   procedure   MoveCursor;                                  VIRTUAL;
   procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {LateralIOOBJ}

pListIOOBJ = ^ListIOOBJ;
ListIOOBJ = object (MultiLineIOOBJ)
   vTopPick: integer;         {number of first pick in window}
   vTotPicks: integer;        {total number of picks}
   vListAssigned: boolean;    {is data assigned to list}
   vScrollBarOn: boolean;     {is the vertical scrollbar required}
   vBoxBorder: boolean;       {is the list enclosed in a box}
   vActivePick: integer;      {the offset of the active pick from the top}
   vActiveField: boolean;     {is field highlighted}
   {methods ...}
   constructor Init(X1,Y1,width,depth:byte;Title:string);
   procedure   WriteItem(Item:integer; Selected:boolean);
   procedure   DisplayAllPicks;
   procedure   RefreshScrollbar;
   function    HitItem(Y:byte):byte;
   procedure   ScrollJump(Y:byte);
   procedure   ScrollUp;
   procedure   ScrollDown;
   procedure   ScrollPgUp;
   procedure   ScrollPgDn;
   procedure   ScrollEnd;
   procedure   ScrollHome;
   procedure   AdjustMouseKey(var InKey: word;X,Y:byte);
   function    TargetPick(X,Y:byte): longint;
   procedure   MouseChoose(X,Y:byte);
   function    GetValue: integer;
   procedure   ShowItemDetails(HiPick: integer);            VIRTUAL;
   function    SelectPick(InKey:word;X,Y:byte): tAction;    VIRTUAL;
   function    Select(K:word; X,Y:byte):tAction;            VIRTUAL;
   function    ProcessKey(InKey:word;X,Y:byte):tAction;     VIRTUAL;
   procedure   Display(Status:tStatus);                     VIRTUAL;
   function    Suspend:boolean;                             VIRTUAL;
   function    GetString(Pick:integer): string;             VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {ListIOOBJ}

pArrayIOOBJ = ^ArrayIOOBJ;
ArrayIOOBJ = object (ListIOOBJ)
   vArrayPtr: pointer;
   vStrLength: byte;
   {methods ...}
   constructor Init(X1,Y1,width,depth:byte;Title:string);
   procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
   function    GetString(Pick:integer): string;             VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {ArrayIOOBJ}

pLinkIOOBJ = ^LinkIOOBJ;
LinkIOOBJ = object (ListIOOBJ)
   vLinkList: ^DLLOBJ;
   {methods ...}
   constructor Init(X1,Y1,width,depth:byte;Title:string);
   procedure   AssignList(var LinkList: DLLOBJ);
   function    GetString(Pick:integer): string;             VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {LinkIOOBJ}

pIntIOOBJ = ^IntIOOBJ;
IntIOOBJ = object (CharIOOBJ)
   vMin: longint;
   vMax: longint;
   vFmtPtr: pFmtNumberOBJ;
   {methods...}
   constructor Init(X,Y,Len: byte);
   procedure   InitFormat;
   function    FormatPtr: pFmtNumberOBJ;
   function    GetValue: longint;
   procedure   SetValue(Val:longint);
   procedure   SetMinMax(Min,Max: longint);
   function    CharOK(var Ch:char):boolean;                 VIRTUAL;
   procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
   function    Suspend:boolean;                             VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {object IntIOOBJ}

pRealIOOBJ = ^RealIOOBJ;
RealIOOBJ = object (CharIOOBJ)
   vMin: Extended;
   vMax: Extended;
   vENotation: boolean;
   vFmtPtr: pFmtNumberOBJ;
   {methods...}
   constructor Init(X,Y,Len:byte);
   procedure   InitFormat;
   function    FormatPtr: pFmtNumberOBJ;
   function    GetValue: extended;
   procedure   SetMinMax(Min,Max:extended);
   procedure   SetValue(Val:extended);
   procedure   SetENotation(On:Boolean);
   function    CharOK(var Ch:char):boolean;                 VIRTUAL;
   procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
   function    Suspend:boolean;                             VIRTUAL;
   destructor  Done;                                        VIRTUAL;
end; {RealIOOBJ}

pFixedRealIOOBJ = ^FixedRealIOOBJ;
FixedRealIOOBJ = object (SingleLineIOOBJ)
   vMin: Extended;
   vMax: Extended;
   vDP: byte;
   vWholeP: byte;
   vMaxlen : byte;
   vCursorPos: byte;
   vWholeStr: StrVisible;
   vDPStr: string[20]; {max significance of Turbo reals}
   vFmtPtr: pFmtNumberOBJ;
   {methods...}
   constructor Init(X,Y,Whole,DP:byte);
   procedure   InitFormat;
   function    FormatPtr: pFmtNumberOBJ;
   procedure   Erase;
   procedure   CursorEnd;
   procedure   CursorHome;
   procedure   CursorLeft;
   procedure   CursorRight;
   procedure   DeleteChar;
   procedure   Backspace;
   function    GetValue: extended;
   procedure   SetMinMax(Min,Max:extended);
   procedure   SetValue(Val:extended);
   procedure   ProcessChar(Ch:char);
   function    ProcessEnter:tAction;
   procedure   Condense;
   procedure   PeriodHit;
   procedure   PlusHit;
   procedure   MinusHit;
   procedure   MoveCursor;
   procedure   Display(Status:tStatus);                         VIRTUAL;
   function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
   procedure   Activate;                                        VIRTUAL;
   function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
   function    Suspend:boolean;                                 VIRTUAL;
   destructor  Done;                                            VIRTUAL;
end; {FixedRealIOOBJ}

pDateIOOBJ = ^DateIOOBJ;
DateIOOBJ = object (PictureIOOBJ)
   vDateFmt: tdate;
   vMin: longint;
   vMax: longint;
   {methods...}
   constructor Init(X,Y:byte;DateFmt:tDate);
   procedure   SetMinMax(Min,Max:longint);
   procedure   SetValue(Date:longint);
   function    GetValue: longint;
   function    Suspend:boolean;                                 VIRTUAL;
   destructor  Done;                                            VIRTUAL;
end; {DateIOOBJ}

pHexIOOBJ = ^HexIOOBJ;
HexIOOBJ = object (PictureIOOBJ)
   vMin: longint;
   vMax: longint;
   {methods...}
   constructor Init(X,Y,Len:byte);
   procedure   SetMinMax(Min,Max:longint);
   procedure   SetValue(Val:longint);
   function    GetValue: longint;
   function    Suspend:boolean;                                 VIRTUAL;
   destructor  Done;                                            VIRTUAL;
end; {HexIOOBJ}

procedure IO2Init;

var
  FmtNumberTOT: FmtNumberOBJ;
  
IMPLEMENTATION

procedure ValidationMessage(Line1,Line2,Line3,Line4:string);
{}
var
   Msg: MessageOBJ;
begin
   with Msg do
   begin
      Init(2,' Invalid Input! ');
      AddLine('');
      AddLine(' '+Line1);
      AddLine(' '+Line2);
      AddLine(' '+Line3);
      AddLine(' '+Line4);
      AddLine('');
      Show;
      Done;
   end; {with}
end; {ValidationMessage}
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                      }
{     S i n g l e L i n e I O O B J   M E T H O D S    }
{                                                      }
{||||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor SingleLineIOOBJ.Init;
{}
begin
   VisibleIOOBJ.Init;
   vDispChar := ' ';
   vInsert := IOTOT^.InputIns;
   vRules := IOTOT^.InputRules;
   vPad := IOTOT^.InputPad;
end; {SingleLineIOOBJ.Init}

procedure SingleLineIOOBJ.InsertAction(InsOn:boolean);
{}
begin
   if InsOn then
      Screen.CursHalf
   else
      Screen.CursOn;
end; {SingleLineIOOBJ.ChangeMode}

procedure SingleLineIOOBJ.SetIns(InsOn:boolean);
{}
begin
   vInsert := InsOn;
end; {SingleLineIOOBJ.SetIns}

procedure SingleLineIOOBJ.SetRules(Rules:byte);
{}
begin
   vRules := Rules;
end; {SetRules}

procedure SingleLineIOOBJ.SetPadChar(Pad:char);
{}
begin
   vPad := Pad;
end; {SingleLineIOOBJ.SetPadChar}

procedure SingleLineIOOBJ.SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
{}
begin
   case Status of
   HiStatus:    Attr := IOTOT^.FieldCol(2);
   Norm:  Attr := IOTOT^.FieldCol(1);
   Off:   Attr := IOTOT^.FieldCol(4);
   end; {case}
   if (vDispChar <> ' ') then
      Str := Replicate(length(Str),vDispChar);
end; {SingleLineIOOBJ.SetFieldAttr}

procedure SingleLineIOOBJ.SetDispChar(Ch:char);
{}
begin
   vDispChar := Ch;
end; {SingleLineIOOBJ.SetDispChar}

destructor SingleLineIOOBJ.Done;
{}
begin
   VisibleIOOBJ.Done;
end; {SingleLineIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||}
{                                          }
{     C h a r I O O B J   M E T H O D S    }
{                                          }
{||||||||||||||||||||||||||||||||||||||||||}
constructor CharIOOBJ.Init(X,Y,FieldLen: byte);
{}
var
  W : byte;
begin
   SingleLineIOOBJ.Init;
   vInputStr := '';
   vCursor := IOTOT^.InputCursorLoc;
   vCursorStr := 1;
   vJust := IOTOT^.InputJust;
{$IFDEF CHECK}
   W := Monitor^.Width;
   if X > W then
      vBoundary.X1 := 1
   else
      vBoundary.X1 := X;
   vBoundary.Y1 := Y;
   vBoundary.Y2 := vBoundary.Y1;
   if pred(vBoundary.X1 + FieldLen) > W then
      vFieldLen := succ(W - vBoundary.X1)
   else
      vFieldLen := FieldLen;
   vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
{$ELSE}
   vBoundary.X1 := X;
   vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
   vBoundary.Y1 := Y;
   vBoundary.Y2 := vBoundary.Y1;
   vFieldlen := FieldLen;
{$ENDIF}
   vMaxlen := vFieldLen;
end; {cons CharIOOBJ.Init}

procedure CharIOOBJ.SetCursor(Curs:tCursPos);
{}
begin
   vCursor := Curs;
end; {CharIOOBJ.SetCurs}

procedure CharIOOBJ.SetJust(Just:tJust);
{}
begin
   vJust := Just;
end; {CharIOOBJ.SetJust}

procedure CharIOOBJ.CursorHome;
{}
begin
   vCursorStr := 1;
   Display(HiStatus);
end; {CharIOOBJ.CursorHome}

procedure CharIOOBJ.CursorEnd;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
      vCursorStr := succ(length(vInputStr));
end; {CharIOOBJ.CursorEnd}

procedure CharIOOBJ.CursorLeft;
{}
begin
   if vCursorStr > 1 then
      dec(vCursorStr);
end; {CharIOOBJ.CursorLeft}

procedure CharIOOBJ.CursorRight;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
         inc(vCursorStr);
end; {CharIOOBJ.CursorRight}

procedure CharIOOBJ.Erase;
{}
begin
   vInputStr := '';
   vCursorStr := 1;
   Display(HiStatus);
end; {CharIOOBJ.Erase}

procedure CharIOOBJ.DeleteChar;
{}
begin
  delete(vInputStr,vCursorStr,1);
  Display(HiStatus);
end; {CharIOOBJ.DeleteChar}

procedure CharIOOBJ.BackSpace;
{}
begin
   if vCursorStr > 1 then
   begin
      CursorLeft;
      DeleteChar;
      Display(HiStatus)
   end;
end; {CharIOOBJ.BackSpace}

function CharIOOBJ.ProcessEnter:tAction;
{}
begin
   ProcessEnter := Enter;
end; {CharIOOBJ.ProcessEnter}

procedure CharIOOBJ.MoveCursor;
{}
begin
   Screen.GotoXY(pred(vBoundary.X1)+vCursorStr,vBoundary.Y1);
end; {CharIOOBJ.MoveCursor}

procedure CharIOOBJ.PosCursor;
{}
begin
   case vCursor of
      CursLeft:  vCursorStr := 1;
      CursRight: vCursorStr := succ(length(vInputStr));
      CursPrev:  {do nothing};
   end; {case}
end; {CharIOOBJ.PosCursor}

procedure CharIOOBJ.ReDisplay(Status:tStatus);
{abstract}
begin end;

procedure CharIOOBJ.Display(Status:tStatus);
{}
begin
   PosCursor;
   ReDisplay(Status);
end; {CharIOOBJ.Display}

function CharIOOBJ.CharOK(var Ch:char): boolean;
{}
begin
   CharOK := true;
end; {CharIOOBJ.CharOK}

procedure CharIOOBJ.ProcessChar(Ch:char);
{}

   procedure EraseOld;
   {}
   begin
      if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
         Erase;
   end; {EraseOld}

begin
   if ( ( (vInsert and (length(vInputStr) >= vMaxlen))
          or
          (vCursorStr > vMaxLen)
        )
        and
        ((vFirstKey and ((vRules and EraseDefault) = EraseDefault))=false)
      ) then
      Ding
   else
   begin
      if CharOK(Ch) then
         EraseOld
      else
      begin
         Ding;
         exit
      end;
      if not vInsert then
         Delete(vInputStr,vCursorStr,1);
      insert(Ch,vInputStr,vCursorStr);
      CursorRight;
      ReDisplay(HiStatus);
   end;
end; {CharIOOBJ.ProcessChar}

function CharIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
{}
begin
   Case InKey of
      8: BackSpace;
      288: Erase;  {Alt-D}
      339: DeleteChar;
      327: CursorHome;
      335: CursorEnd;
      331: CursorLeft;
      333: CursorRight;
      338: begin
              vInsert := not vInsert;
              InsertAction(vInsert);
           end;
      32..255: ProcessChar(chr(InKey));    {characters}
   end; {case}
   case InKey of
      523,13: ProcessKey := ProcessEnter;
      27: ProcessKey := Escaped;
      else 
      begin
         if  ((vRules and JumpIfFull) = JumpIfFull)
         and (length(vInputStr) >= vMaxlen)
         and ( (Inkey >= 32) and (InKey <= 255)) 
         and (vCursorStr > vMaxLen) then
            ProcessKey := NextField
         else
            ProcessKey := None;
      end;
   end;
   vFirstKey := false;
   MoveCursor;
end; {CharIOOBJ.ProcessKey}

procedure CharIOOBJ.Activate;
{}
var
   Action: tAction;
begin
   repeat
      Action := Select(0,0,0);
      Display(HiStatus);
      WriteLabel(HiStatus);
      with Key do 
      repeat
         GetInput;
         if LastKey = 27 then
            Action := Escaped
         else
            Action := ProcessKey(LastKey,LastX,LastY);
      until Action in [Finished,Escaped,Enter];
   until (Action = Escaped) or Suspend;
end; {CharIOOBJ.Activate}

function CharIOOBJ.Select(K:word; X,Y:byte): tAction;
{}
begin
   Display(HiStatus);
   WriteLabel(HiStatus);
   WriteMessage;
   vFirstKey := true;
   InsertAction(vInsert);
   PosCursor;
   MoveCursor;
   Select := None;
end; {CharIOOBJ.Select}

procedure CharIOOBJ.ClearMessage;
{}
var Col,L: byte;
begin
   if vMsgPtr <> Nil then   {clear the message}
   begin
      move(vMsgPtr^,L,1);
      if L > 0 then
      begin
         Col := IOTOT^.MessageCol;
         if Col = 0 then
            Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
         else
            Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
      end;
   end;
end; {CharIOOBJ.ClearMessage}

function CharIOOBJ.Suspend:boolean;
{}
begin
   ReDisplay(Norm);
   WriteLabel(Norm);
   ClearMessage;
   Suspend := true;
end; {CharIOOBJ.Suspend}

destructor CharIOOBJ.Done;
{}
begin
   SingleLineIOOBJ.Done;
end; {CharIOOBJ.Done}

{||||||||||||||||||||||||||||||||||||||||||||||}
{                                              }
{     S t r F i e l d O B J   M E T H O D S    }
{                                              }
{||||||||||||||||||||||||||||||||||||||||||||||}
constructor StringIOOBJ.Init(X,Y,FieldLen: byte);
{}
begin
   CharIOOBJ.Init(X,Y,FieldLen);
   vCase := IOTOT^.InputCase;
   vForceCase := IOTOT^.InputForceCase;
end; {StringIOOBJ.Init}

procedure StringIOOBJ.SetValue(Str:string);
{}
begin
   vInputStr := Str;
   if vCursorStr > succ(length(Str)) then
      vCursorStr :=  succ(length(Str));
   PosCursor;
end; {StringIOOBJ.SetValue}

procedure StringIOOBJ.SetCase(Cas:tCase);
{}
begin
   vCase := Cas;
end; {StringIOOBJ.SetCase}

procedure StringIOOBJ.SetForceCase(On:boolean);
{}
begin
   vForceCase := On;
end; {StringIOOBJ.SetForceCase}

function StringIOOBJ.GetValue: string;
{}
begin
   GetValue := vInputStr;
end; {StringIOOBJ.GetValue}

procedure StringIOOBJ.ReDisplay(Status:tStatus);
{}
var
  A: byte;
  AdjStr: String;
begin
   if (Status <> HiStatus)
   or ((Status = HiStatus) and vForceCase) then
      vInputStr := AdjCase(vCase,vInputStr);
   if (vDispChar = ' ') then
      AdjStr := vInputStr
   else
      AdjStr := Replicate(length(vInputStr),vDispChar);
   if Status = HiStatus then
   begin
     SetFieldAttr(Status,A,AdjStr);
     Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(AdjStr,vFieldlen,vPad));
   end
   else
   begin
      SetFieldAttr(Status,A,AdjStr);  {was norm}
      AdjStr := Pad(vJust,AdjStr,vFieldLen,vPad);
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
   end;
end; {StringIOOBJ.ReDisplay}

destructor StringIOOBJ.Done;
{}
begin
   CharIOOBJ.Done;
end; {StringIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                    }
{     P i c S t r F i e l d O B J   M E T H O D S    }
{                                                    }
{||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor PictureIOOBJ.Init(X,Y: byte;Pic:string);
{}
begin
   StringIOOBJ.Init(X,Y,length(Pic));
   vPicture := Pic;
   vFieldLen := InputChars;
   vMaxlen := vFieldlen;
   vAllowChar := '';
   vDisAllowChar := '';
   SetIns(IOTOT^.InputIns);
end; {PictureIOOBJ.Init}

function PictureIOOBJ.InputChars: byte;
{}
var
  Counter : byte;
  I : integer;
begin
  Counter := 0;
  for I := 1 to length(vPicture) do
      if vPicture[I] in FmtChars then
         Inc(Counter);
  InputChars := counter;
end; {PictureIOOBJ.InputChars}

procedure PictureIOOBJ.SetAllowChar(Str:string);
{}
begin
   vAllowChar := Str;
end; {PictureIOOBJ.SetAllowChar}

procedure PictureIOOBJ.SetDisAllowChar(Str:string);
{}
begin
   vDisAllowChar := Str;
end; {PictureIOOBJ.SetDisAllowChar}

procedure PictureIOOBJ.ReDisplay(Status:tStatus);
{}
var
  A,B,Len: byte;
  Counter,I: integer;
  AdjStr,
  TempStr : string;
begin
   AdjStr := vInputStr;
   SetFieldAttr(Status,A,AdjStr);
   if Status <> HiStatus Then
   begin
      vInputStr := AdjCase(vCase,vInputStr);
      TempStr := PicFormat(AdjStr,vPicture,vPad);
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
   end
   else
   begin
     B := IOTot^.FieldCol(3);
     Counter := 0;
     Len := length(vInputStr);
     for I := 1 to length(vPicture) do
     begin
        if (vPicture[I] in FmtChars) then
        begin
           inc(Counter);
           if Counter <= Len then
              Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vInputStr[Counter])
           else
              Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vPad);
        end
        else
           Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,B,vPicture[I]);
     end;
   end;
end; {PictureIOOBJ.ReDisplay}

function PictureIOOBJ.CursorOffset(InputPos:byte):byte;
{}
var
   Counter: byte;
   CharPos: byte;
   L : byte;
begin
   Counter := 0;
   CharPos := 0;
   L := length(vPicture);
   repeat
      inc(Counter);
      if vPicture[Counter] in FmtChars then
         inc(CharPos);
   until (CharPos = InputPos) or (Counter > L);
   CursorOffset := Counter + pred(vBoundary.X1);
end; {PictureIOOBJ.CursorOffset}

procedure PictureIOOBJ.PosCursor;
{}
begin
   StringIOOBJ.PosCursor;
   vCursorScr := CursorOffset(vCursorStr);
end; {PictureIOOBJ.PosCursor}

procedure PictureIOOBJ.Erase;
{}
begin
   vInputStr := '';
   vCursorStr := 1;
   PosCursor;
   Display(HiStatus);
end; {PictureIOOBJ.Erase}

procedure PictureIOOBJ.CursorHome;
{}
begin
   vCursorStr := 1;
   vCursorScr := CursorOffset(vCursorStr);
end; {PictureIOOBJ.CursorHome}

procedure PictureIOOBJ.CursorEnd;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
   begin
      vCursorStr := succ(length(vInputStr));
      vCursorScr := CursorOffset(vCursorStr);
   end;
end; {PictureIOOBJ.CursorEnd}

procedure PictureIOOBJ.CursorLeft;
{}
begin
   if vCursorStr > 1 then
   begin
      dec(vCursorStr);
      Repeat
         dec(vCursorScr);
      Until vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars;
   end;
end; {PictureIOOBJ.CursorLeft}

procedure PictureIOOBJ.CursorRight;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
   begin
      Inc(vCursorStr);
      Repeat
         Inc(vCursorScr);
      Until (succ(vCursorScr-vBoundary.X1) > length(vPicture))
         or (vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars);
   end;
end; {PictureIOOBJ.CursorRight}

procedure PictureIOOBJ.DeleteChar;
{}
begin
  delete(vInputStr,vCursorStr,1);
  ReDisplay(HiStatus);
end; {PictureIOOBJ.DeleteChar}

procedure PictureIOOBJ.BackSpace;
{}
begin
   if vCursorStr > 1 then
   begin
      CursorLeft;
      DeleteChar;
      ReDisplay(HiStatus)
   end;
end; {PictureIOOBJ.BackSpace}

function PictureIOOBJ.CharOK(var Ch:char):boolean;
{}
var
   PicChar : char;
begin
   if ((vAllowChar <> '') and (pos(Ch,vAllowChar) = 0))
   or ((vDisAllowChar <> '') and (pos(Ch,vDisAllowChar) > 0)) then
      CharOK := false
   else
   begin
      PicChar := vPicture[succ(vCursorScr - vBoundary.X1)];
      if PicChar = '!' then
         Ch := upcase(Ch);
      CharOK :=  ((Ch in ['0'..'9',FmtNumberTOT.GetDecimal,'-']) and (PicChar = '#'))
              or ((AlphabetTOT^.IsLetter(ord(Ch)) or AlphabetTOT^.IsPunctuation(ord(Ch))) and (PicChar = '@'))
              or (PicChar in ['*','!']);
      end;
end; {PictureIOOBJ.CharOK}

procedure PictureIOOBJ.MoveCursor;
{}
begin
   Screen.GotoXY(vCursorScr,vBoundary.Y1);
end; {PictureIOOBJ.MoveCursor}

function PictureIOOBJ.GetValue:string;
{}
begin
   GetValue := vInputStr;
end; {PictureIOOBJ.GetValue}

function PictureIOOBJ.GetPicValue:string;
{}
begin
   GetPicValue := PicFormat(vInputStr,vPicture,' ');
end; {PictureIOOBJ.GetPicValue}

destructor PictureIOOBJ.Done;
{}
begin
   CharIOOBJ.Done;
end; {PictureIOOBJ.Done}

{||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                }
{     L a t e r a l I O O B J   M E T H O D S    }
{                                                }
{||||||||||||||||||||||||||||||||||||||||||||||||}

constructor LateralIOOBJ.Init(X,Y,FieldLen,MaxLen: byte);
{}
begin
   StringIOOBJ.Init(X,Y,FieldLen);
   vStartChar := 1;
{$IFDEF CHECK}
   if Maxlen < vFieldlen then
      vMaxlen := vFieldLen
   else
      vMaxLen := MaxLen;
{$ELSE}
   vMaxLen := MaxLen;
{$ENDIF}
end; {LateralIOOBJ.Init}

procedure LateralIOOBJ.ReDisplay(Status:tStatus);
{}
var
  A: byte;
  AdjStr,
  TempStr : string;
begin
   if (Status <> HiStatus)
   or ((Status = HiStatus) and vForceCase) then
      vInputStr := AdjCase(vCase,vInputStr);
   case Status of
     HiStatus:    A:= IOTOT^.FieldCol(2);
     Norm:  A:= IOTOT^.FieldCol(1);
     Off:   A:= IOTOT^.FieldCol(4);
   end; {case}
   if (vDispChar = ' ') then
      AdjStr := vInputStr
   else
      AdjStr := Replicate(length(vInputStr),vDispChar);
   if Status <> HiStatus then
      vInputStr := AdjCase(vCase,vInputStr);
   TempStr := TruncFormat(AdjStr,vStartChar,vFieldLen,vPad);
   Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
end; {LateralIOOBJ.ReDisplay}

function LateralIOOBJ.CursorOffset(InputPos:byte):byte;
{}
begin
   CursorOffset := succ(InputPos - vStartChar)
end; {LateralIOOBJ.CursorOffset}

procedure LateralIOOBJ.PosCursor;
{}
begin
   case vCursor of
      CursLeft:  begin
                    vCursorStr := 1;
                    vStartChar := 1;
                 end;
      CursRight: begin
                    vCursorStr := succ(length(vInputStr));
                    if vCursorStr - vStartChar > vFieldLen then
                       vStartChar := vCursorStr - vFieldLen;
                 end;
      CursPrev:  {do nothing};
   end; {case}
end; {LateralIOOBJ.PosCursor}

procedure LateralIOOBJ.CursorHome;
{}
begin
   vCursorStr := 1;
   if vStartChar <> 1 then
   begin
      vStartChar := 1;
      ReDisplay(HiStatus);
   end;
end; {LateralIOOBJ.CursorHome}

procedure LateralIOOBJ.CursorEnd;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
   begin
      vCursorStr := succ(length(vInputStr));
      if (vCursorStr - vStartChar) > vFieldLen then
      begin
         vStartChar := vCursorStr - vFieldLen;
         ReDisplay(HiStatus);
      end;
   end;
end; {LateralIOOBJ.CursorEnd}

procedure LateralIOOBJ.CursorLeft;
{}
begin
   if vCursorStr > 1 then
   begin
      if vCursorStr = vStartChar then
      begin
         dec(vStartChar);
         dec(vCursorStr);
         ReDisplay(HiStatus)
      end
      else
         dec(vCursorStr);
   end;
end; {LateralIOOBJ.CursorLeft}

procedure LateralIOOBJ.CursorRight;
{}
begin
   if (vCursorStr <= length(vInputStr)) then
   begin
      if vCursorStr - vStartChar = vFieldLen then
      begin
         inc(vStartChar);
         inc(vCursorStr);
         ReDisplay(HiStatus);
      end
      else
         inc(vCursorStr);
   end;
end; {LateralIOOBJ.CursorRight}

procedure LateralIOOBJ.Erase;
{}
begin
   vInputStr := '';
   vStartChar := 1;
   vCursorStr := 1;
   PosCursor;
   Display(HiStatus);
end; {LateralIOOBJ.Erase}

procedure LateralIOOBJ.DeleteChar;
{}
begin
  delete(vInputStr,vCursorStr,1);
  ReDisplay(HiStatus);
end; {LateralIOOBJ.DeleteChar}

procedure LateralIOOBJ.BackSpace;
{}
begin
   if vCursorStr > 1 then
   begin
      CursorLeft;
      DeleteChar;
      ReDisplay(HiStatus)
   end;
end; {LateralIOOBJ.BackSpace}

procedure LateralIOOBJ.MoveCursor;
{}
begin
   Screen.GotoXY(pred(vBoundary.X1)+vCursorStr - pred(vStartChar),vBoundary.Y1);
end; {LateralIOOBJ.MoveCursor}

function LateralIOOBJ.GetValue:string;
{}
begin
   GetValue := vInputStr;
end; {LateralIOOBJ.GetValue}

destructor LateralIOOBJ.Done;
{}
begin
   CharIOOBJ.Done;
end; {StringFieldOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                }
{     L i s t F i e l d O B J   M E T H O D S    }
{                                                }
{||||||||||||||||||||||||||||||||||||||||||||||||}
{$I totIO2.INC}
{||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                  }
{     A r r a y F i e l d O B J   M E T H O D S    }
{                                                  }
{||||||||||||||||||||||||||||||||||||||||||||||||||}

constructor ArrayIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
{}
begin
   ListIOOBJ.Init(X1,Y1,width,depth,Title);
end; {ArrayIOOBJ.Init}

procedure ArrayIOOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
{}
begin
   vArrayPtr := @StrArray;
   vStrLength := StrLength;
   vTotPicks := Total;
   vListAssigned := true;
end; {ArrayIOOBJ.AssignList}

function ArrayIOOBJ.GetString(Pick:integer): string;
{}
var
  W : word;
  TempStr : String;
  ArrayOffset: word;
begin
   if (Pick > 0) and (Pick <= vTotPicks) then
   begin
      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]));
   end
   else
      TempStr := '';
   W := vBorder.X2 - succ(vBorder.X1);
   GetString := Padleft(TempStr,W,' ');
end; {ArrayIOOBJ.GetString}

destructor ArrayIOOBJ.Done;
{}
begin
   ListIOOBJ.Done;
end; {ArrayIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                }
{     L i s t F i e l d O B J   M E T H O D S    }
{                                                }
{||||||||||||||||||||||||||||||||||||||||||||||||}
constructor LinkIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
{}
begin
   ListIOOBJ.Init(X1,Y1,width,depth,Title);
end; {LinkIOOBJ.Init}

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

function LinkIOOBJ.GetString(Pick:integer): string;
{}
var
  TempPtr : DLLNodePtr;
begin
   TempPtr := vLinkList^.NodePtr(Pick);
   if TempPtr <> Nil then
      vLinkList^.ShiftActiveNode(TempPtr,Pick);
   GetString := vLinkList^.GetStr(TempPtr,1,vBorder.X2 - vBorder.X1);
end; {LinkIOOBJ.GetString}

destructor LinkIOOBJ.Done;
{}
begin
   ListIOOBJ.Done;
end; {LinkIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||}
{                                        }
{     I n t I O O B J   M E T H O D S    }
{                                        }
{||||||||||||||||||||||||||||||||||||||||}
constructor IntIOOBJ.Init(X,Y,Len:byte);
{}
begin
   CharIOOBJ.Init(X,Y,Len);
   vMin := 0;
   vMax := 0;
   vFmtPtr := Nil;
end; {IntIOOBJ.Init}

function IntIOOBJ.FormatPtr: pFmtNumberOBJ;
{}
begin
   FormatPtr := vFmtPtr;
end; {IntIOOBJ.FormatPtr}

procedure IntIOOBJ.InitFormat;
{}
begin
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
   new(vFmtPtr,Init);
   vFmtPtr^ := FmtNumberTOT;
end; {IntIOOBJ.InitFormat}

procedure IntIOOBJ.SetMinMax(Min,Max:longint);
{}
begin
{$IFDEF CHECK}
   if Min > Max then
   begin
     vMax := Min;
     vMin := Max;
   end
   else
   begin
     vMax := Max;
     vMin := Min;
   end;
{$ELSE}
   vMax := Max;
   vMin := Min;
{$ENDIF}
end; {IntIOOBJ.SetMinMax}

procedure IntIOOBJ.SetValue(Val:longint);
{}
begin
   if  ((vRules and SuppressZero) = SuppressZero)
   and (Val = 0) then
      vInputStr := ''
   else
      vInputStr := IntToStr(Val);
{$IFDEF CHECK}
   if VMax <> vMin then
   begin
      if Val < vMin then
         vMin := Val
      else if Val > vMax then
      begin
         vMax := Val;
         vMaxLen := length(IntToStr(vMax));
      end;
   end;
{$ENDIF}
end;  {IntIOOBJ.SetValue}

function IntIOOBJ.GetValue:longint;
{}
begin
   if ValidInt(vInputStr) then
      GetValue := StrToLong(vInputStr)
   else
      GetValue := 0;
end;  {IntIOOBJ.GetValue}

function IntIOOBJ.CharOK(var Ch:char):boolean;
{}
begin
   if (Ch = '+') and ((pos('+',vInputStr)>0) or (vCursorStr > 1))
   or (Ch = '-') and ((pos('-',vInputStr)>0) or (vCursorStr > 1)) then
      CharOK := false
   else
      CharOK :=    (Ch in  ['0'..'9'])
             or (  (Ch='-') and ((vMin=vMax) or (vMin < 0)))
             or (  (Ch='+') and ((vMin=vMax) or (vMax > 0)))
end; {IntIOOBJ.CharOK}

procedure IntIOOBJ.ReDisplay(Status:tStatus);
{}
var
  A: byte;
  AdjStr: String;
  L: longint;
begin
   if (Status = Norm) and (vFmtPtr <> Nil) then
   begin
      L := GetValue;
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
                     IOTOT^.FieldCol(1),
                     vFmtPtr^.FormattedLong(L,vMaxLen))
   end
   else
   begin
      AdjStr := vInputStr;
      SetFieldAttr(Status,A,AdjStr);
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
   end;
end; {IntIOOBJ.ReDisplay}

function IntIOOBJ.Suspend:boolean;
{}
var
  L : longint;
begin
   L := GetValue;
   if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
   and (vMax <> vMin)
   and ((ValidInt(vInputStr) = false) or (L > vMax) or (L < vMin))
   then   {Invalid}
   begin
      ValidationMessage(NumberError[1],
                        NumberError[2],
                        '',
                        IntToStr(vMin)+' - '+IntToStr(vMax));
      Suspend := false;
   end
   else
   begin
      ReDisplay(Norm);
      WriteLabel(Norm);
      ClearMessage;
      Suspend := true;
   end;
end; {IntIOOBJ.Suspend}

destructor IntIOOBJ.Done;
{}
begin
   CharIOOBJ.Done;
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
end; {IntIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||}
{                                          }
{     R e a l I O O B J   M E T H O D S    }
{                                          }
{||||||||||||||||||||||||||||||||||||||||||}
constructor RealIOOBJ.Init(X,Y,Len:byte);
{}
begin
   CharIOOBJ.Init(X,Y,Len);
   vENotation := false;
   vMax := 0;
   vMin := 0;
   vFmtPtr := Nil;
end; {RealIOOBJ.Init}

function RealIOOBJ.FormatPtr: pFmtNumberOBJ;
{}
begin
   FormatPtr := vFmtPtr;
end; {RealIOOBJ.FormatPtr}

procedure RealIOOBJ.InitFormat;
{}
begin
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
   new(vFmtPtr,Init);
   vFmtPtr^ := FmtNumberTOT;
end; {RealIOOBJ.InitFormat}

procedure RealIOOBJ.SetMinMax(Min,Max:extended);
{}
begin
{$IFDEF CHECK}
   if Min > Max then
   begin
     vMax := Min;
     vMin := Max;
   end
   else
   begin
     vMax := Max;
     vMin := Min;
   end;
{$ELSE}
   vMax := Max;
   vMin := Min;
{$ENDIF}
end; {RealIOOBJ.SetMinMax}

procedure RealIOOBJ.SetValue(Val:extended);
{}
begin
   if  ((vRules and SuppressZero) = SuppressZero)
   and (Val = 0.0) then
      vInputStr := ''
   else
   begin
      if vENotation then
         vInputStr := RealtoSciStr(Val,Floating)
      else
         vInputStr := RealToStr(Val,Floating);
   end;
{$IFDEF CHECK}
   if vMax <> vMin then
   begin
      if Val < vMin then
         vMin := Val
      else if Val > vMax then
         vMax := Val;
   end;
{$ENDIF}
end;  {RealIOOBJ.SetValue}

function RealIOOBJ.GetValue:extended;
{}
begin
   if ValidReal(vInputStr) then
      GetValue := StrToReal(vInputStr)
   else
      GetValue := 0;
end;  {RealIOOBJ.GetValue}

procedure RealIOOBJ.SetENotation(On:Boolean);
{}
begin
   vEnotation := On;
end; {RealIOOBJ.SetENotation}

function RealIOOBJ.CharOK(var Ch:char):boolean;
{}
var DC : char;
begin
   DC := FmtNumberTOT.GetDecimal;
   if ((Ch = DC) and (pos(DC,vInputStr)>0)) 
   or ((Ch = '-') and (pos('-',vInputStr)>0))
   or ((Ch = '+') and (pos('+',vInputStr)>0))
   then
      CharOK := false
   else
      CharOK :=    (Ch in  ['0'..'9','+',DC])
                or (  (Ch in ['E','e']) and vENotation)
                or (  (Ch='-') and (vMin < 0));
end; {RealIOOBJ.CharOK}

procedure RealIOOBJ.ReDisplay(Status:tStatus);
{}
var
  A: byte;
  AdjStr: String;
  E: extended;
begin
   if (Status = Norm) and (vFmtPtr <> Nil) then
   begin
      E := GetValue;
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
                     IOTOT^.FieldCol(1),
                     vFmtPtr^.FormattedReal(E,Floating,vMaxLen))
   end
   else
   begin
      AdjStr := vInputStr;
      SetFieldAttr(Status,A,AdjStr);
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
   end;
end; {RealIOOBJ.ReDisplay}

function RealIOOBJ.Suspend:boolean;
{}
var
  E : extended;
  MsgStr: string;
begin
   E := GetValue;
   if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
   and (vMax <> vMin)
   and ((ValidReal(vInputStr) = false) or (E > vMax) or (E < vMin))
   then   {Invalid}
   begin
      if vENotation then
         MsgStr := RealtoSciStr(vMin,Floating)+' - '+RealtoSciStr(vMax,Floating)
      else
         MsgStr := RealToStr(vMin,Floating)+' - '+RealToStr(vMax,Floating);
      ValidationMessage(NumberError[1],
                        NumberError[2],
                        '',
                        MsgStr);
      Suspend := false;
   end
   else
   begin
      ReDisplay(Norm);
      WriteLabel(Norm);
      ClearMessage;
      Suspend := true;
   end;
end; {RealIOOBJ.Suspend}

destructor RealIOOBJ.Done;
{}
begin
   CharIOOBJ.Done;
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
end; {RealIOOBJ.Done}

{||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                    }
{     F i x e d R e a l I O O B J   M E T H O D S    }
{                                                    }
{||||||||||||||||||||||||||||||||||||||||||||||||||||}
constructor FixedRealIOOBJ.Init(X,Y,Whole,DP:byte);
{}
begin
   SingleLineIOOBJ.Init;
   vMax := 0;
   vMin := 0;
   vDP := DP;
   vWholeP := Whole;
   if vDP > 0 then
      vMaxlen := succ(vWholeP) + vDP
   else
      vMaxlen := vWholeP;
   vBoundary.X1 := X;
   vBoundary.X2 := pred(vBoundary.X1 + vMaxlen);
   vBoundary.Y1 := Y;
   vBoundary.Y2 := vBoundary.Y1;
   vCursorPos := 1;
   vPad := ' ';
   vWholeStr:= replicate(vWholeP,vPad);
   vDPStr :=  replicate(vDP,vPad);
   vFmtPtr := Nil;
end; {FixedRealIOOBJ.Init}

function FixedRealIOOBJ.FormatPtr: pFmtNumberOBJ;
{}
begin
   FormatPtr := vFmtPtr;
end; {FixedRealIOOBJ.FormatPtr}

procedure FixedRealIOOBJ.InitFormat;
{}
begin
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
   New(vFmtPtr,Init);
   vFmtPtr^ := FmtNumberTOT;
end; {FixedRealIOOBJ.InitFormat}

procedure FixedRealIOOBJ.SetMinMax(Min,Max:extended);
{}
begin
{$IFDEF CHECK}
   if Min > Max then
   begin
     vMax := Min;
     vMin := Max;
   end
   else
   begin
     vMax := Max;
     vMin := Min;
   end;
{$ELSE}
   vMax := Max;
   vMin := Min;
{$ENDIF}
end; {FixedRealIOOBJ.SetMinMax}

procedure FixedRealIOOBJ.SetValue(Val:extended);
{}
var
  TempStr : string;
  P : Byte;
begin
   vDPStr := replicate(vDP,vPad);
   if ((vRules and SuppressZero) = SuppressZero)
   and (Val = 0.0) then
      vWholeStr := replicate(vWholeP,vPad)
   else
   begin
     TempStr := RealToStr(Val,vDP);
     P := Pos('.',TempStr);
     if (P = 0) or (vDP = 0) then
        vWholeStr := padright(TempStr,vWholeP,vPad)
     else
     begin
        vWholeStr := padright(copy(TempStr,1,pred(P)),vWholeP,vPad);
        vDPStr := padleft(copy(TempStr,succ(P),vDP),vDP,vPad);
     end;
   end;
{$IFDEF CHECK}
   if vMin <> vMax then
   begin
      if Val < vMin then
         vMin := Val
      else if Val > vMax then
         vMax := Val;
   end;
{$ENDIF}
end;  {FixedRealIOOBJ.SetValue}

procedure FixedRealIOOBJ.Condense;
{}
begin
   if vWholeStr [1] = '-' then
   begin
      delete(vWholeStr,1,1);
      vWholeStr := '-'+padright(Strip('A',vPad,vWholeStr),pred(vWholeP),vPad);
   end
   else
      vWholeStr := padright(Strip('A',vPad,vWholeStr),vWholeP,vPad);
   vDPStr := padleft(Strip('A',vPad,vDPStr),vDP,'0');
end; {FixedRealIOOBJ.Condense}

function FixedRealIOOBJ.GetValue:extended;
{}
var ValStr: string;
begin
   Condense;
   ValStr := vWholeStr+'.'+vDPStr;
   ValStr := strip('A',vPad,ValStr);
   if ValidReal(ValStr) then
      GetValue := StrToReal(ValStr)
   else
      GetValue := 0;
end;  {FixedRealIOOBJ.GetValue}

procedure FixedRealIOOBJ.PeriodHit;
{}
begin
   Condense;
   if vDP > 0 then
      vCursorPos := vWholeP + 2
   else
      vCursorPos := vWholeP;
   Display(HiStatus);
end; {FixedRealIOOBJ.PeriodHit}

procedure FixedRealIOOBJ.PlusHit;
{}
var P: byte;
begin
   P := pos('-',vWholeStr);
   if P > 0 then
   begin
      delete(vWholeStr,P,1);
      insert(vPad,vWholeStr,P);
      Display(HiStatus);
   end;
end; {FixedRealIOOBJ.PlusHit}

procedure FixedRealIOOBJ.MinusHit;
{}
var P: byte;
begin
   if vMin >= 0.0 then
      ding
   else
   begin
      P := pos('-',vWholeStr);
      if P = 0 then
      begin
         P := pos(vPad,vWholeStr);
         if P = 0 then
            ding
         else
         begin
            delete(vWholeStr,P,1);
            vWholeStr := '-'+vWholeStr;
         end;
         Display(HiStatus);
         if vCursorPos = 1 then
            CursorRight;
      end;
   end;
end; {FixedRealIOOBJ.MinusHit}

procedure FixedRealIOOBJ.CursorHome;
{}
begin
   vCursorPos := 1;
   Display(HiStatus);
end; {FixedRealIOOBJ.CursorHome}

procedure FixedRealIOOBJ.CursorEnd;
{}
begin
   vCursorPos := vMaxlen;
end; {FixedRealIOOBJ.CursorEnd}

procedure FixedRealIOOBJ.CursorLeft;
{}
begin
   if vCursorPos > 1 then
      dec(vCursorPos);
   if (vCursorPos = succ(vWholeP)) then
      dec(vCursorPos);
end; {FixedRealIOOBJ.CursorLeft}

procedure FixedRealIOOBJ.CursorRight;
{}
begin
   if vCursorPos < vMaxlen then
      inc(vCursorPos);
   if (vCursorPos = succ(vWholeP)) then
      inc(vCursorPos);
end; {FixedRealIOOBJ.CursorRight}

procedure FixedRealIOOBJ.Erase;
{}
begin
   vWholeStr := replicate(vWholeP,vPad);
   vDPStr := replicate(vDP,vPad);
   vCursorPos := 1;
   Display(HiStatus);
end; {FixedRealIOOBJ.Erase}

procedure FixedRealIOOBJ.DeleteChar;
{}
var P : byte;
begin
  if vCursorPos  <= vWholeP then
  begin
     P := vCursorPos-(vWholeP-length(vWholeStr));
     delete(vWholeStr,P,1);
     insert(vPad,vWholeStr,P);
  end
  else
  begin
     P := vCursorPos - succ(vWholeP);
     delete(vDPStr,P,1);
     insert(vPad,vDPStr,P);
  end;
  Display(HiStatus);
end; {FixedRealIOOBJ.DeleteChar}

procedure FixedRealIOOBJ.BackSpace;
{}
begin
   if vCursorPos > 1 then
   begin
      CursorLeft;
      DeleteChar;
      Display(HiStatus)
   end;
end; {FixedRealIOOBJ.BackSpace}

function FixedRealIOOBJ.ProcessEnter:tAction;
{}
begin

   ProcessEnter := Enter;
end; {FixedRealIOOBJ.ProcessEnter}

procedure FixedRealIOOBJ.MoveCursor;
{}
begin
   Screen.GotoXY(pred(vBoundary.X1)+vCursorPos,vBoundary.Y1);
end; {FixedRealIOOBJ.MoveCursor}

procedure FixedRealIOOBJ.Display(Status:tStatus);
{}
var
  A: byte;
  AdjStr: String;
  E: Extended;
begin
   if (Status <> HiStatus) and (vFmtPtr <> nil) then
   begin
      E := GetValue;
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
                     IOTOT^.FieldCol(1),
                     vFmtPtr^.FormattedReal(E,vDP,vMaxLen))
   end
   else
   begin
      AdjStr := vWholeStr;
      if vDP > 0 then
         AdjStr := AdjStr + FmtNumberTOT.GetDecimal+vDPStr;
      SetFieldAttr(Status,A,AdjStr);
      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
   end;
end; {FixedRealIOOBJ.Display}

procedure FixedRealIOOBJ.ProcessChar(Ch:char);
{}
var
  P,WholePos,DPPos: byte;

   procedure EraseOld;
   {}
   begin
      if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
         Erase;
   end; {EraseOld}

begin
   if Ch in ['0'..'9'] then
      EraseOld
   else
   begin
      Ding;
      exit
   end;
   WholePos := vCursorPos-(vWholeP-length(vWholeStr));
   if vCursorPos > vWholeP then  {entering decimals}
      DPPos := vCursorPos - succ(vWholeP)
   else
      DPPos := 0;
   if not vInsert then
   begin
      if DPPOS > 0 then  {entering decimals}
      begin
         delete(vDPStr,DPPos,1);
         insert(Ch,vDPStr,DPPos);
      end
      else  {entering whole numbers}
      begin
         delete(vWholeStr,WholePos,1);
         insert(Ch,vWholeStr,WholePos);
      end;
   end
   else
   begin
      if DPPos > 0 then  {entering decimals}
      begin
         if vDPStr[DPPos] = vPad then
         begin
            delete(vDPStr,DPPos,1);
            insert(Ch,vDPStr,DPPos);
         end
         else
         begin
            P := PosAfter(vPad,vDPStr,DPPos);
            if P = 0 then   {push a character off the end}
               delete(vDPStr,length(vDPStr),1)
            else
               delete(vDPStr,P,1);
            insert(Ch,vDPStr,DPPos);
         end;
      end
      else  {entering whole numbers}
      begin
         if vWholeStr[WholePos] in [vPad,'-'] then
         begin
            delete(vWholeStr,WholePos,1);
            insert(Ch,vWholeStr,WholePos);
         end
         else
         begin
            P := LastPosBefore(vPad,vWholeStr,WholePos);
            if P = 0 then
               P := pos(vPad,vWholeStr);
            if P = 0 then   {no room for another character}
            begin
               Ding;
               exit;
            end
            else
            begin
               delete(vWholeStr,P,1);
               insert(Ch,vWholeStr,WholePos);
               if WholePos = vWholeP then
               begin
                  Display(HiStatus);  {don't cursor right}
                  exit;
               end;
            end;
         end;
      end;
   end;
   CursorRight;
   Display(HiStatus);
end; {FixedRealIOOBJ.ProcessChar}

function FixedRealIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
{}
begin
   if InKey = ord(FmtNumberTOT.GetDecimal) then
      PeriodHit
   else
   Case InKey of
      8: BackSpace;
      339: DeleteChar;
      327: CursorHome;
      335: CursorEnd;
      331: CursorLeft;
      333: CursorRight;
      338: begin
              vInsert := not vInsert;
              InsertAction(vInsert);
           end;
      ord('+'): PlusHit;
      ord('-'): MinusHit;
      32..255: ProcessChar(chr(InKey));    {characters}
   end; {case}
   case InKey of
      13: ProcessKey := ProcessEnter;
      27: ProcessKey := Escaped;
      else ProcessKey := None;
   end; {case}
   vFirstKey := false;
   MoveCursor;
end; {FixedRealIOOBJ.ProcessKey}

procedure FixedRealIOOBJ.Activate;
{}
var
   Action: tAction;
begin
   repeat
      Action := Select(0,0,0);
      Display(HiStatus);
      WriteLabel(HiStatus);
      with Key do
         repeat
            GetInput;
            Action := ProcessKey(LastKey,LastX,LastY);
         until Action in [Finished,Escaped,Enter];
   until Suspend;
end; {FixedRealIOOBJ.Activate}

function FixedRealIOOBJ.Select(K:word; X,Y:byte): tAction;
{}
begin
   Display(HiStatus);
   WriteLabel(HiStatus);
   InsertAction(vInsert);
   WriteMessage;
   vFirstKey := true;
   MoveCursor;
   Select := None;
end; {FixedRealIOOBJ.Select}

function FixedRealIOOBJ.Suspend:boolean;
{}
var Col,L: byte;
    ValStr: string;
    E : extended;
begin
   E := GetValue;
   Condense;
   ValStr := vWholeStr+'.'+vDPStr;
   ValStr := strip('A',vPad,ValStr);
   if  (((vRules and AllowNull) = AllowNull) and (getValue=0) = false)
   and (vMax <> vMin)
   and ((ValidReal(ValStr) = false) or (E > vMax) or (E < vMin))
   then   {Invalid}
   begin
      ValidationMessage(NumberError[1],
                        NumberError[2],
                        '',
                        RealToStr(vMin,vDP)+' - '+RealToStr(vMax,vDP));
      Suspend := false;
   end
   else
   begin
      Display(Norm);
      WriteLabel(Norm);
      if vMsgPtr <> Nil then   {clear the message}
      begin
         move(vMsgPtr^,L,1);
         if L > 0 then
         begin
            Col := IOTOT^.MessageCol;
            if Col = 0 then
               Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
            else
               Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
         end;
      end;
      Suspend := true;
   end;
end; {FixedRealIOOBJ.Suspend}

destructor FixedRealIOOBJ.Done;
{}
begin
   SingleLineIOOBJ.Done;
   if vFmtPtr <> nil then
      Dispose(vFmtPtr,Done);
end; {FixedRealIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||||}
{                                          }
{     D a t e I O O B J   M E T H O D S    }
{                                          }
{||||||||||||||||||||||||||||||||||||||||||}
constructor DateIOOBJ.Init(X,Y:byte;DateFmt:tDate);
{}
var 
  Pic:string[10];
  Sep:char;
begin
   vDateFmt := DateFmt;
   Sep := DateTOT^.GetSeparator;
   Case vDateFmt of
      MMDDYY,
      DDMMYY,
      YYMMDD:   Pic := '##'+Sep+'##'+Sep+'##';
      MMDDYYYY,
      DDMMYYYY: Pic := '##'+Sep+'##'+Sep+'####';
      MMYY:     Pic := '##'+Sep+'##';
      MMYYYY:   Pic := '##'+Sep+'####';
      YYYYMMDD: Pic := '####'+Sep+'##'+Sep+'##';
   end; {case}
   PictureIOOBJ.Init(X,Y,Pic);
   vMin := 0;
   vMax := 0;
end; {DateIOOBJ.Init}

procedure DateIOOBJ.SetMinMax(Min,Max:longint);
{}
begin
{$IFDEF CHECK}
   if Min > Max then
   begin
     vMax := Min;
     vMin := Max;
   end
   else
   begin
     vMax := Max;
     vMin := Min;
   end;
{$ELSE}
   vMax := Max;
   vMin := Min;
{$ENDIF}
end; {DateIOOBJ.SetMinMax}

procedure DateIOOBJ.SetValue(Date:longint);
{}
begin
   PictureIOOBJ.Setvalue(StripDateStr(JultoStr(Date,vDateFmt),vDateFmt));
end; {DateIOOBJ.SetValue}

function DateIOOBJ.GetValue: longint;
{}
begin
   if vInputStr = '' then
      GetValue := StrToJul('01/01/1980',DDMMYYYY)
   else
      GetValue := StrtoJul(vInputStr,vDateFmt);
end; {DateIOOBJ.GetValue}

function DateIOOBJ.Suspend:boolean;
{}
var
  L : longint;
  OK : boolean;
begin
   L := GetValue;
   OK := ValidDateStr(vInputStr,vDateFmt);
   if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
   and ( (OK = false)
         or ((vMax <> vMin) and ((L > vMax) or (L < vMin)))
       )
   then   {Invalid}
   begin
      if (OK = false) then
         ValidationMessage(DateError[1],
                           DateError[2],
                            '',
                            '      '+DateFormat(vDateFmt))
      else if (L < vMin) then
         ValidationMessage(DateError[3],
                           DateError[4],
                            '',
                            '   '+JulToStr(vMin,vDateFmt))
      else
         ValidationMessage(DateError[5],
                           DateError[6],
                            '',
                            '   '+JulToStr(vMax,vDateFmt));
      Suspend := false;
   end
   else
   begin
      ReDisplay(Norm);
      WriteLabel(Norm);
      ClearMessage;
      Suspend := true;
   end;
end; {DateIOOBJ.Suspend}

destructor DateIOOBJ.Done;
{}
begin
   PictureIOOBJ.Done;
end; {DateIOOBJ.Done}
{||||||||||||||||||||||||||||||||||||||||}
{                                        }
{     H E X I O O B J   M E T H O D S    }
{                                        }
{||||||||||||||||||||||||||||||||||||||||}
constructor HEXIOOBJ.Init(X,Y,Len:byte);
{}
begin
   PictureIOOBJ.Init(X,Y,replicate(len,'*'));
   SetAllowChar('0123456789aAbBcCdDeEfF');
   vMin := 0;
   vMax := 0;
end; {HEXIOOBJ.Init}

procedure HEXIOOBJ.SetMinMax(Min,Max:longint);
{}
begin
{$IFDEF CHECK}
   if Min > Max then
   begin
     vMax := Min;
     vMin := Max;
   end
   else
   begin
     vMax := Max;
     vMin := Min;
   end;
{$ELSE}
   vMax := Max;
   vMin := Min;
{$ENDIF}
end; {HEXIOOBJ.SetMinMax}

procedure HEXIOOBJ.SetValue(Val:longint);
{}
begin
   PictureIOOBJ.SetValue(InttoHEXStr(Val));
end; {HEXIOOBJ.SetValue}

function HEXIOOBJ.GetValue: longint;
{}
begin
   GetValue := HEXStrtoLong(vInputStr);
end; {HEXIOOBJ.GetValue}

function HEXIOOBJ.Suspend:boolean;
{}
var
  L : longint;
begin
   L := GetValue;
   if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
   and (vMax <> vMin)
   and ((L > vMax) or (L < vMin))
   then   {Invalid}
   begin
      ValidationMessage(NumberError[1],
                        NumberError[2],
                        '',
                        IntToHEXStr(vMin)+' - '+IntToHEXStr(vMax));
      Suspend := false;
   end
   else
   begin
      ReDisplay(Norm);
      WriteLabel(Norm);
      ClearMessage;
      Suspend := true;
   end;
end; {HEXIOOBJ.Suspend}

destructor HEXIOOBJ.Done;
{}
begin
   PictureIOOBJ.Done;
end; {HEXIOOBJ.Done}
{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     U N I T   I N I T I A L I Z A T I O N     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}
procedure IO2Init;
{initilizes objects and global variables}
begin
   FmtNumberTOT.Init;
end; {IO2Init}

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