home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TTT5.ZIP / IOTTT5.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-31  |  55.8 KB  |  1,707 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}                                       
  13.                      {       Unit:    IOTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-}       
  18.  
  19. Unit IOTTT5;
  20.  
  21. (*
  22. {$DEFINE IOFULL}
  23. *)
  24.  
  25. INTERFACE
  26.  
  27. uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5, MiscTTT5;
  28.  
  29. CONST
  30. MaxTables      = 10;       {alter as necessary}
  31. MaxInputFields = 40;       {alter as necessary}
  32.  
  33. IOUndefined = 0;
  34. {$IFDEF IOFULL}
  35. IOString   = 1;
  36. IOByte     = 2;
  37. IOWord     = 3;
  38. IOInteger  = 4;
  39. IOLongInt  = 5;
  40. IOReal     = 6;
  41. IOPassword = 7;
  42. IOSelect   = 8;
  43. IODate     = 9;
  44.  
  45. AllowNull    = $01;
  46. SuppressZero = $02;
  47. RightJustify = $04;
  48. EraseDefault = $08;
  49. JumpIfFull   = $10;
  50.  
  51. Default_Allow_Null    :boolean = true;
  52. Default_Suppress_Zero :boolean = true;
  53. Default_Right_Justify :boolean = false;
  54. Default_Erase_Default :boolean = false;
  55. Default_Jump_Full     :boolean = false;
  56. Default_Allow_Char    :set of char = [#0];
  57. Default_DisAllow_Char :set of char = [#0];
  58. {$ENDIF}
  59. Refresh_None    = 0;
  60. Refresh_Current = 1;
  61. Refresh_All     = 2;
  62. End_Input       = 99;
  63. No_Char         = #0;
  64.  
  65. TYPE
  66. {$IFDEF VER50}
  67. Move_Field_Proc = procedure(var CurrentField:byte;var Refresh:byte);
  68. Char_Hook_Proc   = procedure(var Ch : char; var CurrentField:byte;var Refresh:byte);
  69. Insert_Proc      = procedure(Insert:boolean);
  70. {$ENDIF}
  71.  
  72. IOCharSet = Set of char;
  73. Str_Field_Defn = record
  74.                       Upfield   : byte;
  75.                       Downfield : byte;
  76.                       Leftfield : byte;
  77.                       Rightfield: byte;
  78.                       X         : byte;
  79.                       Y         : byte;
  80.                       Message   : string;
  81.                       MsgX      : byte;
  82.                       MsgY      : byte;
  83.                       CursorX   : byte;
  84.                       StrLocX   : byte;
  85.                       FieldLen  : byte;
  86.                       FieldStr  : strscreen;
  87.                       FieldFmt    : string;
  88.                       Right_Justify : boolean;
  89.                       {$IFDEF IOFULL}
  90.                       RealDP        : byte;
  91.                       Allow_Null    : boolean;
  92.                       Suppress_Zero : Boolean;
  93.                       Erase_Default : boolean;
  94.                       Jump_Full     : boolean;
  95.                       Allow_Char    : set of char;
  96.                       DisAllow_Char : set of char;
  97.  
  98.                       case FieldType:byte of
  99.                            IOString   : (SPtr: ^string);
  100.                            IOByte     : (BPtr: ^Byte;BMax:byte;BMin:byte);
  101.                            IOWord     : (WPtr: ^Word;WMax:word;WMin:word);
  102.                            IOInteger  : (IPtr: ^Integer;IMax:integer;IMin:Integer);
  103.                            IOLongInt  : (LPtr: ^LongInt;LMax:longint;LMin:longInt);
  104.                            IOReal     : (RPtr: ^Real;RMax:real;RMin:Real);
  105.                            IODate     : (DPtr: ^Dates;DFormat:byte;DMax:Dates;DMin:Dates);
  106.                       {$ELSE}
  107.                       FieldType : byte;
  108.                       SPtr : ^string;
  109.                       {$ENDIF}
  110.                 end;
  111.  
  112. Str_Field_Ptr = ^Str_Field_Defn;
  113.  
  114. TableSettings = record
  115.                      HiFCol  : byte;
  116.                      HiBCol  : byte;
  117.                      LoFCol  : byte;
  118.                      LoBCol  : byte;
  119.                      MsgFCol : byte;
  120.                      MsgBCol : byte;
  121.                      TotalFields: byte;
  122.                      CurrentField : byte;
  123.                      AllowEsc : boolean;
  124.                      IO_FieldsSet : boolean;
  125.                      Displayed   : boolean;
  126.                      Beep : boolean;
  127.                      WhiteSpace : char;
  128.                      ErrorLine : byte;
  129.                      Insert : boolean;
  130.                      {$IFDEF VER50}
  131.                      LeaveFieldHook : Move_Field_Proc;
  132.                      EnterFieldHook : Move_Field_Proc;
  133.                      CharHook   : Char_Hook_Proc;
  134.                      InsertProc : Insert_Proc;
  135.                      {$ENDIF}
  136.                      FinishChar : char;
  137.                 end;
  138.  
  139. TableRec = record
  140.                 FieldDefn: array[0..MaxInputFields] of Str_Field_Ptr;
  141.                 ITTT: TableSettings;
  142.            end;
  143.  
  144. TablePtr = ^TableRec;
  145.  
  146.  
  147. VAR
  148.   CurrentTable : byte;
  149.   TableSet: boolean;
  150.   TotalTables : byte;
  151.   Table : array[1..MaxTables] of TablePtr;
  152.   I_Char : char;
  153.   {$IFNDEF VER50}
  154.   IO_LeaveHook,
  155.   IO_EnterHook,
  156.   IO_CharHook,
  157.   IO_InsertHook : pointer;
  158.   {$ENDIF}
  159.  
  160. Procedure Create_Tables(No_Of_Tables:byte);
  161. Procedure Activate_Table(Table_no:byte);
  162. {$IFDEF VER50}
  163. Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  164. Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  165. Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  166. Procedure Assign_InsHook(Proc:Insert_Proc);
  167. {$ENDIF}
  168. Procedure Create_Fields(No_of_fields:byte);
  169. Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  170. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  171. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  172. Procedure String_Field(DefID:byte;var Strvar:String;DefFormat:string);
  173. {$IFDEF IOFULL}
  174. Procedure Assign_Finish_Char(Ch : char);
  175. Procedure Byte_Field(DefID:byte;var ByteVar:Byte;DefFormat:string;Min,Max:byte);
  176. Procedure Word_Field(DefID:byte;var Wordvar:Word;DefFormat:string;Min,Max:word);
  177. Procedure Integer_Field(DefID:byte;var Integervar:Integer;DefFormat:string;Min,Max:integer);
  178. Procedure LongInt_Field(DefID:byte;var LongIntvar:LongInt;DefFormat:string;Min,Max:LongInt);
  179. Procedure Date_Field(DefID:byte;var Datevar:Dates;DateFormat:byte;DefFormat:string;
  180.                       Min,Max : Dates);
  181. Procedure Real_Field(DefID:byte;var Realvar:Real;DefFormat:string;Min,Max:real);
  182. Procedure Set_Default_Rules(Rules:word);
  183. Procedure Field_Rules(DefID:byte;Rules:word;AChar:IOcharset;DChar:IOcharset);
  184. {$ENDIF}
  185. Procedure Display_All_Fields;
  186. Procedure Allow_Esc(OK:boolean);
  187. Procedure Allow_Beep(OK:boolean);
  188. Procedure Dispose_Fields;
  189. Procedure Dispose_Tables;
  190. Procedure Process_Input(StartField:byte);
  191.  
  192. implementation
  193.  
  194. Const
  195.     Valid    = 0;
  196.     NotValid = 1;
  197.     EscValid = 2;
  198.  
  199.     FmtChars  : set of char = ['!','#','@','*'];
  200.     IOUp       = #200;
  201.     IODown     = #208;
  202.     IORight    = #205;
  203.     IOLeft     = #203;
  204.     IODel      = #211;
  205.     IOTotErase = #146;    {Alt-E}
  206.     IOErase    = #160;    {Alt-D}
  207.     IOFinish   = #196;    {F10}   {can be over ridden with ASSIGN_FINISH_CHAR}
  208.     IOEsc      = #27;
  209.     IOTab      = #9;
  210.     IOShiftTab = #143;
  211.     IOEnter    = #13;
  212.     IOIns      = #210;
  213.     IOBackSp   = #8;
  214.     IORightFld = #244;
  215.     IOLeftFld  = #243;
  216.  
  217. VAR
  218.    FirstCharPress : boolean;
  219.  
  220. {$F+}
  221. procedure NoFieldHook(var CurrentField:byte;var Refresh:byte);
  222. begin
  223. end;
  224.  
  225. procedure NoCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  226. begin
  227. end;
  228.  
  229. Procedure DefaultInsertHook(On:boolean);
  230. begin
  231.     If ON then
  232.        OnCursor
  233.     else
  234.        FullCursor;
  235. end;
  236. {$F-}
  237.  
  238. {$IFNDEF VER50}
  239. Procedure CallEnterFieldHook(var CurrentField:byte;var Refresh:byte);
  240.           Inline($FF/$1E/IO_EnterHook);
  241.  
  242. Procedure CallLeaveFieldHook(var CurrentField:byte;var Refresh:byte);
  243.           Inline($FF/$1E/IO_LeaveHook);
  244.  
  245. Procedure CallCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  246.           Inline($FF/$1E/IO_CharHook);
  247.  
  248. Procedure CallInsertHook(On:boolean);
  249.           Inline($FF/$1E/IO_InsertHook);
  250. {$ENDIF}
  251.  
  252. Procedure IOTTT_Error(Code:byte;value:real);    {fatal error -- msg and halt}
  253. var Message:string;
  254. begin
  255.     Case Code of
  256.     1 : Message := 'Error 1: Invalid value of '+Real_to_Str(value,0)
  257.                    +' in Create_Fields with a MaxInputFields of '
  258.                    +Real_to_Str(MaxInputFields,0);
  259.     2 : Message := 'Error 2 : Insufficient Memory on Heap. Available '
  260.                    +Real_to_Str(MaxAvail,0)+'. Required '
  261.                    +Real_to_Str(value,0);
  262.     3 : Message := 'Error 3 : Field operation not allowed before before Create_Fields';
  263.     4 : Message := 'Error 4 : Field ID: '
  264.                    +Real_to_Str(value,0)+' out of range';
  265.     5 : Message := 'Error 5 : cannot change fields, invalid target field ID: '
  266.                    +Real_to_Str(value,0);
  267.     6 : message := 'Error 6 : Invalid X or Y value defined in Add_Field ID: '
  268.                    +Real_to_Str(value,0);
  269.     7 : Message := 'Error 7 : Cannot Add_message before calling Add_Field';
  270.     8 : Message := 'Error 8 : Cannot Add_Message, invalid Field ID: '+Real_to_Str(value,0);
  271.     9 : message := 'Error 9 : Invalid X or Y coordinate defined in Add_Message ID: '
  272.                    +Real_to_Str(value,0);
  273.     10 : Message := 'Error 10 : Cannot Dispose_fields, no fields exist';
  274.     11 : Message := 'Error 11 : Cannot Create_Fields - fields already created,'
  275.                     +' reset with Dispose_fields';
  276.     12 : Message := 'Error 12 : Use Create_Tables before Activate_Table';
  277.     13 : Message := 'Error 13 : Cannot Activate_Table - Table outside range';
  278.     else Message := 'Aborting';
  279.     end; {case}
  280.     WriteAT(1,12,black,lightgray,Message);
  281.     Repeat Until keypressed;
  282.     Halt;
  283. end;    {proc IOTTT_Error}
  284.  
  285. Procedure Ding;
  286. begin
  287.     If Table[CurrentTable]^.ITTT.Beep then
  288.     begin
  289.        sound(750);delay(150);nosound;
  290.     end;
  291. end;    {proc Ding}
  292.  
  293. Procedure Reset_Table(var T: TableSettings);
  294. begin
  295.     with T do
  296.     begin
  297.         HiFCol := white;
  298.         HiBCol := blue;            
  299.         LoFCol := blue;
  300.         LoBCol := lightgray;            
  301.         MsgFCol:= yellow;            
  302.         MsgBCol:= red;            
  303.         TotalFields:=MaxInputFields;            
  304.         CurrentField := 1;            
  305.         AllowEsc := false;            
  306.         IO_FieldsSet := false;            
  307.         Displayed    := false;            
  308.         Beep    := true;            
  309.         WhiteSpace   := #250;            
  310.         ErrorLine := 24;            
  311.         Insert := true;
  312.         {$IFDEF VER50}
  313.         LeaveFieldHook := NoFieldHook;
  314.         EnterFieldHook := NoFieldHook;            
  315.         CharHook := NoCharHook;            
  316.         InsertProc := DefaultInsertHook;            
  317.         {$ELSE}
  318.         IO_LeaveHook  := nil;
  319.         IO_EnterHook  := nil;
  320.         IO_CharHook   := nil;
  321.         IO_InsertHook := @DefaultInsertHook;
  322.         {$ENDIF}
  323.         FinishChar := IOFinish;            
  324.     end;
  325. end;
  326.  
  327. Procedure Create_Tables(No_Of_Tables:byte);
  328. var
  329.   I:integer;
  330.   Room_needed : integer;
  331. begin
  332.     If No_of_Tables in [1..MaxTables] then
  333.     begin
  334.         Room_needed := sizeof(Table[1]^);
  335.         For I := 1 to No_of_Tables do
  336.         begin
  337.             If MaxAvail >= Room_needed then
  338.             begin
  339.                 GetMem(Table[I],Room_Needed);
  340.                 Reset_Table(Table[I]^.ITTT)
  341.             end
  342.             else  {not enough heap space}
  343.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  344.         end;
  345.         TotalTables := No_Of_Tables;
  346.     end;
  347.     TableSet := true;
  348. end;   {IO_SetTables}
  349.  
  350.  Procedure Activate_Table(Table_No:byte);
  351.  {}
  352.  begin
  353.      If not TableSet then
  354.         IOTTT_Error(12,0.0);
  355.      If Table_No > TotalTables then
  356.         IOTTT_Error(13,0.0);
  357.      CurrentTable := Table_No
  358.  end; {of proc Activate_Table}
  359. {$IFDEF VER50}
  360.  Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  361.  {}
  362.  begin
  363.      Table[CurrentTable]^.ITTT.LeaveFieldHook := proc;
  364.  end; {of proc Assign_Field_Proc}
  365.  
  366.  Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  367.  {}
  368.  begin
  369.      Table[CurrentTable]^.ITTT.EnterFieldHook := proc;
  370.  end; {of proc Assign_Field_Proc}
  371.  
  372.  Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  373.  {}
  374.  begin
  375.      Table[CurrentTable]^.ITTT.CharHook := proc;
  376.  end; {of proc Assign_Char_Proc}
  377.  
  378.  Procedure Assign_InsHook(Proc:Insert_Proc);
  379.  {}
  380.  begin
  381.      Table[CurrentTable]^.ITTT.InsertProc := proc;
  382.  end; {of proc Assign_Char_Proc}
  383. {$ENDIF}
  384.  Procedure Assign_Finish_Char(Ch : char);
  385.  {}
  386.  begin
  387.      Table[CurrentTable]^.ITTT.FinishChar := Ch;
  388.  end; {of proc Assign_Finish_Char}
  389.  
  390. {$IFDEF IOFULL}
  391.  Procedure Set_Default_Rules(Rules:word);
  392.  {}
  393.  begin
  394.          Default_Allow_Null    := (Rules and AllowNull) = AllowNull;
  395.          Default_Suppress_Zero := (Rules and SuppressZero) = SuppressZero;
  396.          Default_Right_Justify := (Rules and RightJustify) = RightJustify;
  397.          Default_Erase_Default := (Rules and EraseDefault) = EraseDefault;
  398.          Default_Jump_Full     := (Rules and JumpIfFull) = JumpIfFull;
  399.  end; {of proc Set_Default_Rules}
  400. {$ENDIF}
  401.  
  402. Procedure Create_Fields(No_of_fields:byte);
  403. var
  404.   I:integer;
  405.   Room_needed : integer;
  406. begin
  407.     If not TableSet then
  408.        Create_Tables(1);
  409.     with Table[CurrentTable]^ do
  410.     begin
  411.     (*
  412.         If ITTT.IO_FieldsSet then IOTTT_Error(11,0);       {already set}
  413.     *)
  414.         If No_of_Fields in [1..MaxInputFields] then
  415.         begin
  416.             Room_needed := sizeof(FieldDefn[0]^);
  417.             For I := 0 to No_of_fields do
  418.             begin
  419.                 If MaxAvail >= Room_needed then
  420.                 begin
  421.                     GetMem(FieldDefn[I],Room_Needed);
  422.                     with FieldDefn[I]^ do
  423.                     begin
  424.                         Message     := '';
  425.                         MsgX        := 81;     {zero means auto-center}
  426.                         MsgY        := 0;
  427.                         FieldType   := IOUndefined;
  428.                         SPtr        := nil;
  429.                         FieldLen    := 0;
  430.                         FieldStr    := '';
  431.                         FieldFmt    := '';
  432.                         Right_Justify := false;
  433.                     end;   {With}
  434.                 end
  435.                 else  {not enough heap space}
  436.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  437.             end;
  438.             ITTT.TotalFields := No_of_Fields;
  439.             ITTT.IO_FieldsSet := true;
  440.         end
  441.         else  {Invalid No_of_fields}
  442.            IOTTT_Error(1,No_of_fields);
  443.    end; {with table}
  444. end;  {Proc IO_SetFields}
  445.  
  446.  Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  447.  {}
  448.  begin
  449.      With Table[CurrentTable]^.ITTT do
  450.      begin
  451.          HiFCol := HiF;
  452.          HiBCol := HiB;
  453.          LoFCol := LoF;
  454.          LoBCol := LoB;
  455.          MsgFCol := MsgF;
  456.          MsgBCol := MsgB;
  457.      end;
  458.  end;    {Proc Define_Colors}
  459.  
  460.  Procedure Check_Field_Number(DefId : byte);
  461.  {internal}
  462.  begin
  463.      with Table[CurrentTable]^ do
  464.      begin
  465.          If not ITTT.IO_FieldsSet then IOTTT_Error(3,0);
  466.          If (DefID < 1) or (DefID>ITTT.TotalFields) then
  467.             IOTTT_Error(4,Defid);
  468.      end;
  469.  end; {of proc Check_Field_Number}
  470.  
  471. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  472. begin
  473.     with Table[CurrentTable]^ do
  474.     begin
  475.         Check_Field_Number(DefID);
  476.         If  (DefX < 1) or (DefX > 80)
  477.         or  (DefY < 1) or (DefY > DisplayLines) then
  478.            IOTTT_Error(6,Defid);
  479.         With FieldDefn[DefID]^ do
  480.         begin
  481.             If DefU <= ITTT.TotalFields then
  482.                Upfield    := DefU;
  483.             If DefD <= ITTT.TotalFields then
  484.                Downfield  := DefD;
  485.             If DefL <= ITTT.TotalFields then
  486.                Leftfield  := DefL;
  487.             If DefR <= ITTT.TotalFields then
  488.                Rightfield := DefR;
  489.             X          := DefX;
  490.             Y          := DefY;
  491.         end;
  492.    end; {with Table}
  493. end; {proc ADD_Field}
  494.  
  495. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  496. begin
  497.     with Table[CurrentTable]^ do
  498.     begin
  499.         If not ITTT.IO_FieldsSet then IOTTT_Error(7,0);
  500.         If (DefID < 1) or (DefID > ITTT.TotalFields) then IOTTT_Error(8,DefID);
  501.         If (DefX < 0) or (DefX > 80) or (DefY < 1) or (DefY > 25) then IOTTT_Error(9,DefID);
  502.         With FieldDefn[Defid]^ do
  503.         begin
  504.             MsgX := DefX;
  505.             MsgY := DefY;
  506.             Message := DefString;
  507.         end;
  508.     end; {with Table}
  509. end;  {proc ADD_Message}
  510.  
  511.  Function Max_string_length(DefFormat:string) : byte;
  512.  var I,Counter : byte;
  513.  begin
  514.      Counter := 0;
  515.      For I := 1 to length(DefFormat) do
  516.          if (DefFormat[I] in FmtChars) then
  517.             Counter := succ(counter);
  518.      Max_string_length := Counter;
  519.  end;  {sub func Max_String_Length}
  520.  
  521.  Function  Last_Char_Left_Justified(Str,Fmt:string): byte;
  522.  var
  523.     LenS,LenF,S,
  524.     Counter : byte;
  525.  begin
  526.      Counter := 0;
  527.      S := 0;
  528.      LenF := Length(Fmt);
  529.      LenS := Length(Str);
  530.      Repeat
  531.           Inc(Counter);
  532.           If Fmt[Counter] in FmtChars then
  533.              Inc(S);
  534.      Until (S > LenS) or (Counter > LenF);
  535.      Last_Char_Left_Justified := counter;
  536.  end;
  537.  
  538.  Function  Pos_of_Last_Input_Char(DefFormat:string): byte;
  539.  var
  540.     Counter : byte;
  541.  begin
  542.      Counter := Succ(Length(DefFormat));
  543.      Repeat
  544.           Dec(Counter);
  545.      Until (DefFormat[Counter] in FmtChars) or (Counter = 0);
  546.      Pos_of_Last_Input_Char := counter;
  547.  end;
  548.  
  549. Procedure Set_Cursor(DefID:byte);
  550. begin
  551.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  552.     begin
  553. {$IFDEF IOFULL}
  554.         If Right_Justify then
  555.         begin
  556.             CursorX := pred(X) + Pos_of_Last_Input_Char(FieldFmt);
  557.             StrLocX := length(FieldStr);
  558.         end
  559.         else       {left Justified}
  560.         begin
  561. {$ENDIF}
  562.            If FieldStr = '' then
  563.               StrLocX := 1
  564.            else
  565.            begin
  566.                StrLocX := succ(Length(FieldStr));
  567.                If StrLocX > FieldLen then
  568.                   StrLocX := FieldLen;
  569.            end;
  570.            CursorX := Last_Char_Left_Justified(FieldStr,FieldFmt);
  571.            If CursorX > FieldLen then
  572.               dec(CursorX);
  573.            CursorX := CursorX + pred(X);
  574. {$IFDEF IOFULL}
  575.         end;
  576. {$ENDIF}
  577.     end;
  578. end;
  579.  
  580.  
  581. Function Var_To_String(DefID : byte):String;
  582. var Str : string;
  583. begin
  584.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  585.     begin
  586. {$IFDEF IOFULL}
  587.         Case FieldType of
  588.         IOString  : Str := SPtr^;
  589.         IOByte    : If Suppress_Zero and (BPtr^ = 0) then
  590.                        Str := ''
  591.                     else
  592.                        Str := Int_To_Str(BPtr^);
  593.         IOWord    : If Suppress_Zero and (WPtr^ = 0) then
  594.                        Str := ''
  595.                     else
  596.                        Str := Int_To_Str(WPtr^);
  597.         IOInteger : If Suppress_Zero and (IPtr^ = 0) then
  598.                        Str := ''
  599.                     else
  600.                        Str := Int_To_Str(IPtr^);
  601.         IOLongInt : If Suppress_Zero and (LPtr^ = 0) then
  602.                        Str := ''
  603.                     else
  604.                        Str := Int_To_Str(LPtr^);
  605.         IODate    : If Suppress_Zero and (DPtr^ = 0) then
  606.                        Str := ''
  607.                     else
  608.                        Str := Unformatted_date(Julian_to_date(WPtr^,DFormat));
  609.         IOReal    : If Suppress_Zero and (RPtr^ = 0.0) then
  610.                        Str := ''
  611.                     else
  612.                     begin
  613.                         Str := Real_To_Str(RPtr^,RealDP);
  614.                         If RealDP <> Floating then
  615.                             Delete(Str,LastPos('.',Str),1);
  616.                     end;
  617.         end; {case}
  618. {$ELSE}
  619.       Str := SPtr^;
  620. {$ENDIF}
  621.     end;   {with}
  622.     Var_To_String := Str;
  623.     Set_Cursor(DefID);
  624.  end; {func Var_To_String}
  625.  
  626.  Function Formatted_String(Str,Fmt:string;RJ:boolean):string;
  627.  var
  628.  TempStr : string;
  629.  I,J : byte;
  630.  K : integer;
  631.  begin
  632. {$IFDEF IOFULL}
  633.      If RJ then
  634.      begin
  635.          J := succ(Length(Fmt));
  636.          K := length(Str);
  637.          For I := length(Fmt) downto 1 do
  638.          begin
  639.              If not (Fmt[I] in FmtChars) then
  640.              begin
  641.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  642.                  dec(J);
  643.              end
  644.              else    {format character}
  645.              begin
  646.                  If K > 0  then
  647.                     TempStr[I] := Str[K]
  648.                  else
  649.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  650.                  Dec(K);
  651.              end;
  652.          end;
  653.      end
  654.      else   {left Justified}
  655.      begin
  656. {$ENDIF}
  657.          J := 0;
  658.          For I := 1 to length(Fmt) do
  659.          begin
  660.              If not (Fmt[I] in FmtChars) then
  661.              begin
  662.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  663.                  inc(J);
  664.              end
  665.              else    {format character}
  666.              begin
  667.                  If I - J <= length(Str) then
  668.                     TempStr[I] := Str[I - J]
  669.                  else
  670.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  671.              end;
  672.          end;
  673. {$IFDEF IOFULL}
  674.      end;
  675. {$ENDIF}
  676.      TempStr[0] := char(length(Fmt));  {set initial byte to string length}
  677.      Formatted_String := Tempstr;
  678.  end;  {Func Formatted_String}
  679.  
  680. {$IFDEF IOFULL}
  681.  Procedure Invalid_Message(var CH : char);
  682.  begin
  683.    Ding;
  684.    With Table[CurrentTable]^.ITTT do
  685.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  686.                PadCenter('Invalid number - press any key ... and make correction!',80,' '),CH);
  687.  end;
  688.  
  689.  Procedure Invalid_Date_Message(var CH : char;Format:byte);
  690.  var FmtStr : string;
  691.  begin
  692.    Ding;
  693.    Case Format of
  694.    MMDDYY   : FmtStr := 'MM/DD/YY';
  695.    MMDDYYYY : FmtStr := 'MM/DD/YYYY';
  696.    MMYY     : FmtStr := 'MM/YY';
  697.    MMYYYY   : FmtStr := 'MM/YYYY';
  698.    DDMMYY   : FmtStr := 'DD/MM/YY';
  699.    DDMMYYYY : FmtStr := 'DD/MM/YYYY';
  700.    end; {case}
  701.    With Table[CurrentTable]^.ITTT do
  702.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  703.                PadCenter('Error format is '+FmtStr+'  - press any key ... and make correction!',80,' '),CH);
  704.  end;
  705.  
  706.  Procedure OutOfRange_Message(MinS,MaxS : StrScreen;var CH:char);
  707.  var 
  708.    S : StrScreen;
  709.  begin
  710.      Ding;
  711.      S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key & correct';
  712.      With Table[CurrentTable]^.ITTT do
  713.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  714.  end;
  715.  
  716.  Procedure Validate_Field(DefID:byte; var result:byte);
  717.  {}
  718.  var
  719.    VL : longint;
  720.    VR : Real;
  721.    ChV : char;
  722.    RetCode : integer;
  723.  
  724.                      Procedure Check_Number(Min,Max: longint;
  725.                                             Len : byte;
  726.                                             StrMax : string);
  727.                      {}
  728.                      begin
  729.                          with Table[CurrentTable]^.FieldDefn[DefID]^ do
  730.                          begin
  731.                              val(FieldStr,VL,Retcode);
  732.                              If Retcode <> 0 then
  733.                              begin
  734.                                  Invalid_Message(ChV);
  735.                                  If ChV = #027 then
  736.                                  begin
  737.                                     Result := EscValid;
  738.                                     FieldStr := Var_To_String(DefID);
  739.                                  end
  740.                                  else
  741.                                     Result := NotValid;
  742.                              end
  743.                              else
  744.                              begin
  745.                                  If (VL < Min)
  746.                                  or (VL > Max)
  747.                                  or ((length(FieldStr) > Len) and (FieldStr > StrMax)) then
  748.                                  begin
  749.                                     OutOfRange_Message(Int_To_Str(Min),Int_To_Str(Max),ChV);
  750.                                     If ChV = #027 then
  751.                                     begin
  752.                                        FieldStr := Var_To_String(DefID);
  753.                                        Result := EscValid;
  754.                                     end
  755.                                     else
  756.                                        Result := NotValid;
  757.                                  end
  758.                                  else
  759.                                  begin
  760.                                      Result := valid;
  761.                                  end;
  762.                              end;
  763.                          end; {with}
  764.                      end; {of proc Check_Number}
  765.  
  766.                      Procedure Check_date;
  767.                      {}
  768.                      begin
  769.                          with Table[CurrentTable]^.FieldDefn[DefID]^ do
  770.                          begin
  771.                              If not Valid_Date(FieldStr,DFormat) then
  772.                              begin
  773.                                  Invalid_Date_Message(ChV,DFormat);
  774.                                  If ChV = #027 then
  775.                                  begin
  776.                                     Result := EscValid;
  777.                                     FieldStr := Var_To_String(DefID);
  778.                                  end
  779.                                  else
  780.                                     Result := NotValid;
  781.                              end
  782.                              else
  783.                              begin
  784.                                  VL := Date_to_Julian(FieldStr,DFormat);
  785.                                  If (VL < DMin)
  786.                                  or (VL > DMax) then
  787.                                  begin
  788.                                     OutOfRange_Message(Julian_to_date(DMin,DFormat),Julian_to_date(DMax,DFormat),ChV);
  789.                                     If ChV = #027 then
  790.                                     begin
  791.                                        FieldStr := Var_To_String(DefID);
  792.                                        Result := EscValid;
  793.                                     end
  794.                                     else
  795.                                        Result := NotValid;
  796.                                  end
  797.                                  else
  798.                                  begin
  799.                                      Result := valid;
  800.                                  end;
  801.                              end;
  802.                          end; {with}
  803.                      end; {of proc Check_date}
  804.  
  805.  begin
  806.      Result := Valid; {assume alls well}
  807.      with Table[CurrentTable]^ do
  808.           with FieldDefn[DefID]^ do
  809.      begin
  810.          If (FieldStr = '') and Allow_Null then
  811.             exit;
  812.          Case FieldType of
  813.          IOByte    : Check_Number(BMin,BMax,2,'255');
  814.          IOWord    : Check_Number(WMin,WMax,4,'65535');
  815.          IOInteger : Check_Number(IMin,IMax,5,'32767');
  816.          IOLongInt : Check_Number(LMin,LMax,11,'2147483647');
  817.          IODate    : Check_Date;
  818.          IOReal    : begin
  819.                          val(  Strip('B',ITTT.WhiteSpace,
  820.                                      Formatted_String(FieldStr,FieldFmt,Right_Justify)),
  821.                                VR,
  822.                                Retcode
  823.                             );
  824.                          If Retcode <> 0 then
  825.                          begin
  826.                              Invalid_Message(ChV);
  827.                              If ChV = #027 then
  828.                              begin
  829.                                 Result := EscValid;
  830.                                 FieldStr := Var_To_String(DefID);
  831.                              end
  832.                              else
  833.                                 Result := NotValid;
  834.                          end
  835.                          else
  836.                          begin
  837.                              If (VR < RMin)
  838.                              or (VR > RMax) then
  839.                              begin
  840.                                 OutOfRange_Message(Real_To_Str(RMin,RealDP),Real_To_Str(RMax,RealDP),ChV);
  841.                                 If ChV = #027 then
  842.                                 begin
  843.                                    FieldStr := Var_To_String(DefID);
  844.                                    Result := EscValid;
  845.                                 end
  846.                                 else
  847.                                    Result := NotValid;
  848.                              end
  849.                              else
  850.                              begin
  851.                                  Result := valid;
  852.                              end;
  853.                          end;
  854.                      end;
  855.          end; {case}
  856.      end;   {with}
  857.  end; {of proc Validate_Field}
  858. {$ENDIF}
  859.  
  860.  Procedure String_To_Var(DefID : byte);
  861.  begin
  862.     with Table[CurrentTable]^ do
  863.          with FieldDefn[DefID]^ do
  864. {$IFDEF IOFULL}
  865.          begin
  866.              Case FieldType of
  867.              IOString  : SPtr^ := FieldStr;
  868.              IOByte    : BPtr^ := Str_to_Int(FieldStr);
  869.              IOWord    : WPtr^ := Str_to_Int(FieldStr);
  870.              IOInteger : IPtr^ := Str_to_Int(FieldStr);
  871.              IOLongInt : LPtr^ := Str_to_Long(FieldStr);
  872.              IOReal    : RPtr^ := Str_to_Real(Strip('B',ITTT.WhiteSpace,
  873.                                               Formatted_String(FieldStr,FieldFmt,Right_Justify)));
  874.              IODate    : If FieldStr = '' then
  875.                             DPtr^ := 0
  876.                          else
  877.                             DPtr^ := Date_to_Julian(FieldStr,Dformat);
  878.              end; {case}
  879.         end;   {with}
  880. {$ELSE}
  881.        SPTR^ := FieldStr;
  882. {$ENDIF}
  883.  end; {proc String_to_var}
  884.  
  885. {$IFDEF IOFULL}
  886.  Procedure Set_Misc_Field_Defaults(DefID:byte);
  887.  {}
  888.  begin
  889.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  890.      begin
  891.          Allow_Null    := Default_Allow_Null;
  892.          Suppress_Zero := Default_Suppress_Zero;
  893.          Right_Justify := Default_Right_Justify;
  894.          Erase_Default := Default_Erase_Default;
  895.          Allow_Char    := Default_Allow_Char;
  896.          DisAllow_Char := Default_DisAllow_Char;
  897.          Set_Cursor(DefID);
  898.      end;  {with}
  899.  end; {of proc Set_Misc_Field_Defaults}
  900.  
  901.  Procedure Field_Rules(DefID:byte;
  902.                        Rules:word;
  903.                        AChar: IOCharSet;
  904.                        DChar: IOCharSet);
  905.  {}
  906.  begin
  907.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  908.      begin
  909.          Allow_Null     := (Rules and AllowNull) = AllowNull;
  910.          Suppress_Zero  := (Rules and SuppressZero) = SuppressZero;
  911.          If (FieldType = IOReal)
  912.          and (RealDP > 0)
  913.          and (RealDp <> Floating) then
  914.              Right_Justify := true       {force Right_Justify}
  915.          else
  916.              Right_Justify := (Rules and RightJustify) = RightJustify;
  917.          Erase_Default := (Rules and EraseDefault) = EraseDefault;
  918.          Jump_Full := (Rules and JumpIfFull) = JumpIfFull;
  919.          Allow_Char    := Achar;
  920.          If (RealDP <> Floating) and (DChar = [#0])  then
  921.             DisAllow_Char := ['.']
  922.          else
  923.             DisAllow_Char := Dchar;
  924.          FieldStr      := Var_To_String(DefID);
  925.      end;  {with}
  926.  end; {of proc Field_Rules}
  927. {$ENDIF}
  928.  
  929.  Procedure String_Field(DefID:byte;
  930.                         var Strvar:String;
  931.                         DefFormat:string);
  932.  {}
  933.  begin
  934.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  935.      begin
  936.          Check_Field_Number(DefID);
  937. {$IFDEF IOFULL}
  938.          FieldType     := IOString;
  939. {$ENDIF}
  940.          SPtr          := @StrVar;
  941.          FieldStr      := Sptr^;
  942.          FieldFmt      := DefFormat;
  943.          FieldLen      := Max_String_Length(FieldFmt);
  944. {$IFDEF IOFULL}
  945.          Set_Misc_Field_Defaults(DefID);
  946. {$ELSE}
  947.          Set_Cursor(DefID);
  948. {$ENDIF}
  949.      end;
  950.  end; {of proc String_Field}
  951.  
  952. {$IFDEF IOFULL}
  953.  Procedure Byte_Field(DefID:byte;
  954.                       var Bytevar:Byte;
  955.                       DefFormat:string;
  956.                       Min,Max : byte);
  957.  {}
  958.  begin
  959.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  960.      begin
  961.          Check_Field_Number(DefID);
  962.          FieldType     := IOByte;
  963.          Set_Misc_Field_Defaults(DefID);
  964.          SPtr          := @Bytevar;
  965.          FieldStr := Var_To_String(DefID);
  966.          If DefFormat = '' then
  967.             FieldFmt := '###'
  968.          else
  969.             FieldFmt := DefFormat;
  970.          If (Max = 0) or (Max < Min) then
  971.             BMax := 255
  972.          else
  973.             BMax := Max;
  974.          If Min > BMax then
  975.             BMin := 0
  976.          else
  977.             BMin := Min;
  978.          FieldLen      := Max_String_Length(FieldFmt);
  979.          Set_Misc_Field_Defaults(DefID);
  980.      end;
  981.  end; {of proc Byte_Field}
  982.  
  983.  Procedure Word_Field(DefID:byte;
  984.                       var Wordvar:Word;
  985.                       DefFormat:string;
  986.                       Min,Max : word);
  987.  {}
  988.  begin
  989.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  990.      begin
  991.          Check_Field_Number(DefID);
  992.          FieldType     := IOWord;
  993.          Set_Misc_Field_Defaults(DefID);
  994.          SPtr          := @WordVar;
  995.          FieldStr      := Var_to_String(DefID);
  996.          If DefFormat = '' then
  997.             FieldFmt := '#####'
  998.          else
  999.             FieldFmt := DefFormat;
  1000.          If (Max = 0) or (Max < Min) then
  1001.              WMax := 65535
  1002.          else
  1003.             WMax := Max;
  1004.          If Min > WMax then
  1005.             WMin := 0
  1006.          else
  1007.             WMin := MIn;
  1008.          FieldLen      := Max_String_Length(FieldFmt);
  1009.          Set_Misc_Field_Defaults(DefID);
  1010.      end;
  1011.  end; {of proc Word_Field}
  1012.  
  1013.  Procedure Integer_Field(DefID:byte;
  1014.                       var Integervar:Integer;
  1015.                       DefFormat:string;
  1016.                       Min,Max:Integer);
  1017.  {}
  1018.  begin
  1019.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1020.      begin
  1021.          Check_Field_Number(DefID);
  1022.          FieldType     := IOInteger;
  1023.          Set_Misc_Field_Defaults(DefID);
  1024.          SPtr          := @IntegerVar;
  1025.          FieldStr      := Var_to_String(DefID);
  1026.          If DefFormat = '' then
  1027.             FieldFmt := '######'
  1028.          else
  1029.             FieldFmt := DefFormat;
  1030.          If (Max = 0) or (Max < Min) then
  1031.             IMax := 32767
  1032.          else
  1033.             IMax := Max;
  1034.          If Min > WMax then
  1035.             IMin := -32768
  1036.          else
  1037.             IMin := Min;
  1038.          FieldLen      := Max_String_Length(FieldFmt);
  1039.          Set_Misc_Field_Defaults(DefID);
  1040.      end;
  1041.  end; {of proc Integer_Field}
  1042.  
  1043.  Procedure LongInt_Field(DefID:byte;
  1044.                       var LongIntvar:LongInt;
  1045.                       DefFormat:string;
  1046.                       Min,Max : LongInt);
  1047.  {}
  1048.  begin
  1049.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1050.      begin
  1051.          Check_Field_Number(DefID);
  1052.          FieldType     := IOLongInt;
  1053.          Set_Misc_Field_Defaults(DefID);
  1054.          SPtr          := @LongIntVar;
  1055.          FieldStr      := Var_to_String(DefID);
  1056.          If DefFormat = '' then
  1057.             FieldFmt := '###########'
  1058.          else
  1059.             FieldFmt := DefFormat;
  1060.          If (max = 0) or (Max < Min) then
  1061.             LMax := 2147483647
  1062.          else
  1063.             LMax := Max;
  1064.          If (Min > LMax) then
  1065.             LMin := -2147483647
  1066.          else
  1067.             LMin := Min;
  1068.          FieldLen      := Max_String_Length(FieldFmt);
  1069.          Set_Misc_Field_Defaults(DefID);
  1070.      end;
  1071.  end; {of proc LongInt_Field}
  1072.  
  1073.  Procedure Date_Field(DefID:byte;
  1074.                       var Datevar:Dates;
  1075.                       DateFormat:byte;
  1076.                       DefFormat:string;
  1077.                       Min,Max : Dates);
  1078.  {}
  1079.  begin
  1080.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1081.      begin
  1082.          Check_Field_Number(DefID);
  1083.          FieldType     := IODate;
  1084.          Set_Misc_Field_Defaults(DefID);
  1085.          SPtr          := @DateVar;
  1086.          If DateVar = 0 then
  1087.             FieldStr := ''
  1088.          else
  1089.             FieldStr      := Unformatted_date(Julian_to_Date(DateVar,DateFormat));
  1090.          If DefFormat = '' then
  1091.          begin
  1092.              Case DateFormat of
  1093.              DDMMYY,MMDDYY :       FieldFmt := '##/##/##';
  1094.              MMYY          :       FIeldFmt := '##/##';
  1095.              MMYYYY        :       FieldFmt := '##/####';
  1096.              DDMMYYYY,
  1097.              MMDDYYYY      :       FieldFmt := '##/##/####';
  1098.              end; {Case}
  1099.          end
  1100.          else
  1101.             FieldFmt := DefFormat;
  1102.          If (Max = 0) or (Max < Min) then
  1103.              DMax := 65535
  1104.          else
  1105.             DMax := Max;
  1106.          If Min > WMax then
  1107.             DMin := 0
  1108.          else
  1109.             DMin := MIn;
  1110.          DFormat := DateFormat;
  1111.          FieldLen      := Max_String_Length(FieldFmt);
  1112.          Set_Misc_Field_Defaults(DefID);
  1113.      end;
  1114.  end; {of proc Date_Field}
  1115.  
  1116.  Procedure Real_Field(DefID:byte;
  1117.                       var Realvar:Real;
  1118.                       DefFormat:string;
  1119.                       Min,Max : real);
  1120.  {}
  1121.  var p : byte;
  1122.  begin
  1123.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1124.      begin
  1125.          Check_Field_Number(DefID);
  1126.          FieldType     := IOReal;
  1127.          Set_Misc_Field_Defaults(DefID);
  1128.          SPtr          := @RealVar;
  1129.          If DefFormat = '' then
  1130.             FieldFmt := '############'
  1131.          else
  1132.             FieldFmt := DefFormat;
  1133.          P := LastPos('.',FieldFmt);
  1134.          If P = 0 then
  1135.             RealDP  := Floating
  1136.          else
  1137.             RealDP := Length(FieldFmt) - P;
  1138.          If RealDP = 0 then
  1139.             Delete(FieldFmt,P,1);            {remove the end decimal place}
  1140.          If (Max = 0.0) or (Max < Min) then
  1141.             RMax := 1.7E+37                  {for compatibiltity with Turbo4}
  1142.          else
  1143.             RMax := Max;
  1144.          If Min > RMax then
  1145.             RMin := 2.9E-38                  {for compatibiltity with Turbo4}
  1146.          else
  1147.             RMin := Min;
  1148.          If (RealDP <> 0) and (RealDP <> Floating) then
  1149.             Right_Justify := true;
  1150.          If RealDP <> Floating then
  1151.             DisAllow_Char := ['.'];
  1152.          FieldStr      := Var_to_String(DefID);
  1153.          FieldLen      := Max_String_Length(FieldFmt);
  1154.          Set_Misc_Field_Defaults(DefID);
  1155.      end;
  1156.  end; {of proc Real_Field}
  1157. {$ENDIF}
  1158.  
  1159. Procedure Hilight(ID:byte);      {display cell in bright colors}
  1160. begin
  1161.     with Table[CurrentTable]^ do
  1162.          with FieldDefn[ID]^ do
  1163.               WriteAT(X,Y,ITTT.HiFCol,ITTT.HiBCol,
  1164.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1165. end;
  1166.  
  1167. Procedure LoLight(ID:byte);      {display cell in dim colors}
  1168. begin
  1169.     with Table[CurrentTable]^ do
  1170.          with FieldDefn[ID]^ do
  1171.              WriteAT(X,Y,ITTT.LoFCol,ITTT.LoBCol,
  1172.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1173. end;
  1174.  
  1175. Procedure Display_All_Fields;
  1176. var I : integer;
  1177. begin
  1178.     with Table[CurrentTable]^ do
  1179.     begin
  1180.         For I :=  1 to ITTT.TotalFields do
  1181.             LoLight(I);
  1182.         ITTT.Displayed  := true;
  1183.     end; {with Table}
  1184. end;
  1185.  
  1186. Procedure Allow_Esc(OK:boolean);
  1187. begin
  1188.     Table[CurrentTable]^.ITTT.AllowEsc := OK;
  1189. end;    {proc Allow_Esc}
  1190.  
  1191. Procedure Allow_Beep(OK:boolean);
  1192. begin
  1193.     Table[CurrentTable]^.ITTT.Beep := OK;
  1194. end;    {proc Allow_Beep}
  1195.  
  1196. Procedure Dispose_Fields;
  1197. var I : integer;
  1198. begin
  1199.     with Table[CurrentTable]^ do
  1200.     begin
  1201.         If not ITTT.IO_FieldsSet then IOTTT_Error(10,0);
  1202.         For I := 0 to ITTT.TotalFields do
  1203.             FreeMem(FieldDefn[I],sizeof(FieldDefn[I]^));
  1204.         Reset_Table(ITTT);
  1205.     end; {with Table}
  1206. end; { proc Dispose_Fields}
  1207.  
  1208. Procedure Dispose_Tables;
  1209. var I : integer;
  1210. begin
  1211.     For I := 1 to TotalTables do
  1212.         FreeMem(Table[I],sizeOf(Table[I]^));
  1213.     TotalTables := 0;
  1214. end;
  1215.  
  1216. {
  1217. ****************************
  1218. *      Main Procedure      *
  1219. ****************************
  1220. }
  1221.  
  1222. Procedure Process_Input(StartField:byte);
  1223. var
  1224.     OldLine : array[1..160] of byte;
  1225.     Finished : boolean;
  1226.  
  1227.     Procedure DisplayMessage(ID:byte);
  1228.     begin
  1229.         With Table[CurrentTable]^ do
  1230.              with FieldDefn[ID]^ do
  1231.              begin
  1232.                 If MsgX = 0 then   {Center the message}
  1233.                    MsgX := (80 - length(Message)) div 2;
  1234.                 PartSave(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1235.                 WriteAT(MsgX,MsgY,ITTT.MsgFCol,ITTT.MsgBCol,Message);
  1236.              end;
  1237.     end;
  1238.  
  1239.     Procedure RemoveMessage(ID:byte);
  1240.     var I,LocC : integer;
  1241.     begin
  1242.         With Table[CurrentTable]^.FieldDefn[ID]^ do
  1243.              PartRestore(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1244.     end; {sub sub proc RemoveMessage}
  1245.  
  1246.     Procedure Check_Refresh_State(Refresh:byte);
  1247.     {}
  1248.     var I : integer;
  1249.     begin
  1250.         with Table[CurrentTable]^ do
  1251.         Case Refresh of
  1252. {$IFDEF IOFULL}
  1253.         Refresh_None :; {do nothing}
  1254.         Refresh_Current: begin
  1255.  
  1256.                              FieldDefn[ITTT.CurrentField]^.FieldStr := Var_to_String(ITTT.CurrentField);
  1257.                              LoLight(ITTT.CurrentField);
  1258.                          end;
  1259.         Refresh_All: begin
  1260.                          For I := 1 to ITTT.TotalFields do
  1261.                              FieldDefn[I]^.FieldStr      := Var_to_String(I);
  1262.                          Display_All_Fields;
  1263.                      end;
  1264.         End_Input : begin
  1265.                         For I := 1 to ITTT.TotalFields do
  1266.                             FieldDefn[I]^.FieldStr      := Var_to_String(I);
  1267.                         Display_All_Fields;
  1268.                         Finished := true;
  1269.                     end;
  1270. {$ELSE}
  1271.         Refresh_None   :; {do nothing}
  1272.         Refresh_Current: LoLight(ITTT.CurrentField);
  1273.         Refresh_All    : Display_All_Fields;
  1274.         End_Input      : begin
  1275.                              Display_All_Fields;
  1276.                              Finished := true;
  1277.                          end;
  1278. {$ENDIF}
  1279.         end; {Case}
  1280.     end; {of proc Check_refresh_State}
  1281.  
  1282.   Procedure Change_Fields(ID:byte);
  1283.   var
  1284.     ValidInput:byte;
  1285.     CField : byte;
  1286.     Refresh : byte;
  1287.   begin
  1288.       with Table[CurrentTable]^ do
  1289.       begin
  1290. {$IFDEF IOFULL}
  1291.           Validate_Field(ITTT.CurrentField,ValidInput);
  1292.           If ValidInput <> Valid then
  1293.              exit;
  1294. {$ENDIF}
  1295.           String_to_Var(ITTT.CurrentField);
  1296.           LoLight(ITTT.CurrentField);
  1297.           If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1298.              RemoveMessage(ITTT.CurrentField);
  1299.           {Now call the "leave field" hook}
  1300.           CField := ITTT.CurrentField;
  1301.           Refresh := Refresh_None;
  1302.           {$IFDEF VER50}
  1303.           ITTT.LeaveFieldHook(CField,Refresh);
  1304.           {$ELSE}
  1305.           If IO_LeaveHook <> Nil then
  1306.              CallLeaveFieldHook(CField,Refresh);
  1307.           {$ENDIF}
  1308.           If CField <> ITTT.CurrentField then
  1309.              ID := CField; {user wants to go to a specific field}
  1310.           Check_Refresh_State(Refresh);
  1311.           If Finished then exit;
  1312.           If ID = 0 then
  1313.           begin
  1314.               Finished := true;
  1315.           end
  1316.           else
  1317.           begin
  1318.               ITTT.CurrentField := ID;
  1319.               CField := ID;
  1320.               {Enter Field Hook}
  1321.               Repeat
  1322.                    ITTT.CurrentField := CField;
  1323.                    Refresh := Refresh_None;
  1324.                    {$IFDEF VER50}
  1325.                    ITTT.EnterFieldHook(CField,Refresh);
  1326.                    {$ELSE}
  1327.                    If IO_EnterHook <> Nil then
  1328.                       CallEnterFieldHook(CField,Refresh);
  1329.                    {$ENDIF}
  1330.                    Check_Refresh_State(Refresh);
  1331.                    If Finished then exit;
  1332.               until CField = ITTT.CurrentField;
  1333.               If (ITTT.CurrentField < 1) 
  1334.               or (ITTT.CurrentField > ITTT.TotalFields) then
  1335.                  
  1336.               HiLight(ITTT.CurrentField);
  1337.               If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1338.                  DisplayMessage(ITTT.CurrentField);
  1339.               With FieldDefn[ITTT.CurrentField]^ do
  1340.                   GotoXY(CursorX,Y);
  1341.               {Ding;}
  1342.           end;  {If ID = 0};
  1343.      end; {with Table}
  1344.   end;  {proc change fields}
  1345.  
  1346.   Procedure Erase_Field(ID:byte);
  1347.   begin
  1348.       with Table[CurrentTable]^.FieldDefn[ID]^ do
  1349.       begin
  1350.           FieldStr := '';
  1351.           Set_Cursor(ID);
  1352.       end;
  1353.   end;
  1354.  
  1355.   Procedure Global_Erase;
  1356.   var
  1357.      I : integer;
  1358.      S : string;
  1359.      Ch : char;
  1360.   begin
  1361.       Ding;
  1362.       S := 'Erase all entries!  Are you sure? (Y/N)';
  1363.       With Table[CurrentTable]^.ITTT do
  1364.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  1365.       If Upcase(Ch) <> 'Y' then exit;
  1366.       with Table[CurrentTable]^ do
  1367.       begin
  1368.           For I :=  1 to ITTT.TotalFields do
  1369.               Erase_Field(I);
  1370.           Display_All_Fields;
  1371.           ITTT.CurrentField := 1;
  1372.       end;
  1373.   end;
  1374.  
  1375.   Procedure Cursor_Right;
  1376.   begin
  1377.       With Table[CurrentTable]^ do
  1378.            with FieldDefn[ITTT.CurrentField]^ do
  1379.            begin
  1380.               If (Right_Justify and (StrLocX < length(FieldStr)) and (StrLocX < FieldLen)) or
  1381.                  ((Right_Justify = false) and (StrLocX <= length(FieldStr)) and (StrLocX < FieldLen))then
  1382.               begin
  1383.                   Inc(StrLocX);
  1384.                   Repeat
  1385.                        Inc(CursorX);
  1386.                   Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1387.               end;
  1388.               GotoXY(CursorX,Y);
  1389.           end; {with}
  1390.   end; {Proc Cursor_Right}
  1391.  
  1392.   Procedure Cursor_Left;
  1393.   begin
  1394.       with Table[CurrentTable]^ do
  1395.            With FieldDefn[ITTT.CurrentField]^ do
  1396.            begin
  1397.                If (StrLocX > 1)
  1398.                or ( Right_Justify and (StrLocX > 0) and (length(FieldStr) <> FieldLen) ) then
  1399.                begin
  1400.                    dec(StrLocX);
  1401.                    Repeat
  1402.                         dec(CursorX);
  1403.                    Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1404.                end;
  1405.            end;  {with}
  1406.   end;  {Proc Cursor_left}
  1407.  
  1408.   Procedure Cursor_Home;
  1409.   var
  1410.     Counter1, Counter2 : byte;
  1411.   begin
  1412.       with Table[CurrentTable]^ do
  1413.            With FieldDefn[ITTT.CurrentField]^ do
  1414.                 Repeat
  1415.                      Counter1 := CursorX;
  1416.                      Cursor_Left;
  1417.                 Until Counter1 = CursorX;
  1418.   end;  {Proc Cursor_Home}
  1419.  
  1420.   Procedure Delete_Char;
  1421.   var
  1422.     I : integer;
  1423.   begin
  1424.       with Table[CurrentTable]^ do
  1425.            with FieldDefn[ITTT.CurrentField]^ do   {non format characters}
  1426.            begin
  1427.                If StrLocX > 0 then
  1428.                begin
  1429.                   Delete(FieldStr,StrLocX,1);
  1430.                   If Right_Justify then
  1431.                      Dec(StrLocX);
  1432.                end;
  1433.            end;  {with}
  1434.   end;  {Delete_Chars}
  1435.  
  1436.   Procedure Backspaced;
  1437.   begin
  1438.       with Table[CurrentTable]^ do
  1439.            with FieldDefn[ITTT.CurrentField]^ do
  1440.            begin
  1441.                If StrLocX > 1 then
  1442.                begin
  1443.                    If Right_Justify then
  1444.                    begin
  1445.                        Delete(FieldStr,pred(StrLocX),1);
  1446.                        Dec(StrLocX);
  1447.                    end
  1448.                    else
  1449.                    begin
  1450.                        Cursor_Left;
  1451.                        Delete(FieldStr,StrLocX,1);
  1452.                    end;
  1453.                end;
  1454.            end;  {with}
  1455.   end;  { Proc Backspaced }
  1456.  
  1457.   Procedure Finish_Input;
  1458.   {}
  1459.   var ValidInput : byte;
  1460.   begin
  1461. {$IFDEF IOFULL}
  1462.       Validate_Field(Table[CurrentTable]^.ITTT.CurrentField,ValidInput);
  1463.       If ValidInput = Valid then
  1464.       begin
  1465. {$ENDIF}
  1466.           String_to_Var(Table[CurrentTable]^.ITTT.CurrentField);
  1467.           Finished := true;
  1468. {$IFDEF IOFULL}
  1469.       end;
  1470. {$ENDIF}
  1471.   end; {of proc Finish_Input}
  1472.  
  1473.   Procedure Insert_Character(K : char);
  1474.   begin
  1475.       with Table[CurrentTable]^ do
  1476.            with FieldDefn[ITTT.CurrentField]^ do
  1477.            begin
  1478.                If length(FieldStr) < FieldLen then
  1479.                begin
  1480.                    If Right_Justify then
  1481.                    begin
  1482.                        Inc(StrLocX);
  1483.                        Insert(K,FieldStr,StrLocX);
  1484.                    end
  1485.                    else
  1486.                    begin
  1487.                        Insert(K,FieldStr,StrLocX);
  1488.                        Cursor_Right;
  1489.                    end;
  1490.                end
  1491.                else Ding;
  1492.       end;
  1493.   end;
  1494.  
  1495.   Procedure OverType_Character(K : char);
  1496.   begin
  1497.       with Table[CurrentTable]^ do
  1498.            with FieldDefn[ITTT.CurrentField]^ do
  1499.            begin
  1500.                If (StrLocX = 0) and Right_Justify then
  1501.                begin
  1502.                    Insert(K,FieldStr,StrLocX);
  1503.                    Inc(StrLocX);
  1504.                end
  1505.                else
  1506.                begin
  1507.                    Delete(FieldStr,StrLocX,1);
  1508.                    Insert(K,FieldStr,StrLocX);
  1509.                    Cursor_Right;
  1510.                end;
  1511.            end;
  1512.   end;
  1513.  
  1514.   Procedure Activity;
  1515.   var
  1516.     K : char;
  1517.     ReturnStr: string;
  1518.     Prior_CursorX : byte;
  1519.     ValidInput : byte;
  1520.     OldField : byte;
  1521.     CField : byte;
  1522.     Refresh: byte;
  1523.   begin
  1524.       OldField := Table[CurrentTable]^.ITTT.CurrentField;
  1525. (*DEBUG
  1526.        with  Table[CurrentTable]^ do
  1527.             with FieldDefn[ITTT.CurrentField]^ do
  1528.             begin
  1529.                 Fastwrite(1,22,white,int_to_Str(StrLocX)+'   ');
  1530.                 Fastwrite(1,23,white,Int_to_Str(CursorX)+'   ');
  1531.                 Fastwrite(1,24,white,FieldStr+'    ');
  1532.                 Fastwrite(1,25,white,Int_to_Str(RealDP)+'   ');
  1533.             end;
  1534. (*ENDDEBUG*)
  1535.       K := Getkey;
  1536.       {now the character hook}
  1537.       With Table[CurrentTable]^ do
  1538.       begin
  1539.           CField := ITTT.CurrentField;
  1540.           ReFresh := Refresh_None;
  1541.           {$IFDEF VER50}
  1542.           ITTT.CharHook(K,CField,Refresh);
  1543.           {$ELSE}
  1544.           If IO_CharHook <> Nil then
  1545.              CallCharHook(K,CField,Refresh);
  1546.           {$ENDIF}
  1547.           Check_Refresh_State(Refresh);
  1548.           If CField <> ITTT.CurrentField then
  1549.              Change_Fields(CField); {user wants to go to a specific field}
  1550.           If K = ITTT.FinishChar then
  1551.              Finish_Input
  1552.           else
  1553. {$IFDEF IOFULL}
  1554.              If  (FieldDefn[ITTT.CurrentField]^.Allow_Char <> [#0])
  1555.              and (not (K in FieldDefn[ITTT.CurrentField]^.Allow_Char)) then
  1556.              begin
  1557.                  Ding;
  1558.                  Exit;
  1559.              end;
  1560. {$ELSE}
  1561. ;
  1562. {$ENDIF}
  1563.       end;
  1564.  
  1565.       If (K <> No_Char)
  1566.       and (Finished = false) then
  1567.       Case K of
  1568.       #132,   {mouse right but}
  1569.       IOEsc : If Table[CurrentTable]^.ITTT.AllowEsc then
  1570.                  begin
  1571.                      Finished := true;
  1572.                   end
  1573.                   else Ding;
  1574.       #32..#126 : with Table[CurrentTable]^ do
  1575.                       with FieldDefn[ITTT.CurrentField]^ do
  1576.                       begin
  1577.                           If FieldFmt[CursorX - X + 1] = '!' then K := upcase(K);
  1578. {$IFDEF IOFULL}
  1579.                           If (
  1580.                                (Allow_Char = [#0])
  1581.                                or ((Allow_Char <> [#0]) and (K in Allow_Char))
  1582.                              )
  1583.                           and
  1584.                              (
  1585.                                (DisAllow_Char = [#0])
  1586.                                or ((DisAllow_Char <> [#0]) and ((K in DisAllow_Char)= false))
  1587.                              )
  1588.                           then
  1589.                           begin
  1590. {$ENDIF}
  1591.                               If ((K in ['0'..'9','.','-','e','E']) and (FieldFmt[CursorX - X + 1] = '#'))
  1592.                               or ((K in ['a'..'z','A'..'Z',' ',',','.',';',':']) and
  1593.                                                         (FieldFmt[CursorX - X + 1] = '@'))
  1594.                               or (FieldFmt[CursorX - X + 1] = '*')
  1595.                               or (FieldFmt[CursorX - X + 1] = '!') then
  1596.                               begin
  1597. {$IFDEF IOFULL}
  1598.                                   If FirstCharPress then
  1599.                                   begin
  1600.                                       If Erase_Default then
  1601.                                          Erase_Field(ITTT.CurrentField);
  1602.                                       FirstCharPress := false;
  1603.                                   end;
  1604. {$ENDIF}
  1605.                                   If (ITTT.Insert) then
  1606.                                      Insert_Character(K)
  1607.                                   else
  1608.                                      OverType_Character(K);
  1609.                               end
  1610.                               else Ding; {end if K in statement}
  1611. {$IFDEF IOFULL}
  1612.                           end; {if}
  1613. {$ENDIF}
  1614.                       end;  {with}
  1615.       #133,      {mouse left but}
  1616.       #131,      {mouse right}
  1617.       IORightFld,
  1618.       IOTab,
  1619.       IOEnter :  with Table[CurrentTable]^ do
  1620.                      Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1621.       #130,      {mouse left}
  1622.       IOLeftFld,
  1623.       IOShiftTab : with Table[CurrentTable]^ do
  1624.                        Change_Fields(FieldDefn[ITTT.CurrentField]^.LeftField);
  1625.       IOBackSp : Backspaced;
  1626.       IODel    : Delete_Char;
  1627.       IOLeft   : Cursor_Left;
  1628.       IORight  : Cursor_Right;
  1629.       #128,    {mouse up}
  1630.       IOUp     : with Table[CurrentTable]^ do
  1631.                       Change_Fields(FieldDefn[ITTT.CurrentField]^.UpField);
  1632.       #129,    {mouse down}
  1633.       IODown   : with Table[CurrentTable]^ do
  1634.                       Change_Fields(FieldDefn[ITTT.CurrentField]^.DownField);
  1635.       IOErase    :with Table[CurrentTable]^ do
  1636.                        Erase_Field(ITTT.CurrentField);
  1637.       IOTotErase : Global_Erase;
  1638.       IOIns      : with Table[CurrentTable]^ do
  1639.                    begin
  1640.                        ITTT.Insert := not ITTT.Insert;
  1641.                        {$IFDEF VER50}
  1642.                        ITTT.InsertProc(ITTT.Insert);
  1643.                        {$ELSE}
  1644.                         If IO_InsertHook <> Nil then
  1645.                            CallInsertHook(ITTT.Insert);
  1646.                        {$ENDIF}
  1647.                    end;
  1648.       #199       : Cursor_Home;
  1649.       #207       : with Table[CurrentTable]^ do
  1650.                       Set_Cursor(ITTT.CurrentField);
  1651.       else Ding;
  1652.       end; {case}
  1653.       HiLight(Table[CurrentTable]^.ITTT.CurrentField);
  1654.       with Table[CurrentTable]^ do
  1655.            with FieldDefn[ITTT.CurrentField]^ do
  1656.                 GotoXY(CursorX,Y);
  1657.       If Table[CurrentTable]^.ITTT.CurrentField <> OldField then
  1658.          FirstCharPress := true
  1659.       else
  1660.          FirstCharPress := false;
  1661. {$IFDEF IOFULL}
  1662.       with Table[CurrentTable]^ do
  1663.            with FieldDefn[ITTT.CurrentField]^ do
  1664.            begin
  1665.                If  (FirstCharPress = false)
  1666.                and (Jump_Full)
  1667.                and (StrLocX = FieldLen)
  1668.                and (Length(FieldStr) = FieldLen)
  1669.                and (ITTT.Insert)
  1670.                and (K in [#32..#126])
  1671.                and (Jump_Full) then
  1672.                    Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1673.            end;
  1674. {$ENDIF}
  1675.       I_Char := K;
  1676.   end;    {Proc Activity}
  1677.  
  1678.  
  1679. begin   {Process_Input}
  1680.     with Table[CurrentTable]^ do
  1681.     begin
  1682.         If ITTT.Displayed = false then Display_All_Fields;
  1683.         If StartField in [1..ITTT.TotalFields] then
  1684.            ITTT.CurrentField := StartField
  1685.         else
  1686.            StartField := 1;
  1687.  
  1688.         Hilight(ITTT.CurrentField);
  1689.         If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1690.         DisplayMessage(Table[CurrentTable]^.ITTT.CurrentField);
  1691.         GotoXY(FieldDefn[ITTT.CurrentField]^.CursorX,
  1692.                FieldDefn[ITTT.CurrentField]^.Y);
  1693.         Finished := false;
  1694.         FirstCharPress := true;
  1695.         OnCursor;
  1696.         repeat
  1697.              Activity;
  1698.         until Finished;
  1699.     end;
  1700. end;   {Process_Input}
  1701.  
  1702. begin  {Initial Auto proc}
  1703.     CurrentTable := 1;
  1704.     TableSet := False;
  1705. end.
  1706.  
  1707.