home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SCREDIT2.ZIP / SCRED3&4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-02  |  36.3 KB  |  1,421 lines
  1. Function S_Length(Var S:S_Str80):Integer;
  2. Begin
  3. S_Length:=Pos(S_Blanks,S+S_Blanks) - 1;
  4. End;
  5.  
  6.  
  7. Function S_UpShiftedStr(Target_String:S_Str80):S_Str80;
  8. Var
  9. Point : integer;
  10. Begin
  11. Point := 1;
  12. While Point <= Length(Target_String) do
  13.     Begin
  14.     Target_String[Point] := UpCase(Target_String[Point]);
  15.     Point := Point + 1;
  16.     End;
  17. S_UpShiftedStr := Target_String;
  18. End;
  19.  
  20.  
  21.  
  22.  
  23. Function S_FindScreen(ScrName:S_Str80):Integer;
  24. Var S_Count:Integer;
  25. Begin
  26. S_Count := 0;
  27. Repeat
  28.     S_Count := S_Count + 1;
  29. Until ((S_UpShiftedStr(ScrName)=S_UpShiftedStr(S_Indx^.S_Name[S_Count])) or
  30.        (S_Count > S_Indx^.S_sFiled));
  31. If  S_Count > S_Indx^.S_sFiled Then
  32.     S_Msg := ' Is not in file.'
  33. Else
  34.     If  S_Indx^.S_CompiledInd[S_Count] = 0 Then
  35.         S_Msg := ' has not been compiled..';
  36.  
  37. If  (S_ChangeScreen = True) And
  38.     (S_Msg > '') then
  39.     Begin
  40.     S_DisplayMessage(S_MessBg,S_MessFg,'<'+ScrName+'>'+S_Msg);
  41.     S_CloseScreenFile;
  42.     Halt;
  43.     End;
  44. S_FindScreen := S_Count;
  45. End;
  46.  
  47.  
  48.  
  49. Procedure S_CloseScreenFile;
  50. Begin
  51. {$I-}
  52. Close(S_File);
  53. {$I+}
  54. S_SetCursor(S_Normal);
  55. End;
  56.  
  57.  
  58.  
  59.  
  60. Procedure S_ResetKeyFlags;
  61. Begin
  62. S_Fkey    := False;
  63. S_Tab     := False;
  64. S_Ctrl    := False;
  65. S_Esc     := False;
  66. S_Alt     := False;
  67. S_Shift   := False;
  68. S_F1      := False;
  69. S_F2      := False;
  70. S_F3      := False;
  71. S_F4      := False;
  72. S_F5      := False;
  73. S_F6      := False;
  74. S_F7      := False;
  75. S_F8      := False;
  76. S_F9      := False;
  77. S_F10     := False;
  78. S_Enter   := False;
  79. S_BkSp    := False;
  80. S_Home    := False;
  81. S_Up      := False;
  82. S_PgUp    := False;
  83. S_Left    := False;
  84. S_Right   := False;
  85. S_End     := False;
  86. S_Down    := False;
  87. S_PgDn    := False;
  88. S_Ins     := False;
  89. S_Del     := False;
  90. S_NumLock := False;
  91. S_InsertKey := False;
  92. S_DeleteKey := False;
  93. S_BackSpace := False;
  94. S_LeftArrow := False;
  95. S_RightArrow:= False;
  96. End;
  97.  
  98.  
  99.  
  100. Procedure S_Init;
  101. Begin
  102. FillChar (S_Msg,81,00);
  103. FillChar (S_Blanks,81,32);
  104. S_Blanks[0]     := Chr(80);
  105. FillChar(S_NormAttrib,81,00);
  106. S_StatusLine    := '[Insert] [Caps] [Num Lock] [Scroll Lock]';
  107. FillChar(S_StAttrWork,21,32);
  108. S_StAttrWork[0] := #20;
  109.  
  110. S_MessBg        := 4;
  111. S_MessFg        := 15;
  112. S_NormBg        := 0;
  113. S_NormFg        := 2;
  114. S_Cursor        := S_Normal;
  115. S_Sound         := True;
  116. S_Freq          := 300;
  117. S_Dur           := 100;
  118.  
  119. S_ChangeScreen  := True;
  120. S_Ch            := Chr(00);
  121. S_Point         := 0;
  122. S_Direction     := 1;
  123. S_NewStr        := '';
  124. S_Padding       := '';
  125. S_RecNo         := 0;
  126. S_ValidateLine  := 0;
  127.  
  128. S_ResetKeyFlags;
  129.  
  130. S_Seg := $B000;
  131. If  S_VideoPort = $3B4 Then
  132.     Begin
  133.     S_MessBg  := 7;
  134.     S_MessFg  := 8;
  135.     S_NormBg  := 0;
  136.     S_NormFg  := 10;
  137.     S_Ofs     := $0000;
  138.     S_Mono    := True;
  139.     End
  140. Else
  141.     Begin
  142.     S_Mono := False;
  143.     S_Ofs  := $8000;
  144.     End;
  145.  
  146. S_BW := False;
  147. For S_Count := 1 to ParamCount Do
  148.     Begin
  149.     S_WorkStr := ParamStr(S_Count);
  150.     If  S_UpShiftedStr(S_WorkStr) = '/BW' Then
  151.         S_BW := True;
  152.     End;
  153. If  S_BW Then
  154.     Begin
  155.     S_MessBg := 0;
  156.     S_MessFg := 15;
  157.     S_NormBg := 0;
  158.     S_NormFg := 15;
  159.     End;
  160.  
  161. S_AllocateMemory;
  162. S_SetCursor(S_Off);
  163. End;
  164.  
  165.  
  166.  
  167. Procedure S_OpenScreenFile(ScrFileName:S_Str80);
  168. Var
  169. IOerr : Integer;
  170. Begin
  171. Assign(S_File,ScrFileName);
  172. {$I-}
  173. Reset(S_FILE);
  174. IOerr := IOResult;
  175. {$I+}
  176. If  IOerr > 0 then
  177.     Begin
  178.     Str(IoErr:4,S_Msg);
  179.     S_Msg := 'IO error <' + S_Msg + '> reading ';
  180.     End;
  181. If  SizeOf(S_File) = 0 Then
  182.     S_Msg := 'Empty screen file ';
  183. If  S_Msg > '' Then
  184.     Begin
  185.     S_DisplayMessage(S_MessBg,S_MessFg,S_Msg+'<'+ScrFileName+'>');
  186.     S_CloseScreenFile;
  187.     Halt;
  188.     End;
  189. Seek(S_File,0);
  190. Read(S_File,S_Indx^);
  191. End;
  192.  
  193.  
  194.  
  195. Procedure S_Store_Buf_Loc (ScrName:S_Str80;ScrBuf:WorkAreaPtr);
  196. Begin
  197. S_Count := S_FindScreen(ScrName);
  198. S_BuffPtr^[S_Count] := ScrBuf;
  199. End;
  200.  
  201.  
  202.  
  203. Procedure S_LoadScreen(ScrName:S_Str80);
  204. Var
  205. X,Y,Z : Integer;
  206.  
  207. Begin
  208. S_Msg := '';
  209. S_Num := S_FindScreen(ScrName);
  210.  
  211. S_WorkArea := S_BuffPtr^[S_Num];
  212. Seek(S_File,S_Indx^.S_RecordNumber[S_Num]);
  213. Read(S_File,S_Record^);
  214. If  S_BW Then
  215.     Begin
  216.     X := 2;
  217.     While X < 4000 Do
  218.         Begin
  219.         S_Record^.S_Video[X] := #15;
  220.         X := X + 2;
  221.         End;
  222.     End;
  223. S_FirstField := 0;
  224. If  S_Indx^.S_FieldsRecNo[S_Num] > 0 then
  225.     Begin
  226.     Seek(S_File,S_Indx^.S_FieldsRecNo[S_Num]);
  227.     Read(S_File,S_Field^);
  228.     S_FirstField := S_Indx^.S_First[S_Num];
  229.     S_Point := 1;
  230.     For X := 1 to S_Indx^.S_Count[S_Num] do
  231.         Begin
  232.         If  S_BW Then
  233.             Begin
  234.             S_Field^.S_DisplayBg[X] := 0;
  235.             S_Field^.S_DisplayFg[X] := 15;
  236.             S_Field^.S_NormalBg [X] := 0;
  237.             S_Field^.S_NormalFg [X] := 15;
  238.             S_Field^.S_PromptBg [X] := 0;
  239.             S_Field^.S_PromptFg [X] := 15;
  240.             End;
  241.         S_FieldPtr^[X] := S_Point;
  242.         If  S_Field^.S_Type[X] In [8,9,98,99] Then
  243.             S_Point := S_Point + S_Field^.S_Len[X]+1
  244.         Else
  245.             S_Point := S_Point + 6;
  246.         For Z := S_Field^.S_Col[X] to
  247.             (S_Field^.S_Col[X] +
  248.             S_Field^.S_Len[X] + 1) do
  249.             Begin
  250.             S_Record^.S_Video
  251.                 [((S_Field^.S_Row[X]-1)*S_LineSize)+((Z-1)*2)+1]:= #32;
  252.             End;
  253.         End;
  254.     End;
  255. If  S_ChangeScreen = True Then
  256.     Begin
  257.     S_PutScrMem(S_Record^.S_Video[1],
  258.                        Mem[S_Seg:S_Ofs],3840);
  259.     S_Point := S_FirstField;
  260.     End
  261. Else
  262.     S_ChangeScreen := True;
  263. End;
  264.  
  265.  
  266.  
  267. Procedure S_DisplayScreenField(R,C,T,L,DL,DF,DB,NF,NB:Integer;Var S:S_Str80);
  268. Var
  269. RealWork   : Real;
  270. S_Result   : Integer;
  271. BackColor,
  272. ForColor   : Integer;
  273.  
  274. Begin
  275. If  T in [1..7,91..97] Then
  276.     Begin
  277.     If  Pos(S,'-0.000000') = 1 then
  278.         Begin
  279.         DL := DL - 2;
  280.         Delete(S,1,2);
  281.         End;
  282.     If  Pos(S,'-0.000000') = 2 then
  283.         Begin
  284.         DL := DL - 1;
  285.         Delete(S,1,1);
  286.         End;
  287.     If  Pos('-0',S) > 1 then
  288.         Begin
  289.         Delete(S,2,1);
  290.         DL := DL -1;
  291.         End;
  292.     End;
  293.  
  294. S_Padding := Copy(S_Blanks,1,(L-DL));
  295.  
  296. If  Dl > 0 Then
  297.     S_Result := (DB * 16) + DF
  298. Else
  299.     S_Result := (NB * 16) + NF;
  300.  
  301. FillChar(S_NormAttrib,81,S_Result);
  302. S_NormAttrib[0] := Chr(80);
  303.  
  304.  
  305. If  T in [0..7,90..97] Then
  306.     Begin
  307.     S_Padding := ' ' + S_Padding + S + ' ';
  308.     If  Pos('-.',S) = 1 Then
  309.         Begin
  310.         S_Ins_Str := '0';
  311.         Insert(S_Ins_Str,S,2);
  312.         End;
  313.     If  S[1] <> '-' Then
  314.         S := '0' + S;
  315.     If  Pos('.',S) = 0 Then
  316.         S:= S + '.0'
  317.     Else
  318.         S := S + '0';
  319.     End
  320. Else
  321.     S_Padding := ' ' + S + S_Padding + ' ';
  322.  
  323. S_Write(R,C,L+2,S_Padding,S_NormAttrib);
  324. End;
  325.  
  326.  
  327.  
  328. Procedure S_FillScreen;
  329. VAR
  330. S_PointHold   : Integer;
  331. RealWork          : Real;
  332.  
  333. Begin
  334. S_PointHold := S_Point;
  335. S_Point     := 0;
  336. While S_Point < S_Indx^.S_Count[S_Num] Do
  337.     With S_Field^ Do
  338.         Begin
  339.         S_Point := S_Point + 1;
  340.         If  S_Type[S_Point] In [8,9,98,99] Then
  341.             Begin
  342.             Move(S_WorkArea^[S_FieldPtr^[S_Point]],S_EditStr,
  343.                  S_Len[S_Point] + 1);
  344.             S_DataLen[S_Point] := Ord(S_EditStr[0]);
  345.             End
  346.         Else
  347.             Begin
  348.             Move(S_WorkArea^[S_FieldPtr^[S_Point]],RealWork,6);
  349.             If  S_Type[S_Point] In [0,90] Then
  350.                 Begin
  351.                 Str(RealWork:1:0,S_EditStr);
  352.                 S_DataLen[S_Point] := Ord(S_EditStr[0]);
  353.                 End
  354.             Else
  355.                 Begin
  356.                 If  S_Type[S_Point] In [2..7] Then
  357.                     Str(RealWork:1:S_Type[S_Point]-1,S_EditStr)
  358.                 ELSE
  359.                     Str(RealWork:1:S_Type[S_Point]-91,S_EditStr);
  360.                 S_DataLen[S_Point] := Ord(S_EditStr[0]);
  361.                 END;
  362.             End;
  363.         S_DisplayScreenField(
  364.             S_Field^.S_Row[S_Point],
  365.             S_Field^.S_Col[S_Point],
  366.             S_Field^.S_Type[S_Point],
  367.             S_Field^.S_Len[S_Point],
  368.             S_Field^.S_DataLen[S_Point],
  369.             S_Field^.S_DisplayFg[S_Point],
  370.             S_Field^.S_DisplayBg[S_Point],
  371.             S_Field^.S_NormalFg[S_Point],
  372.             S_Field^.S_NormalBg[S_Point],
  373.             S_EditStr);
  374.         S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  375.         END;
  376. S_Point := S_PointHold;
  377. End;
  378.  
  379.  
  380.  
  381. Procedure S_Get_Field_Value(X:Integer);
  382. Var
  383. RealWork : Real;
  384. S_Result   : Integer;
  385.  
  386. Begin
  387. S_EditStr := '';
  388. With S_Field^ Do
  389.     Begin
  390.     If  S_Type[X] IN [8,9,98,99] Then
  391.         Move(S_WorkArea^[S_FieldPtr^[X]],S_EditStr,S_DataLen[X]+1)
  392.     Else
  393.         Begin
  394.         Move(S_WorkArea^[S_FieldPtr^[X]],RealWork,6);
  395.         IF  S_Type[X] In [0,90] Then
  396.             Str(RealWork:1:0,S_EditStr)
  397.         Else
  398.             IF  S_Type[X] In [2..7] Then
  399.                 Str(RealWork:1:S_Type[X]-1,S_EditStr)
  400.             ELSE
  401.                 Str(RealWork:1:S_Type[X]-1,S_EditStr);
  402.         S_DataLen[X] := Ord(S_EditStr[0]);
  403.         End;
  404.     End;
  405. End;
  406.  
  407.  
  408.  
  409. Procedure S_EditString (R,C,T,L,F,B,DF,DB,NF,NB,HR,HL:Integer;Var S:S_Str80);
  410. Var
  411. WorkNum  : Real;
  412. S_Result : Integer;
  413.  
  414. Begin
  415. S_Fg        := 2;
  416. S_Bg        := 0;
  417. S_Str_Pos   := 1;
  418. S_Ins_Str   := ' ';
  419.  
  420. S_Attrib := Trunc((B*16) + F);
  421.  
  422. If  S_Attrib > 15 Then
  423.     Begin
  424.     If  F = 0 then
  425.         S_Reverse := 15
  426.     Else
  427.         S_Reverse := F;
  428.     End
  429. Else
  430.     S_Reverse := (7*16) + F;
  431.  
  432. FillChar(S_EditAttrib,81,S_Attrib);
  433.  
  434. S_EditAttrib[0] := Chr(L+2);
  435.  
  436. If  T < 8 Then
  437.     Begin
  438.     If  Pos(S,'0.000000') > 0 then
  439.         S := '';
  440.     If  Pos('0.',S) = 1 Then
  441.         Delete(S,1,1);
  442.     If  Pos('-0.',S) = 1 Then
  443.         Delete(S,2,1);
  444.     End;
  445.  
  446. S_WorkStr    := S + S_Blanks;
  447. S_WorkStr[0] := Chr(L);
  448. S_Max_Dig    := L - T;
  449.  
  450. If  S_LeftArrow Then
  451.     Begin
  452.     S_Str_Pos := S_Length(S_WorkStr);
  453.     If  S_Str_Pos < L Then
  454.         S_Str_Pos := S_Str_Pos + 1;
  455.     End;
  456.  
  457. S_Setcursor(S_Cursor);
  458. Repeat
  459.     If  (T<8) And (S_Str_Pos > S_Length(S_WorkStr)) then
  460.         S_Str_Pos := S_Length(S_WorkStr)+1;
  461.  
  462.     S_EditAttrib[S_Str_Pos+1] := Chr(S_Reverse);
  463.     S_Write(R,C,L+2,' '+S_WorkStr+' ',S_EditAttrib);
  464.     GoToXY(C+S_Str_Pos,R);
  465.     S_GetKey;
  466.     S_EditAttrib[S_Str_Pos+1] := Chr(S_Attrib);
  467.     S_Write(R,C,L+2,' '+S_WorkStr+' ',S_EditAttrib);
  468.  
  469.     If  ((S_LeftArrow) Or (S_BackSpace)) Then
  470.         Begin
  471.         If  S_Str_Pos > 1 Then
  472.             Begin
  473.             S_Str_Pos := S_Str_Pos - 1;
  474.             If  S_BackSpace Then
  475.                 S_DeleteKey := True;
  476.             End
  477.         Else
  478.             Begin
  479.             If  S_LeftArrow Then
  480.                 Begin
  481.                 S_Shift := True;
  482.                 S_Tab   := True;
  483.                 End;
  484.             End;
  485.         End;
  486.     If  S_RightArrow Then
  487.         If  S_Str_Pos < L Then
  488.             Begin
  489.             If  (T < 8) And
  490.                 (S_Str_Pos > S_Length(S_WorkStr)) Then
  491.                 S_Tab := True
  492.             Else
  493.                 S_Str_Pos := S_Str_Pos + 1;
  494.             End
  495.         Else
  496.             S_Tab := True;
  497.     If  S_DeleteKey Then
  498.         Begin
  499.         If  S_Length(S_WorkStr) > 0 Then
  500.             Begin
  501.             Delete(S_WorkStr,S_Str_Pos,1);
  502.             S_WorkStr := S_WorkStr + #32;
  503.             End;
  504.         End;
  505.  
  506.     If  (Not S_Ctrl) And
  507.         (Not S_Alt ) And
  508.         (Not S_Fkey) And
  509.         (S_Ch In [#32..#127]) Then
  510.         Begin
  511.         If  T < 8 Then
  512.             Begin
  513.             If  (S_Ch = '?') And
  514.                 (S_Str_Pos > 1) Or
  515.                 (S_Ch <> '?')   Then
  516.                 Begin
  517.                 Case S_Ch of
  518.                    '-' : If ((Pos('-',S_WorkStr) > 0)
  519.                          Or (S_Str_Pos > 1)) Then
  520.                             S_Ch := #00;
  521.                    '.' : If ((T = 0 ) Or (Pos('.',S_WorkStr) > 0)) And
  522.                             (Pos('.',S_WorkStr) <> S_Str_Pos)  Then
  523.                             S_Ch := #00;
  524.                   '0'..'9':
  525.                 Else
  526.                     S_Ch := #00;
  527.                 End;{Case of}
  528.                 End;{Begin}
  529.             End;
  530.  
  531.         If  T = 8 Then
  532.             Begin
  533.             If  ((S_Ch = '?') And (S_Str_Pos>1)) Or (S_Ch<>'?') Then
  534.                 If  Not (S_Ch In [#32,'A'..'Z','a'..'z']) Then
  535.                     S_Ch := #00;
  536.             End;
  537.  
  538.         If  S_ch > #00 Then
  539.             Begin
  540.             If  S_InsertMode = True Then
  541.                 Begin
  542.                 If  S_Str_Pos <= L Then
  543.                     Begin
  544.                     S_Ins_Str[1] := S_Ch;
  545.                     Insert(S_Ins_Str,S_WorkStr,S_Str_Pos);
  546.                     End;
  547.                 End
  548.             Else
  549.                 S_WorkStr[S_Str_Pos] := S_ch;
  550.             If  S_Str_Pos < L Then
  551.                 S_Str_Pos := S_Str_Pos + 1
  552.             Else
  553.                 Begin
  554.                 S_Tab   := True;
  555.                 S_Shift := False;
  556.                 End;
  557.             S_WorkStr[0] := Chr(L);
  558.             End;
  559.         End;
  560.  
  561.     If  ((S_Enter) Or (S_Tab)) And
  562.         (S_WorkStr[1] = '?') Then
  563.         Begin
  564.         S_Msg := '';
  565.         If  (HR > 0) Then
  566.             Begin
  567.             Seek(S_File,HR);
  568.             Read(S_File,S_Indx^);
  569.             If  S_Indx^.S_RangeList[Hl][1]='H' Then
  570.                 S_Msg := Copy(S_Indx^.S_RangeList[HL],6,
  571.                          Length(S_Indx^.S_RangeList[Hl]));
  572.             Seek(S_File,0);
  573.             Read(S_File,S_Indx^);
  574.             End;
  575.         If  S_Msg = '' Then
  576.             S_Msg := ' No Help is available for this field ';
  577.         S_Enter  := False;
  578.         S_Tab    := False;
  579.         S_Wait   := True;
  580.         S_Str_Pos := S_Str_Pos - 1;
  581.         Delete(S_WorkStr,1,1);
  582.         End;
  583.  
  584. Until S_Enter Or
  585.       S_Tab   Or
  586.       S_Esc   Or
  587.       S_Fkey;
  588.  
  589. S_SetCursor(S_Off);
  590.  
  591. S_WorkStr := Copy (S_WorkStr,1,S_Length(S_WorkStr));
  592.  
  593. If  length(S_WorkStr) > 0 Then
  594.     S_Attrib := Trunc((DB*16) + DF)
  595. Else
  596.     S_Attrib := Trunc((NB*16) + NF);
  597.  
  598. FillChar(S_EditAttrib,81,S_Attrib);
  599. S_EditAttrib[0] := Chr(L+2);
  600.  
  601. S_Msg     := '';
  602.  
  603. If  T < 8 Then
  604.     Begin
  605.     If  S_WorkStr = '' then
  606.         S_workstr := '0.0';
  607.     If  S_WorkStr[1] = '.' Then
  608.         S_WorkStr := '0'+S_WorkStr;
  609.     If  Pos('-.',S_WorkStr) = 1 Then
  610.         Begin
  611.         S_Ins_Str[1] := '0';
  612.         Insert(S_Ins_Str,S_WorkStr,2);
  613.         End;
  614.     Val(S_WorkStr,WorkNum,S_Result);
  615.     If  T = 0 Then
  616.         Str(WorkNum:L:T,S_WorkStr)
  617.     Else
  618.         Str(WorkNum:L:(T-1),S_WorkStr);
  619.     While (S_WorkStr [1]= ' ') Or (Length(S_WorkStr)>L) Do
  620.          Delete(S_WorkStr,1,1);
  621.     If  Pos('0.',S_WorkStr) = 1 Then
  622.         Delete(S_WorkStr,1,1);
  623.     If  Pos('-0.',S_WorkStr) = 1 Then
  624.         Delete(S_WorkStr,2,1);
  625.     End;
  626.  
  627. If  T = 0 Then
  628.     If  S_WorkStr = '' Then
  629.         S_WorkStr := '0';
  630.  
  631. S_EditStr:= S_WorkStr;
  632. S        := S_WorkStr;
  633. S_DisplayScreenField(R,C,T,L,Length(S_EditStr),DF,DB,NF,NB,S);
  634. End;
  635.  
  636.  
  637.  
  638.  
  639. Procedure S_Find_Min_and_max;
  640. Begin
  641. FillChar(S_CompMin,81,00);
  642. FillChar(S_CompMax,81,00);
  643. S_Done := False;
  644. S_EndLine    := False;
  645. While Not S_Done Do
  646.     Begin
  647.     S_Str_Ptr := S_Str_Ptr + 1;
  648.     If  S_Str_Ptr <= Length(S_CurStr) Then
  649.         Begin
  650.         If  S_CurStr[S_Str_Ptr] = #94 Then
  651.             Begin
  652.             S_Str_Ptr  := S_Str_Ptr + 1;
  653.             S_CompMax := S_CurStr[S_Str_Ptr]
  654.             End
  655.         Else
  656.             Begin
  657.             If  S_CurStr[S_Str_Ptr] = #39 Then
  658.                 Begin
  659.                 If  S_CompMax = '' Then
  660.                     S_CompMax := S_CompMin;
  661.                 S_Done := True;
  662.                 End
  663.             Else
  664.                 Begin
  665.                 If  S_CompMax = '' then
  666.                     S_CompMin := S_CompMin + S_CurStr[S_Str_Ptr]
  667.                 Else
  668.                     S_CompMax := S_CompMax + S_CurStr[S_Str_Ptr];
  669.                 End;
  670.             End;
  671.         If  (S_CompMin = '\') or
  672.             (S_CompMin = '=') Then
  673.             S_Done := True;
  674.         End
  675.     Else
  676.         Begin
  677.         S_Done := True;
  678.         If  S_CompMin = '' Then
  679.             S_EndLine    := True;
  680.         End;
  681.     End;
  682. If  S_Upcase Then
  683.     Begin
  684.     S_CompMin := S_UpShiftedStr(S_CompMin);
  685.     S_CompMax := S_UpShiftedStr(S_CompMax);
  686.     End;
  687. End;
  688.  
  689.  
  690.  
  691. Procedure S_ReadNextRangeRec;
  692. Begin
  693. With S_Record^ Do
  694.     Begin
  695.     S_ValidateLine := S_NextLine;
  696.     If  S_RecNo <> S_NextRec Then
  697.         Begin
  698.         S_RecNo := S_NextRec;
  699.         Seek(S_File,S_RecNo);
  700.         Read(S_File,S_Record^);
  701.         End;
  702.     S_NextRec  := S_RangeRec [S_ValidateLine];
  703.     S_NextLine := S_RangeLine[S_ValidateLine];
  704.     S_CurStr := S_RangeList[S_ValidateLine];
  705.     If  S_InIf Then
  706.         S_Str_Ptr := 4
  707.     Else
  708.         S_Str_Ptr := 1;
  709.     End;
  710. End;
  711.  
  712.  
  713. Procedure S_ProcessDate;
  714. Label S_ProcessDate_Exit;
  715. Var
  716. TestLen,
  717. Error,
  718. M_Pos,
  719. D_Pos,
  720. Y_Pos     : Byte;
  721. T_Month,
  722. T_Day,
  723. T_Year    : Integer;
  724. DateMask  : String[30];
  725. WorkNum   : Integer;
  726.  
  727. Begin
  728. Error      := 0;
  729. M_Pos      := 0;
  730. D_Pos      := 0;
  731. Y_Pos      := 0;
  732.  
  733.  
  734. DateMask := Copy(S_CurStr,Pos('DATE',S_CurStr)+5,
  735.     Length(S_CurStr)-Pos('DATE',S_CurStr)+4);
  736. S_Str_Ptr   := 1;
  737.  
  738. If  Length(DateMask) <> Length(S_NewStr) then
  739.     Error := 1; {Date keyed does not match pattern};
  740.  
  741. While ((Error = 0) and (S_Str_Ptr <= Length(DateMask))) do
  742.     Begin
  743.     Case DateMask[S_Str_Ptr] of
  744.         'Y' : If  Y_Pos = 0 Then
  745.                   Begin
  746.                   Y_Pos := S_Str_Ptr;
  747.                   If  DateMask[S_Str_Ptr+2] = 'Y' Then
  748.                       TestLen := 4
  749.                   Else
  750.                       TestLen := 2;
  751.                   Val(Copy(S_NewStr,S_Str_Ptr,4),T_Year,S_Result);
  752.                   If  (S_Result > 0) Or (T_Year = 0) Then
  753.                       Error := 2;{Year has invalid character};
  754.                   S_Str_Ptr := S_Str_Ptr + (TestLen - 1);
  755.                   End;
  756.         'M' : If  M_Pos = 0 Then
  757.                   Begin
  758.                   M_Pos := S_Str_Ptr;
  759.                   Val(Copy(S_NewStr,S_Str_Ptr,2),T_Month,S_Result);
  760.                   If  (S_Result > 0) Or (T_Month = 0) Then
  761.                       Error := 3;{Month has invalid character};
  762.                   S_Str_Ptr := S_Str_Ptr + 1;
  763.                   End;
  764.         'D' : If  D_Pos = 0 Then
  765.                   Begin
  766.                   D_Pos := S_Str_Ptr;
  767.                   Val(Copy(S_NewStr,S_Str_Ptr,2),T_Day,S_Result);
  768.                   If  (S_Result > 0) Or (T_Day = 0) Then
  769.                       Error := 4;{Day has invalid character};
  770.                   S_Str_Ptr := S_Str_Ptr + 1;
  771.                   End;
  772.         Else  If  S_NewStr[S_Str_Ptr] <> DateMask [S_Str_Ptr] Then
  773.                   Error := 1;{Deliminators do not match};
  774.         End;{Case of}
  775.     S_Str_Ptr := S_Str_Ptr + 1;
  776.     End;
  777.  
  778. If  Error > 0 Then
  779.     goto S_ProcessDate_Exit;
  780.  
  781. If  (M_Pos > 0) And
  782.     (Not (T_Month In [1..12])) Then
  783.     Begin
  784.     Error := 6;{Invalid Month Specified}
  785.     goto S_ProcessDate_Exit;
  786.     End;
  787.  
  788. If  D_Pos > 0 Then
  789.     Begin
  790.     If  M_Pos > 0 Then
  791.         Begin
  792.         If  (T_Month In [1,3,5,7,8,10,12]) Then
  793.             Begin
  794.             If (T_Day > 31) Then
  795.                Error := 8;
  796.             End
  797.         Else
  798.             Begin
  799.             If  (T_Month <> 2) Then
  800.                 Begin
  801.                 If  (T_Day > 30) Then
  802.                     Error := 9;
  803.                 End
  804.             Else
  805.                 Begin
  806.                 If  (T_Year > 0) Then
  807.                     Begin
  808.                     If  (T_Year Mod 4) <> 0 Then
  809.                         Begin
  810.                         If  (T_Day > 28) Then
  811.                             Error := 10
  812.                         End
  813.                     Else
  814.                         If  (T_Day > 29) Then
  815.                             Error := 11;
  816.                     End
  817.                 Else
  818.                     If T_Day > 29 Then
  819.                        Error := 11;
  820.                 End;
  821.             End;
  822.         End
  823.     Else
  824.         If  T_Day > 31 Then
  825.             Error := 12;
  826.     End;
  827.  
  828. S_ProcessDate_Exit:
  829.  
  830. If  Error > 0 Then
  831.     Begin
  832.     S_ScreenValid := False;
  833.     Case Error Of
  834.        1 : S_Msg := 'Please enter date in ' + DateMask + ' format.';
  835.        2 : S_Msg := 'Year contains invalid charcter.';
  836.        3 : S_Msg := 'Month contains invalid character.';
  837.        4 : S_Msg := 'Day of date contains invalid character.';
  838.        6 : S_Msg := 'Month must be 1 thru 12.';
  839.        8 : S_Msg := 'Only 31 Days in this month.';
  840.        9 : S_Msg := 'Only 30 Days in this month.';
  841.        10: S_Msg := 'February only has 28 days.';
  842.        11: S_Msg := 'February only has 29 days.';
  843.        12: S_Msg := 'Day can never exceed 31';
  844.     End;
  845.     End;
  846.  
  847. End;
  848.  
  849.  
  850. Procedure S_ProcessIN;
  851. Begin
  852. S_EndLine    := True;
  853. S_Matched    := False;
  854. S_Str_Ptr    := Pos('IN',S_CurStr)+3;
  855. S_CompMin[1] := #32;
  856.  
  857. S_EditStr    := S_NewStr;
  858. If  S_Upcase Then
  859.     S_EditStr := S_UpShiftedStr(S_EditStr);
  860.  
  861. While Not((S_Matched) or (S_CompMin[1] IN ['\','='])) Do
  862.     Begin
  863.     S_Find_Min_and_max;
  864.     If  (S_CompMin <> '\')  And
  865.         (S_CompMin <> '=')  And
  866.         (Not S_EndLine) Then
  867.         Begin
  868.         If  (S_Field^.S_Type[S_Point] In [0..7,90..97]) Then
  869.             Begin
  870.             S_Numeric   := 0;
  871.             S_CompMin_Numeric := 0;
  872.             S_CompMax_Numeric := 0;
  873.             Val(S_EditStr,S_Numeric,S_Result);
  874.             Val(S_CompMin,S_CompMin_Numeric,S_Result);
  875.             Val(S_CompMax,S_CompMax_Numeric,S_Result);
  876.             If  (S_Numeric >= S_CompMin_Numeric) And
  877.                 (S_Numeric <= S_CompMax_Numeric) Then
  878.                 S_Matched := True;
  879.             End
  880.         Else
  881.             Begin
  882.             If  (S_EditStr >= S_CompMin) And
  883.                 (S_EditStr <= S_CompMax) Then
  884.                 S_Matched := True;
  885.             End;
  886.         End;
  887.     If  S_EndLine Then
  888.         Begin
  889.         S_EndLine := False;
  890.         S_ReadNextRangeRec;
  891.         S_Str_Ptr := S_Str_Ptr - 1;
  892.         Repeat
  893.             S_Str_Ptr := S_Str_Ptr + 1;
  894.         Until S_CurStr[S_Str_Ptr] IN [#39,'\','='];
  895.         If  S_CurStr[S_Str_Ptr] <> #39 Then
  896.             S_CompMin := S_CurStr[S_Str_Ptr];
  897.         End;
  898.     End;
  899.  
  900. If  S_Matched Then
  901.     Begin
  902.     While Not(S_CurStr[S_Str_Ptr] In ['\','=']) Do
  903.         Begin
  904.         S_Str_Ptr := Pos('\',S_CurStr);
  905.         If  S_Str_Ptr = 0 Then
  906.             S_Str_Ptr := Pos('=',S_CurStr);
  907.         If  S_Str_Ptr = 0 Then
  908.             Begin
  909.             S_ReadNextRangeRec;
  910.             S_Str_Ptr := 1;
  911.             End;
  912.         End;
  913.     If  S_CurStr[S_Str_Ptr] = '=' then
  914.         Begin
  915.         S_ScreenValid := False;
  916.         S_Msg         := Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
  917.         End
  918.     Else
  919.         S_Matched := False;
  920.     End
  921. Else
  922.     Begin
  923.     If  S_CurStr[S_Str_Ptr] = '\' then
  924.         Begin
  925.         S_ScreenValid := False;
  926.         S_Msg         := Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
  927.         End
  928.     End;
  929. End;
  930.  
  931.  
  932.  
  933. Procedure S_ProcessIf;
  934. Var
  935. End_Loop,
  936. Or_Found,
  937. NOT_Found,
  938. THEN_Found : Boolean;
  939. CompField  : String[16];
  940.  
  941. Begin
  942. S_CompMin  := '';
  943. S_CompMax  := '';
  944. S_Matched := FALSE;
  945. S_WorkStr     := S_EditStr;
  946. THEN_Found    := False;
  947. S_Skip    := False;
  948. While Not Then_Found do
  949.     Begin
  950.     If  Pos('NOT ',S_CurStr) = 4 Then
  951.         Begin
  952.         S_Str_Ptr    := 8;
  953.         NOT_Found := True;
  954.         End
  955.     Else
  956.         Begin
  957.         S_Str_Ptr    := 4;
  958.         NOT_Found := False;
  959.         End;
  960.  
  961.     CompField := '';
  962.     While S_CurStr[S_Str_Ptr] <> #39 Do
  963.         Begin
  964.         CompField := CompField + UpCase(S_CurStr[S_Str_Ptr]);
  965.         S_Str_Ptr   := S_Str_Ptr + 1;
  966.         End;
  967.  
  968.     S_FieldNo := 1;
  969.     S_Matched := False;
  970.     End_Loop  := False;
  971.  
  972.     While CompField <> S_UpShiftedStr(S_Field^.S_FieldName [S_FieldNo])Do
  973.         Begin
  974.         S_FieldNo := S_FieldNo + 1;
  975.         If  S_FieldNo > S_Indx^.S_Count[S_Num] Then
  976.             Begin
  977.             S_FieldNo := 1;
  978.             End_Loop  := True;
  979.             CompField := '';
  980.             S_Field^.S_FieldName[1]:='';
  981.             End;
  982.         End;
  983.  
  984.     S_Get_Field_Value(S_FieldNo);
  985.  
  986.     If  S_Upcase Then
  987.         S_EditStr := S_UpShiftedStr(S_EditStr);
  988.  
  989.     S_Matched := False;
  990.     End_Loop      := False;
  991.     While Not End_Loop do
  992.         Begin
  993.         Repeat
  994.             S_Find_Min_and_Max;
  995.             If  S_EndLine Then
  996.                 Begin
  997.                 S_ReadNextRangeRec;
  998.                 S_Str_Ptr := Pos(Chr(39),S_CurStr);
  999.                 End;
  1000.         Until Not(S_EndLine);
  1001.  
  1002.         If  ((S_CompMin='THEN') Or (S_CompMin='OR') Or (S_CompMin='AND')) Then
  1003.             End_Loop := True;
  1004.         If  Not((End_Loop) Or (S_Matched)) Then
  1005.             Begin
  1006.             If  (S_Field^.S_Type [S_FieldNo] In [0..7,90..97]) Then
  1007.                 Begin
  1008.                 S_Numeric   := 0;
  1009.                 S_CompMin_Numeric := 0;
  1010.                 S_CompMax_Numeric := 0;
  1011.                 Val(S_EditStr,S_Numeric,S_Result);
  1012.                 Val(S_CompMin,S_CompMin_Numeric,S_Result);
  1013.                 Val(S_CompMax,S_CompMax_Numeric,S_Result);
  1014.                 If  Not_Found Then
  1015.                     Begin
  1016.                     If  (S_Numeric < S_CompMin_Numeric) Or
  1017.                         (S_Numeric > S_CompMax_Numeric) Then
  1018.                         S_Matched := True
  1019.                     End
  1020.                 Else
  1021.                     Begin
  1022.                     If  (S_Numeric >= S_CompMin_Numeric) And
  1023.                         (S_Numeric <= S_CompMax_Numeric) Then
  1024.                         S_Matched := True;
  1025.                     End;
  1026.                 End
  1027.             Else
  1028.                 Begin
  1029.                 If  Not_Found Then
  1030.                     Begin
  1031.                     If  (S_EditStr < S_CompMin) Or
  1032.                         (S_EditStr > S_CompMax) Then
  1033.                         S_Matched := True
  1034.                     End
  1035.                 Else
  1036.                     Begin
  1037.                     If  (S_EditStr >= S_CompMin) And
  1038.                         (S_EditStr <= S_CompMax) Then
  1039.                         S_Matched := True;
  1040.                     End;
  1041.                 End;
  1042.             End;
  1043.         End;
  1044.  
  1045.     If  S_CompMin = 'AND' Then
  1046.         Begin
  1047.         If  Not S_Matched Then
  1048.             Begin
  1049.             Repeat
  1050.                 S_ReadNextRangeRec;
  1051.             Until ((Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Or
  1052.                    (Pos('OR',S_CurStr) = Length(S_CurStr)-1));
  1053.             If  (Pos('OR',S_CurStr) = Length(S_CurStr)-1) Then
  1054.                 S_CompMin := 'OR';
  1055.             If  (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then
  1056.                 Then_Found := True;
  1057.             End
  1058.         Else
  1059.             S_ReadNextRangeRec;
  1060.         End;
  1061.  
  1062.     If  S_CompMin = 'OR' Then
  1063.         Begin
  1064.         If  S_Matched Then
  1065.             Repeat
  1066.                 S_ReadNextRangeRec;
  1067.                 If  (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then
  1068.                     Then_Found := True;
  1069.             Until Then_Found
  1070.         Else
  1071.             S_ReadNextRangeRec;
  1072.         End;
  1073.     If  S_CompMin = 'THEN' Then
  1074.         Then_Found := True;
  1075.     End;
  1076.  
  1077. If  S_Matched Then
  1078.     Begin
  1079.     S_Matched := False;
  1080.     While S_CurStr <> 'ENDIF' Do
  1081.         Begin
  1082.         S_ReadNextRangeRec;
  1083.         If  (Pos('ERROR',S_CurStr) = 4) Then
  1084.             Begin
  1085.             S_ScreenValid := False;
  1086.             S_Msg         := Copy(S_CurStr,9,Length(S_CurStr));
  1087.             End;
  1088.         If  (Pos('DATE',S_CurStr) = 4) Then
  1089.             S_ProcessDate;
  1090.         If  S_CurStr = '   SKIP' Then
  1091.             S_Skip   := True;
  1092.         If  (Pos('IN',S_CurStr) = 4) Then
  1093.             Begin
  1094.             S_Str_Ptr := 4;
  1095.             S_InIf := True;
  1096.             S_ProcessIn;
  1097.             S_InIf := False;
  1098.             End;
  1099.         If  (S_ScreenValid = False) Or
  1100.             (S_Skip)         Then
  1101.             While S_CurStr <> 'ENDIF' Do
  1102.                 S_ReadNextRangeRec
  1103.         End;
  1104.     End
  1105. Else
  1106.     While S_CurStr <> 'ENDIF' Do
  1107.         S_ReadNextRangeRec;
  1108.  
  1109. S_EditStr := S_WorkStr;
  1110. End;
  1111.  
  1112.  
  1113. Procedure S_Validate_Location;
  1114. Var
  1115. WorkStr : String[1];
  1116. Begin
  1117. S_Upcase      := False;
  1118. S_ScreenValid := True;
  1119. S_WorkStr     := '';
  1120. S_Skip        := False;
  1121.  
  1122. With S_Record^ do
  1123.     Begin
  1124.     While ((S_NextRec > 0) And (S_ScreenValid)) And (Not S_Skip) Do
  1125.         Begin
  1126.         S_ReadNextRangeRec;
  1127.         If  (S_CurStr[1] = 'I') Then
  1128.             Begin
  1129.             If  S_CurStr[2] = 'F' Then
  1130.                 S_ProcessIf
  1131.             Else
  1132.                 S_ProcessIN;
  1133.             End;
  1134.         If  S_CurStr [1] = 'U' Then
  1135.             Begin
  1136.             If  S_CurStr[11] = 'N' Then
  1137.                 Begin
  1138.                 S_Upcase := True;
  1139.                 S_EditStr := S_UpShiftedStr(S_EditStr);
  1140.                 End
  1141.             Else
  1142.                 Begin
  1143.                 S_Upcase := False;
  1144.                 S_EditStr := S_NewStr;
  1145.                 End;
  1146.             End;
  1147.         If  (S_CurStr[1] = 'S') Then {Skip if Blank}
  1148.             If  S_EditStr = '' Then
  1149.                 S_NextRec  := 0;
  1150.         If  (S_CurStr[3] = 'Q') Then {Required}
  1151.             Begin
  1152.             If  S_EditStr =  '' Then
  1153.                 Begin
  1154.                 WorkStr[0] := #01;
  1155.                 WorkStr[1] := #39;
  1156.                 S_Str_Ptr  := Pos(WorkStr,S_CurStr);
  1157.                 S_ScreenValid := False;
  1158.                 If  S_Str_Ptr = 0 Then
  1159.                     S_Msg := 'This field is required'
  1160.                 Else
  1161.                     S_Msg := Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr)-S_Str_Ptr);
  1162.                 End;
  1163.             End;
  1164.         If  S_CurStr[1] = 'D' Then {Date}
  1165.             S_ProcessDate;
  1166.         End;
  1167.     End;
  1168. End;
  1169.  
  1170.  
  1171.  
  1172. Procedure S_ValidateScreen;
  1173. Begin
  1174. If  S_ValidateField > 0 Then
  1175.     S_Point := S_ValidateField
  1176. Else
  1177.     S_Point := 1;
  1178.  
  1179. S_FieldCounter      := 0;
  1180. S_RecNo             := 9999;
  1181. S_ScreenValid       := True;
  1182. S_Validate_Finished := False;
  1183. Repeat
  1184.     While (S_Field^.S_Type [S_Point] > 9) And
  1185.         (S_FieldCounter <= S_Indx^.S_Count[S_Num]) do
  1186.         Begin
  1187.         S_FieldCounter := S_FieldCounter + 1;
  1188.         S_Point := S_Field^.S_Next [S_Point];
  1189.         End;
  1190.     If  S_Point <= S_Indx^.S_Count[S_Num] then
  1191.         Begin
  1192.         S_Get_Field_Value(S_Point);
  1193.         S_NewStr   := S_EditStr;
  1194.         S_NextRec  := S_Field^.S_RangeNextRec  [S_Point];
  1195.         S_NextLine := S_Field^.S_RangeNextLine [S_Point];
  1196.         S_Validate_Location;
  1197.         If  S_ScreenValid  Then
  1198.             Begin
  1199.             If  S_ValidateField > 0 then
  1200.                 S_Validate_Finished := True
  1201.             Else
  1202.                 Begin
  1203.                 S_Point := S_Point + 1;
  1204.                 S_FieldCounter := S_FieldCounter +1;
  1205.                 End;
  1206.             End
  1207.         Else
  1208.             S_Validate_Finished := True;
  1209.         End
  1210.     Else
  1211.         S_Validate_Finished := True;
  1212.  
  1213. Until (S_Validate_Finished);
  1214. S_ChangeScreen := False;
  1215. S_PointHold    := S_Point;
  1216. S_NewStr       := S_Msg;
  1217. S_LoadScreen(S_Indx^.S_Name[S_Num]);
  1218. S_Msg          := S_NewStr;
  1219. S_Point        := S_PointHold;
  1220. S_ChangeScreen := True;
  1221. End;
  1222.  
  1223.  
  1224. Procedure S_NextKey;
  1225. Var
  1226. ShowStatusHold : Boolean;
  1227. Begin
  1228. ShowStatusHold := S_ShowStatus;
  1229. S_ShowStatus   := False;
  1230. S_GetKey;
  1231. S_ShowStatus   := ShowStatusHold;
  1232. End;
  1233.  
  1234.  
  1235.  
  1236. Procedure S_ReadKey;
  1237. Begin
  1238. If  S_Indx^.S_Count[S_Num] > 0 Then
  1239.     S_FillScreen;
  1240. If  S_Msg > '' Then
  1241.     S_Wait := True;
  1242. S_GetKey;
  1243. End;
  1244.  
  1245.  
  1246.  
  1247. Procedure S_ReadField;
  1248. Var
  1249. RealWork   : Real;
  1250. S_Result   : Integer;
  1251. Testcnt : integer;
  1252.  
  1253. Begin
  1254.  
  1255. If  S_Indx^.S_Count[S_Num] > 0 Then
  1256.     S_FillScreen;
  1257.  
  1258. If  (S_Point < 0) Or (S_Point > S_Indx^.S_Count[S_Num]) Then
  1259.     Begin
  1260.     S_Msg := ' Field number in S_Point is out of range ';
  1261.     S_ReadKey;
  1262.     Exit;
  1263.     End;
  1264.  
  1265. If  S_Field^.S_Type[S_Point] > 9 then
  1266.     Begin
  1267.     S_Msg := ' Cannot read a DISPLAY only field - Any Key To Continue';
  1268.     S_Readkey;
  1269.     Exit;
  1270.     End;
  1271.  
  1272. S_PointHold := S_Point;
  1273.  
  1274. Repeat
  1275.     If  S_Msg > '' Then
  1276.         S_Wait := True;
  1277.  
  1278.     S_Get_Field_Value(S_Point);
  1279.  
  1280.     Repeat
  1281.         S_EditString (
  1282.             S_Field^.S_Row[S_Point],
  1283.             S_Field^.S_Col[S_Point],
  1284.             S_Field^.S_Type[S_Point],
  1285.             S_Field^.S_Len[S_Point],
  1286.             S_Field^.S_PromptFG[S_Point],
  1287.             S_Field^.S_PromptBG[S_Point],
  1288.             S_Field^.S_DisplayFg[S_Point],
  1289.             S_Field^.S_DisplayBg[S_Point],
  1290.             S_Field^.S_NormalFg[S_Point],
  1291.             S_Field^.S_NormalBg[S_Point],
  1292.             S_Field^.S_RangeNextRec[S_Point],
  1293.             S_Field^.S_RangeNextLine[S_Point],
  1294.             S_EditStr);
  1295.  
  1296.             S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  1297.             If  S_Field^.S_Type[S_Point] in [0..7,90..97] Then
  1298.                 Begin
  1299.                 Val(S_EditStr,RealWork,S_Result);
  1300.                 Move(RealWork,S_WorkArea^[S_FieldPtr^[S_Point]],6);
  1301.                 End
  1302.             Else
  1303.                 MOVE(S_EditStr,S_WorkArea^[S_FieldPtr^[S_Point]],
  1304.                     S_Field^.S_Len[S_Point] + 1);
  1305.  
  1306.         If  S_Tab Then
  1307.             S_Fkey := True;
  1308.  
  1309.     Until ((S_Enter) or
  1310.            (S_PointHold <> S_Point) or
  1311.            (S_Fkey));
  1312.  
  1313.     S_Point := S_PointHold;
  1314.  
  1315.     If  (S_Enter)      Or
  1316.         (S_Tab)        Or
  1317.         (S_LeftArrow)  Or
  1318.         (S_RightArrow) Then
  1319.         Begin
  1320.         If  (S_Field^.S_RangeNextRec[S_Point] > 0) Then
  1321.             Begin
  1322.             S_ValidateField := S_Point;
  1323.             S_ValidateScreen;
  1324.             S_ValidateField := 0;
  1325.             If  not S_ScreenValid Then
  1326.                 S_ResetKeyFlags;
  1327.             End
  1328.         Else
  1329.             If  (Length(S_EditStr) > S_Field^.S_Len[S_Point]) Or (S_Enter) Then
  1330.                 S_ScreenValid := True;
  1331.         End;
  1332. Until (S_ScreenValid) Or (S_Fkey);
  1333. End;
  1334.  
  1335.  
  1336.  
  1337. Procedure S_ReadScreen;
  1338. Var
  1339. RealWork   : Real;
  1340. S_Result   : Integer;
  1341.  
  1342. Begin
  1343. Case S_Indx^.S_CompiledInd [S_Num] Of
  1344.   1,2 : S_ReadKey;
  1345.     3 : Begin
  1346.         S_ScreenValid   := False;
  1347.         S_ValidateField := 0;
  1348.         Repeat
  1349.             S_FillScreen;
  1350.  
  1351.             If  S_Msg > '' Then
  1352.                 S_Wait := True;
  1353.  
  1354.             S_PointHold := 0;
  1355.  
  1356.             If  (S_Point > S_Indx^.S_Count[S_Num]) Or
  1357.                 (S_Point < 1) then
  1358.                 S_Point := S_Indx^.S_First[S_Num];
  1359.  
  1360.             Repeat
  1361.                 If  S_PointHold <> S_Point then
  1362.                     Begin
  1363.                     If  S_Field^.S_Type [S_Point] > 9 then
  1364.                         Repeat
  1365.                             If  S_Direction > 0 then
  1366.                                 S_Point := S_Field^.S_Next [S_Point];
  1367.                             If  S_Direction < 0 then
  1368.                                 S_Point := S_Field^.S_Prev [S_Point];
  1369.                         Until S_Field^.S_Type [S_Point] < 10;
  1370.                     S_PointHold := S_Point;
  1371.                     S_Get_Field_Value(S_Point);
  1372.                     End;
  1373.                 S_EditString(
  1374.                     S_Field^.S_Row[S_Point],
  1375.                     S_Field^.S_Col[S_Point],
  1376.                     S_Field^.S_Type[S_Point],
  1377.                     S_Field^.S_Len[S_Point],
  1378.                     S_Field^.S_PromptFG[S_Point],
  1379.                     S_Field^.S_PromptBG[S_Point],
  1380.                     S_Field^.S_DisplayFg[S_Point],
  1381.                     S_Field^.S_DisplayBg[S_Point],
  1382.                     S_Field^.S_NormalFg[S_Point],
  1383.                     S_Field^.S_NormalBg[S_Point],
  1384.                     S_Field^.S_RangeNextRec[S_Point],
  1385.                     S_Field^.S_RangeNextLine[S_Point],
  1386.                     S_EditStr);
  1387.  
  1388.                 S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  1389.  
  1390.                 If  S_Field^.S_Type[S_Point] in [0..7,90..97] Then
  1391.                     Begin
  1392.                     Val(S_EditStr,RealWork,S_Result);
  1393.                     Move(RealWork,S_WorkArea^[S_FieldPtr^[S_Point]],6);
  1394.                     End
  1395.                 Else
  1396.                     MOVE(S_EditStr,S_WorkArea^[S_FieldPtr^[S_Point]],
  1397.                         S_Field^.S_Len[S_Point] + 1);
  1398.  
  1399.                 If  S_Tab Then
  1400.                     Begin
  1401.                     If  S_Shift then
  1402.                         S_Direction := - 1
  1403.                     Else
  1404.                         S_Direction := 1;
  1405.                     If  S_Direction > 0 Then
  1406.                         S_Point := S_Field^.S_Next[S_Point]
  1407.                     Else
  1408.                         S_Point := S_Field^.S_Prev[S_Point];
  1409.                     End;
  1410.  
  1411.             Until ((S_Enter)or(S_Fkey));
  1412.  
  1413.             If  S_ENTER then
  1414.                 S_ValidateScreen;
  1415.  
  1416.         Until(S_ScreenValid) OR (S_Fkey);
  1417.         End;
  1418.     End;{Case of}
  1419. S_Point := 0;
  1420. End;
  1421.