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