home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / EDITORES / TSCREDD2.ZIP / SCRDISK4.EXE / SCREDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-17  |  53.0 KB  |  2,441 lines
  1.  {$M 8000,0,96000}
  2. {$R-} {Range checking off}
  3. {$B+} {Boolean complete evaluation on}
  4. {$S+} {Stack checking on}
  5. {$I+} {I/O checking on}
  6. {$N-} {No numeric coprocessor}
  7. Unit ScrEdit;
  8.  
  9. Interface
  10.  
  11. {$DEFINE MOUSE}
  12. {$DEFINE VALIDATE}
  13. {$DEFINE COLORCHANGE}
  14.  
  15. {$IFDEF MOUSE}
  16.   Uses Crt,Dos,ScrMouse;
  17. {$ELSE}
  18.   Uses Crt,Dos;
  19. {$ENDIF}
  20.  
  21. Const
  22. S_St : Integer   = 0;
  23. S_FileOpen: Boolean   = False;
  24. S_DupFields: Boolean   = False;
  25. S_SetDupFields : Boolean   = False;
  26. S_DupType: Boolean   = False;
  27. S_EntryType: Boolean   = False;
  28. S_DispType: Boolean   = False;
  29. S_ChangeScreen: Boolean   = True;
  30. S_LineSize: Integer   = 160;
  31. S_Zeros: String[8] = '00000000';
  32.  
  33. Type
  34. S_128= Array[1..128] of Byte;
  35. S_Cursors= (S_Off,S_Bold,S_Normal,S_InverseBold,S_InverseNormal,S_GetCursor);
  36. S_RecType= (S_Index,S_Data,S_Fields,S_FieldRanges);
  37. S_Str8= String[8];
  38. S_Str80= String[80];
  39. S_Rec= Record
  40.   Case S_RecordType:S_RecType of
  41.     S_Index:  {Total Bytes 3457}
  42.       (S_Name         : Array[1..128] of String[16];
  43.        S_Number       : S_128;
  44.        S_RecordNumber : Array[1..128] of Integer;
  45.        S_FieldsRecNo  : Array[1..128] of Integer;
  46.        S_RangeRecNo   : Array[1..128] of Integer;
  47.        S_FirstField   : S_128;
  48.        S_Count        : S_128;
  49.        S_CompiledInd  : S_128;
  50.        S_RangeRecNext : Integer;
  51.        S_RangeLineNext: Integer;
  52.        S_sFiled       : Integer;);
  53.     S_Data:   {Total Bytes 3840 + 1}
  54.       (S_Video        : Array[1..3840]of Char;
  55.        S_WorkArray    : Array[1..80,1..2] of Char;);
  56.     S_Fields: {Total Bytes 4225}
  57.       (S_FieldName    : Array[1..128] of String[16];
  58.        S_Row          : S_128;
  59.        S_Col          : S_128;
  60.        S_Len          : S_128;
  61.        S_Type         : S_128;
  62.        S_Prev         : S_128;
  63.        S_Next         : S_128;
  64.        S_DataLen      : S_128;
  65.        S_NormalBG     : S_128;
  66.        S_NormalFG     : S_128;
  67.        S_PromptBG     : S_128;
  68.        S_PromptFG     : S_128;
  69.        S_DisplayBG    : S_128;
  70.        S_DisplayFG    : S_128;
  71.        S_RangeNextRec : Array[1..128] of Integer;
  72.        S_RangeNextLine: S_128);
  73.     S_FieldRanges: {Total Bytes 3608 + 1}
  74.       (S_RangeList  : Array[1..51] of String[78];
  75.        S_RangeRec   : Array[1..51] of Integer;
  76.        S_RangeLine  : Array[1..51] of Byte);
  77.        End;
  78. S_RecPointer= ^S_Rec;
  79. WorkAreaType= Array[1..4096] of byte;
  80. WorkAreaPtr= ^WorkAreaType;
  81. FieldPointerType= Array[1..128] of integer;
  82. FieldPointer= ^FieldPointerType;
  83. BufferPointerType= Array[1..128] of Pointer;
  84. BufferPointer= ^BufferPointerType;
  85.  
  86. Var
  87. S_File: File of S_Rec;
  88. S_Indx: S_RecPointer;
  89. S_Record: S_RecPointer;
  90. S_Field: S_RecPointer;
  91. S_Validate: S_RecPointer;
  92. S_WorkArea: WorkAreaPtr;
  93. S_FieldPtr: FieldPointer;
  94. S_BuffPtr: BufferPointer;
  95.  
  96. S_Cursor: S_Cursors;
  97. S_CursorOld: Integer;
  98. S_ErrorMsg,
  99. S_UserMsg,
  100. S_Msg,
  101. S_WorkStr,
  102. S_EditStr,
  103. S_EditMask,
  104. S_InitialValue,
  105. S_AutoHelpMsg : S_Str80;
  106. S_FastVideo,
  107. S_BufferOnly,
  108. S_DelayScreen,
  109. S_Delayed,
  110. S_QuickHelp,
  111. S_SetDupeFields,
  112. S_Force_EditMask,
  113. S_AutoHelp,
  114. S_AutoValidate :Boolean;
  115. S_FType,
  116. S_StLabelColor,
  117. S_StLabelBg,
  118. S_StLabelFg,
  119. S_StColor,
  120. S_StBg,
  121. S_StFg,
  122. S_ErrorBg,
  123. S_ErrorFg,
  124. S_HelpBg,
  125. S_HelpFg,
  126. S_UserBg,
  127. S_UserFg: Byte;
  128. S_ScrEditPrevExit : Pointer;
  129. S_VRec,
  130. S_RecNo,
  131. S_MessBg,
  132. S_MessFg,
  133. S_Num,
  134. S_Count,
  135. S_FirstField,
  136. S_Direction,
  137. S_PrevFld,
  138. S_Point,
  139. S_RegCX : Integer;
  140. S_Day,
  141. S_Month,
  142. S_Year,
  143. S_DayOfWeek,
  144. S_HelpFreq,
  145. S_HelpDur,
  146. S_UserFreq,
  147. S_UserDur,
  148. S_ErrorFreq,
  149. S_ErrorDur,
  150. S_Freq,
  151. S_Dur,
  152. S_Seg,
  153. S_Ofs  : Word;
  154. S_Wait,
  155. S_BW,
  156. S_Sound_Hold,
  157. S_Sound,
  158. S_UserSound,
  159. S_HelpSound,
  160. S_ErrorSound,
  161. S_ShowStatus,
  162. S_EnterAsTab,
  163. S_Mono,
  164. S_Fkey,
  165. S_Shift,
  166. S_LeftShift,
  167. S_RightShift,
  168. S_Alt,
  169. S_Ctrl,
  170. S_ScrollLock,
  171. S_NumLock,
  172. S_Caps,
  173. S_ESC,
  174. S_Enter,
  175. S_F1,
  176. S_F2,
  177. S_F3,
  178. S_F4,
  179. S_F5,
  180. S_F6,
  181. S_F7,
  182. S_F8,
  183. S_F9,
  184. S_F10,
  185. S_F11,
  186. S_F12,
  187. S_BkSp,
  188. S_Home,
  189. S_Up,
  190. S_PgUp,
  191. S_Left,
  192. S_Right,
  193. S_End,
  194. S_Down,
  195. S_PgDn,
  196. S_Ins,
  197. S_Del,
  198. S_Tab,
  199. S_InsertMode,
  200. S_LeftArrow,
  201. S_RightArrow,
  202. S_InsertKey,
  203. S_DeleteKey,
  204. S_BackSpace,
  205. S_Validate_Upcase,
  206. S_VDone,
  207. S_ScreenValid : Boolean;
  208. S_Attrib,
  209. S_Reverse     : Byte;
  210. S_Ch          : Char;
  211. S_Ch_Num      : Byte absolute S_Ch;
  212. S_NumLockBit  : Integer absolute $40:$17;
  213.  
  214. Var
  215. S_Ins_Str     : String[1];
  216. S_NewStr,
  217. S_Blanks,
  218. S_Padding,
  219. S_WorkAttrib,
  220. S_NormAttrib,
  221. S_EditAttrib  : String[80];
  222. S_StAttrWork  : String[20];
  223. S_StAttrib,
  224. S_StLine  : String[40];
  225. S_ValidateField,
  226. S_V_RecNo,
  227. S_ValidateLine,
  228. S_Fg,
  229. S_Bg,
  230. S_Max_Dec,
  231. S_Max_Dig,
  232. S_Dec_Pos,
  233. S_Pos : Integer;
  234. S_UpCase,
  235. S_Skip,
  236. S_Matched,
  237. S_Done,
  238. S_EndLine,
  239. S_InIf : Boolean;
  240. S_CompMin,
  241. S_CompMax,
  242. S_CurStr  : S_Str80;
  243. S_FieldCounter,
  244. S_NextRec,
  245. S_NextLine,
  246. S_Result,
  247. S_FieldNo,
  248. S_Str_Ptr  : Integer;
  249. S_Numeric,
  250. S_CompMin_Numeric,
  251. S_CompMax_Numeric  :Real;
  252. S_VideoPort : Integer absolute $40:$63;
  253.  
  254. Function  S_SetDisplayOff(X:Integer):Integer;
  255. Function  S_SetDisplayOn(X:Integer):Integer;
  256. Function  S_IsDupe(S_Index:Integer):Boolean;
  257. Function  S_SetDupe(S_Index:Integer):Boolean;
  258. Procedure S_ReSetDupe(S_Index:Integer);
  259. Function  S_UpShiftedStr(Target_String:S_Str80):S_Str80;
  260. {$IFDEF COLORCHANGE}
  261. Function  S_ChangeFieldColor(Fl,ST,Bg,Fg:Integer):Integer;
  262. Function  S_ChangeScreenColor(CT,Bg,Fg:Byte;SR,ER,SC,EC:Integer):Integer;
  263. Procedure S_StoreColorChanges;
  264. {$ENDIF}
  265. Procedure S_RefreshScreen;
  266. Procedure S_ClearDupes;
  267. Procedure S_SetCursor(Switch:S_Cursors);
  268. Procedure S_Beep(Freq,Dur:Word);
  269. Procedure S_PreEdit (HR,HL:Integer);
  270. Procedure S_EditString (R,C,T,L,F,B,DF,DB,NF,NB,HR,HL:Integer;Var S:S_Str80);
  271. Procedure S_DisplayScreenField(R,C,T,L,DL,DF,DB,NF,NB:Integer;Var S:S_Str80);
  272.  
  273.  
  274. Procedure S_OpenScreenFile(ScrFileName:S_Str80);
  275. Procedure S_LoadScreen(ScrName:S_Str80);
  276. Procedure S_ClearScreen(Initialize:Integer);
  277. Procedure S_CloseScreenFile;
  278.  
  279. Procedure S_ResetKeyFlags;
  280. Procedure S_NextKey;
  281. Procedure S_ReadKey;
  282. Procedure S_ReadField;
  283. Procedure S_ReadScreen;
  284.  
  285. Procedure S_FillScreen;
  286. Procedure S_DisplayMessage(BackG,ForG : Integer; Message: S_Str80);
  287. Procedure S_PutScrMem(var Source, Dest; Len : integer);
  288. Procedure S_GetScrMem(var Source, Dest; Len : integer);
  289. Procedure S_Write(Row,Col,Lgth : Integer; Lines,Attribs : S_Str80);
  290. Procedure S_FlushKeyBuf;
  291.  
  292. Procedure S_ValidateScreen;
  293. Procedure S_Validate_Location;
  294. Procedure S_Store_Buf_Loc (ScrName:S_Str80;ScrBuf:WorkAreaPtr);
  295. Procedure S_GetFieldType (Var FType:Byte);
  296. {==}
  297. Implementation
  298. {==}
  299.  
  300. {$F+}
  301. Procedure S_ExitProc;
  302. Begin
  303. S_SetCursor(S_Normal);
  304. End;
  305. {$F-}
  306.  
  307.  
  308.  
  309. Procedure S_Write(Row,Col,Lgth : Integer; Lines,attribs : S_Str80);
  310. Var Pointer:integer;
  311. Begin
  312. For Pointer := 1 to lgth do
  313.   Begin
  314.   S_Record^.S_WorkArray[Pointer,1] := Chr(Ord(Lines[Pointer]));
  315.   S_Record^.S_WorkArray[Pointer,2] := Chr(Ord(Attribs[Pointer]));
  316.   End;
  317. S_PutScrMem(S_Record^.S_WorkArray[1,1],
  318.   Mem[S_Seg:S_Ofs + ((Row-1)*S_LineSize) + ((Col-1)*2)],Lgth * 2);
  319. End;
  320.  
  321.  
  322.  
  323.  
  324.  
  325. Function S_UpShiftedStr(Target_String:S_Str80):S_Str80;
  326. Var
  327. Point : integer;
  328. Begin
  329. Point := 1;
  330. While Point <= Length(Target_String) do
  331.   Begin
  332.   Target_String[Point] := UpCase(Target_String[Point]);
  333.   Point := Point + 1;
  334.   End;
  335. S_UpShiftedStr := Target_String;
  336. End;
  337.  
  338.  
  339.  
  340. Function S_TruncateStr(S:S_Str80):S_Str80;
  341. Var TStr : String;
  342. Begin
  343. TStr := S + S_Blanks;
  344. TStr[0] := Chr(Pos(S_Blanks,TStr)-1);
  345. S_TruncateStr := TStr;
  346. End;
  347.  
  348.  
  349.  
  350. Procedure S_FlushKeyBuf;
  351. Var
  352. S_Regs : Registers;
  353. Begin
  354. FillChar(S_Regs,SizeOf(S_Regs),00);
  355. S_Regs.AH := $0C;
  356. Intr($21,S_Regs);
  357. End;
  358.  
  359.  
  360.  
  361.  
  362.  
  363. Function S_Length(Var S:S_Str80):Integer;
  364. Begin
  365. S_Length:=Pos(S_Blanks,S+S_Blanks) - 1;
  366. End;
  367.  
  368.  
  369.  
  370.  
  371. Function S_FindScreen(ScrName:S_Str80):Integer;
  372. Var S_Count:Integer;
  373. Begin
  374. S_Count := 0;
  375. Repeat
  376.   S_Count := S_Count + 1;
  377. Until ((S_UpShiftedStr(ScrName)=S_UpShiftedStr(S_Indx^.S_Name[S_Count])) or
  378.    (S_Count > S_Indx^.S_sFiled));
  379. If S_Count > S_Indx^.S_sFiled Then
  380.   S_ErrorMsg := ' Is not in file.'
  381. Else
  382.   If  S_Indx^.S_CompiledInd[S_Count] = 0 Then
  383.     S_ErrorMsg := ' has not been compiled..'
  384.   Else
  385.     S_ErrorMsg := '';
  386. S_St := 0;
  387. If (S_ChangeScreen = True) And (S_ErrorMsg > '') then
  388.   Begin
  389.   S_St := 1;
  390.   S_DisplayMessage(S_MessBg,S_MessFg,'<'+ScrName+'>'+S_ErrorMsg);
  391.   S_CloseScreenFile;
  392.   End;
  393. S_FindScreen := S_Count;
  394. End;
  395.  
  396.  
  397.  
  398.  
  399.  
  400. Procedure S_PutScrMem(var Source, Dest; Len : integer);
  401. Begin
  402. If (S_Mono) Or (S_FastVideo) Then
  403.   Move(Source,Dest,Len)
  404. Else
  405.   Begin
  406.   Len := Len shr 1;
  407.   Inline($1E/$55/$BA/$DA/$03/$C5/$B6/Source/$C4/$BE/Dest/$8B/$8E/
  408.     Len/$FC/$AD/$89/$C5/$B4/$09/$EC/$D0/$D8/$72/$FB/$FA/$EC/
  409.     $20/$E0/$74/$FB/$89/$E8/$AB/$FB/$E2/$EA/$5D/$1F);
  410.   End;
  411. End;
  412.  
  413.  
  414.  
  415.  
  416.  
  417. Procedure S_GetScrMem(var Source, Dest; Len : integer);
  418. Begin
  419. If (S_Mono) Or (S_FastVideo) Then
  420.   Move(Source,Dest,Len)
  421. Else
  422.   Begin
  423.   Len := Len shr 1;
  424.   Inline($1E/$55/$BA/$DA/$03/$C5/$B6/Source/$C4/$BE/Dest/$8B/$8E/
  425.     Len/$FC/$EC/$D0/$D8/$72/$FB/$FA/$EC/$D0/$D8/$73/$FB/$AD/
  426.     $FB/$AB/$E2/$F0/$5D/$1F);
  427.   End;
  428. End;
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435. Procedure S_ResetKeyFlags;
  436. Begin
  437. S_Fkey:= False;
  438. S_Tab:= False;
  439. S_Ctrl:= False;
  440. S_Esc:= False;
  441. S_Alt:= False;
  442. S_Shift:= False;
  443. S_F1:= False;
  444. S_F2:= False;
  445. S_F3:= False;
  446. S_F4:= False;
  447. S_F5:= False;
  448. S_F6:= False;
  449. S_F7:= False;
  450. S_F8:= False;
  451. S_F9:= False;
  452. S_F10:= False;
  453. S_F11:= False;
  454. S_F12:= False;
  455. S_Enter:= False;
  456. S_BkSp:= False;
  457. S_Home:= False;
  458. S_Up:= False;
  459. S_PgUp:= False;
  460. S_Left:= False;
  461. S_Right:= False;
  462. S_End:= False;
  463. S_Down:= False;
  464. S_PgDn:= False;
  465. S_Ins:= False;
  466. S_Del:= False;
  467. S_NumLock:= False;
  468. S_InsertKey:= False;
  469. S_DeleteKey:= False;
  470. S_BackSpace:= False;
  471. S_LeftArrow:= False;
  472. S_RightArrow:= False;
  473. End;
  474.  
  475.  
  476.  
  477.  
  478.  
  479.  
  480. Function S_SetColor(Var Bg,Fg:Byte):Byte;
  481. Var X : integer;
  482. Begin
  483. X := 0;
  484. If FG > 15 Then
  485.   Begin
  486.   X  := 127;
  487.   Fg := Fg - 16;
  488.   End;
  489. S_SetColor := (Bg*16) + Fg + X;
  490. End;
  491.  
  492.  
  493.  
  494.  
  495. Procedure S_GetFieldType(Var FType:Byte);
  496. Begin
  497.  
  498. S_DupType:= False;
  499. S_EntryType:= False;
  500. S_DispType:= False;
  501.  
  502. If FType In[0..9] Then
  503.   Begin
  504.   S_Ftype:= Ftype;
  505.   S_EntryType:= True;
  506.   Exit;
  507.   End;
  508. If FType In[10..19] Then
  509.   Begin
  510.   S_Ftype:= Ftype Mod 10;
  511.   S_DupType:= True;
  512.   Exit;
  513.   End;
  514. If FType In[90..99] Then
  515.   Begin
  516.   S_Ftype:= Ftype Mod 90;
  517.   S_DispType:= True;
  518.   Exit;
  519.   End;
  520. If FType In [100..109] Then
  521.   Begin
  522.   S_Ftype:= Ftype Mod 100;
  523.   S_DispType:= True;
  524.   S_DupType:= True;
  525.   Exit;
  526.   End;
  527. End;
  528.  
  529.  
  530.  
  531.  
  532.  
  533. Procedure S_SetCursor(Switch:S_Cursors);
  534. Const
  535. IntNo:Integer = $10;
  536. Var
  537. S_Regs:Registers;
  538.  
  539. Begin
  540. FillChar(S_Regs,SizeOf(S_Regs),00);
  541. S_Regs.AH := 1;
  542. S_Regs.Bh := 0;
  543.  
  544. Case Switch of
  545.   S_InverseNormal,
  546.   S_Normal    : S_Regs.Cx := S_CursorOld;
  547.   S_Off       : S_Regs.CX := 4096;
  548.   S_InverseBold,
  549.   S_Bold      : S_Regs.CX := 15;
  550.   S_GetCursor : S_Regs.AH := 3;
  551.   End;{Case}
  552.  
  553. Intr(IntNo,S_Regs);
  554.  
  555. If  Switch = S_GetCursor Then S_CursorOld := S_Regs.Cx;
  556. End;
  557.  
  558.  
  559.  
  560.  
  561.  
  562. Procedure S_CloseScreenFile;
  563. Begin
  564. If  S_Delayed Then
  565.     S_Delayed := False;
  566. S_St := 1;
  567. If  Not S_FileOpen Then
  568.     Exit;
  569. S_St   := 0;
  570. S_FileOpen := False;
  571. {$I-}
  572. Close(S_File);
  573. S_Result := IoResult;
  574. {$I+}
  575. S_SetCursor(S_Normal);
  576. End;
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583. Procedure S_OpenScreenFile(ScrFileName:S_Str80);
  584. Var
  585. IOerr : Integer;
  586. Begin
  587. If  S_Delayed Then
  588.     S_Delayed := False;
  589. If S_FileOpen Then S_CloseScreenFile;
  590. S_St := 0;
  591.  
  592. {$I-}
  593. If  Pos('.',ScrFileName) = 0 Then ScrFileName := ScrFileName + '.Scr';
  594. Assign(S_File,ScrFileName);
  595. IoErr := IoResult;
  596. If  IoErr = 0 Then
  597.   Begin
  598.   Reset(S_FILE);
  599.   IOerr := IOResult;
  600.   End;
  601. {$I+}
  602. If  IOerr > 0 then
  603.   Begin
  604.   S_St := 1;
  605.   Str(IoErr:4,S_ErrorMsg);
  606.   S_ErrorMsg := 'IO error <' + S_ErrorMsg + '> reading ';
  607.   End
  608. Else
  609.   If  FileSize(S_File) = 0 Then
  610.     Begin
  611.     S_ErrorMsg := 'No records in screen file ';
  612.     S_St := 2;
  613.     End;
  614. If  S_St > 0 Then
  615.   Begin
  616.   If  S_Result = 9999 Then Exit;
  617.   S_DisplayMessage(S_MessBg,S_MessFg,S_ErrorMsg+' <'+ScrFileName+'>');
  618.   S_CloseScreenFile;
  619.   End;
  620.  
  621. S_Result := 0;
  622. Seek(S_File,0);
  623. Read(S_File,S_Indx^);
  624. S_FileOpen := True;
  625. End;
  626.  
  627.  
  628.  
  629.  
  630.  
  631. Procedure S_Beep(Freq,Dur:Word);
  632. Begin
  633. If S_Sound = True Then
  634.   Begin
  635.   Sound(Freq);
  636.   Delay(Dur);
  637.   NoSound;
  638.   End;
  639. End;
  640.  
  641.  
  642.  
  643.  
  644.  
  645. Procedure S_DisplayMessage(BackG,ForG : Integer; Message: S_Str80);
  646. Begin
  647. FillChar(S_WorkAttrib,81,02);
  648. FillChar(S_Padding,81,32);
  649. S_WorkAttrib[0] := #80;
  650. S_Padding[0]    := #80;
  651. Move(Message[1],S_Padding[((80-Length(Message)) Div 2)+1],Length(Message));
  652. FillChar(S_WorkAttrib[((80-Length(Message)) Div 2)+1],Length(Message),(BackG * 16) + ForG);
  653. If  Message > '' Then
  654.   S_Beep(S_Freq,S_Dur);
  655. S_Write(25,1,80,S_Padding,S_WorkAttrib);
  656. End;
  657.  
  658.  
  659.  
  660.  
  661.  
  662. Procedure S_Store_Buf_Loc (ScrName:S_Str80;ScrBuf:WorkAreaPtr);
  663. Begin
  664. S_BuffPtr^[S_FindScreen(ScrName)] := ScrBuf;
  665. End;
  666.  
  667.  
  668.  
  669. Procedure S_LoadScreen(ScrName:S_Str80);
  670. Var
  671. X,Y,Z : Integer;
  672.  
  673. Begin
  674. If  S_Delayed Then
  675.     S_Delayed := False;
  676. S_St := 0;
  677.  
  678. S_Num := S_FindScreen(ScrName);
  679. If  S_St > 0 Then Exit;
  680.  
  681. If  (S_Indx^.S_Count [S_Num] > 0) And
  682.     (S_BuffPtr^[S_Num] = Nil) Then
  683.   Begin
  684.   S_St := 2;
  685.   If  S_Result = 9999 Then Exit;
  686.   S_ErrorMsg := ' Buffer has not been initialized..(Initialize_ScreenName_Buf)';
  687.   S_CloseScreenFile;
  688.   Halt;
  689.   End;
  690.  
  691. S_DupType  := False;
  692. S_WorkArea := S_BuffPtr^[S_Num];
  693.  
  694. Seek(S_File,S_Indx^.S_RecordNumber[S_Num]);
  695. Read(S_File,S_Record^);
  696.  
  697. If  S_BW Then
  698.   Begin
  699.   X := 2;
  700.   While X < 4000 Do
  701.     Begin
  702.     S_Record^.S_Video[X] := #15;
  703.     inc(X,2);
  704.     End;
  705.   End;
  706.  
  707. If  S_Indx^.S_FieldsRecNo[S_Num] > 0 then
  708.   Begin
  709.   If  S_ChangeScreen Then
  710.     Begin
  711.     Seek(S_File,S_Indx^.S_FieldsRecNo[S_Num]);
  712.     Read(S_File,S_Field^);
  713.     End;
  714.   S_Point := 1;
  715.   For X := 1 to S_Indx^.S_Count[S_Num] do
  716.     Begin
  717.     S_GetFieldType(S_Field^.S_Type[X]);
  718.     If  S_BW Then
  719.       Begin
  720.       S_Field^.S_DisplayBg[X] := 0;
  721.       S_Field^.S_DisplayFg[X] := 15;
  722.       S_Field^.S_NormalBg [X] := 0;
  723.       S_Field^.S_NormalFg [X] := 15;
  724.       S_Field^.S_PromptBg [X] := 7;
  725.       S_Field^.S_PromptFg [X] := 0;
  726.       End;
  727.     S_FieldPtr^[X] := S_Point;
  728.     If  S_FType In [8,9] Then
  729.       S_Point := S_Point + S_Field^.S_Len[X]+1
  730.     Else
  731.       S_Point := S_Point + SizeOf(Real);
  732.     For Z:=S_Field^.S_Col[X] to (S_Field^.S_Col[X]+S_Field^.S_Len[X]+1)do
  733.       S_Record^.S_Video[((S_Field^.S_Row[X]-1)*S_LineSize)+((Z-1)*2)+1]:= #32;
  734.     End;
  735.   End;
  736.  
  737. S_FirstField := S_Indx^.S_FirstField[S_Num];
  738. S_Point      := S_FirstField;
  739.  
  740. If S_ChangeScreen = True Then
  741.   Begin
  742.   If  S_DelayScreen Then
  743.       Begin
  744.       S_Delayed     := True;
  745.       S_DelayScreen := False;
  746.       End
  747.   Else
  748.       S_PutScrMem(S_Record^.S_Video[1],Mem[S_Seg:S_Ofs],3840)
  749.   End
  750. Else
  751.   S_ChangeScreen := True;
  752. End;
  753.  
  754.  
  755.  
  756.  
  757.  
  758. Procedure S_DisplayScreenField(R,C,T,L,DL,DF,DB,NF,NB:Integer;Var S:S_Str80);
  759. Var
  760. RealWork   : Real;
  761. X,Y,
  762. S_Result   : Integer;
  763. BackColor,
  764. ForColor   : Integer;
  765.  
  766. Begin
  767. If T in [1..7] Then
  768.   Begin
  769.   If Pos(S,'-0.000000') = 1 Then Begin DL := DL - 2; Delete(S,1,2); End;
  770.   If Pos(S,'-0.000000') = 2 then Begin DL := DL - 1; Delete(S,1,1); End;
  771.   If Pos('-0',S) > 1        then Begin DL := DL - 1; Delete(S,2,1); End;
  772.   End;
  773.  
  774. S_Padding := Copy(S_Blanks,1,(L-DL));
  775.  
  776. If   Dl > 0 Then S_Result := (DB * 16) + DF
  777. Else S_Result := (NB * 16) + NF;
  778.  
  779. FillChar(S_NormAttrib,81,S_Result);
  780. S_NormAttrib[0] := Chr(80);
  781.  
  782. If T in [0..7] Then
  783.   Begin
  784.   S_Padding := S_Padding + S;
  785.   If  Pos('-.',S) = 1 Then Begin S_Ins_Str := '0'; Insert(S_Ins_Str,S,2); End;
  786.   If  S[1] <> '-'     Then S := '0' + S;
  787.   If  Pos('.',S) = 0  Then S:= S + '.0' Else S := S + '0';
  788.   End
  789. Else
  790.   S_Padding := S + S_Padding;
  791.  
  792. S_Write(R,C,L+2,' '+S_Padding+' ',S_NormAttrib)
  793. End;
  794.  
  795.  
  796.  
  797.  
  798.  
  799. Procedure S_FillScreen;
  800. VAR
  801. S_PrevFld   : Integer;
  802. RealWork          : Real;
  803.  
  804. Begin
  805. {
  806. S_BufferOnly := True;
  807. }
  808. S_PrevFld := S_Point;
  809. S_Point   := 0;
  810. While S_Point < S_Indx^.S_Count[S_Num] Do
  811.   With S_Field^ Do
  812.     Begin
  813.     S_Point := S_Point + 1;
  814.     S_GetFieldType(S_Type[S_Point]);
  815.     If  S_FType In [8,9] Then
  816.       Move(S_WorkArea^[S_FieldPtr^[S_Point]],S_EditStr,S_Len[S_Point] + 1)
  817.     Else
  818.       Begin
  819.       Move(S_WorkArea^[S_FieldPtr^[S_Point]],RealWork,6);
  820.       If  S_FType = 0 Then
  821.         Str(RealWork:1:0,S_EditStr)
  822.       Else
  823.         Str(RealWork:1:S_FType-1,S_EditStr);
  824.       End;
  825.     S_DataLen[S_Point] := Ord(S_EditStr[0]);
  826.     S_DisplayScreenField(
  827.       S_Field^.S_Row[S_Point],
  828.       S_Field^.S_Col[S_Point],
  829.       S_FType,
  830.       S_Field^.S_Len[S_Point],
  831.       S_Field^.S_DataLen[S_Point],
  832.       S_Field^.S_DisplayFg[S_Point],
  833.       S_Field^.S_DisplayBg[S_Point],
  834.       S_Field^.S_NormalFg[S_Point],
  835.       S_Field^.S_NormalBg[S_Point],
  836.       S_EditStr);
  837.     S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  838.     END;
  839. S_Point := S_PrevFld;
  840. End;
  841.  
  842.  
  843.  
  844.  
  845.  
  846. Procedure S_GetKey;
  847. Var ClearLine : Boolean;
  848. Begin
  849. ClearLine := False;
  850. S_ResetKeyFlags;
  851. S_Ch := #00;
  852.  
  853. If  (S_ErrorMsg[0]>#00) Then
  854.   Begin
  855.   S_Freq   := S_ErrorFreq;
  856.   S_Dur    := S_ErrorDur;
  857.   S_Sound  := S_ErrorSound;
  858.   S_MessBg := S_ErrorBg;
  859.   S_MessFg := S_ErrorFg;
  860.   S_Msg    := S_ErrorMsg;
  861.   S_ErrorMsg[0]:=#00;
  862.   End
  863. Else
  864. If  (S_UserMsg[0]>#00) Then
  865.   Begin
  866.   S_Freq   := S_UserFreq;
  867.   S_Dur    := S_UserDur;
  868.   S_Sound  := S_UserSound;
  869.   S_MessBg := S_UserBg;
  870.   S_MessFg := S_UserFg;
  871.   S_Msg    := S_UserMsg;
  872.   S_UserMsg[0]:=#00;
  873.   End
  874. Else
  875. If  (S_AutoHelpMsg[0]>#00) Then
  876.   Begin
  877.   S_Freq   := S_HelpFreq;
  878.   S_Dur    := S_HelpDur;
  879.   S_Sound  := S_HelpSound;
  880.   S_MessBg := S_HelpBg;
  881.   S_MessFg := S_HelpFg;
  882.   S_Msg    := S_AutoHelpMsg;
  883.   S_AutoHelpMsg[0]:=#00;
  884.   End;
  885.  
  886. If  (S_Msg[0]>#00) Then
  887.   Begin
  888.   S_Wait    := True;
  889.   S_DisplayMessage(S_MessBg,S_MessFg,S_Msg);
  890.   ClearLine := True;
  891.   End;
  892.  
  893.  
  894. {$IFDEF MOUSE}
  895. If S_MouseActive And S_MouseVisable Then
  896.    S_RestoreMouse;
  897. While (Not (KeyPressed) And  Not(S_MouseEvent)) Do
  898. {$ELSE}
  899. While Not KeyPressed  Do
  900. {$ENDIF}
  901.   Begin
  902.   S_Count:= 0;
  903.   S_LeftShift:= False;
  904.   S_RightShift:= False;
  905.   S_Shift:= False;
  906.   S_Ctrl:= False;
  907.   S_Alt:= False;
  908.   S_ScrollLock:= False;
  909.   S_NumLock:= False;
  910.   S_Caps:= False;
  911.   S_InsertMode:= False;
  912.   If  ((S_NumLockBit and 2)=2) Then
  913.     Begin
  914.     S_Count     := S_Count + 1;
  915.     S_LeftShift := True;
  916.     S_Shift     := True;
  917.     End;
  918.   If  ((S_NumLockBit and 1)=1) Then
  919.     Begin
  920.     S_Count      := S_Count + 1;
  921.     S_RightShift := True;
  922.     S_Shift      := True;
  923.     End;
  924.   If  ((S_NumLockBit And 4)=4) Then
  925.     Begin
  926.     S_Count := S_Count + 1;
  927.     S_Ctrl  := True;
  928.     End;
  929.   If  ((S_NumLockBit And 8)=8) Then
  930.     Begin
  931.     S_Count := S_Count + 1;
  932.     S_Alt   := True;
  933.     End;
  934.   If  ((S_NumLockBit And 16)=16)   Then S_ScrollLock := True;
  935.   If  ((S_NumLockBit and 32)=32)   then S_NumLock := True;
  936.   If  ((S_NumLockBit And 64)=64)   Then S_Caps := True;
  937.   If  ((S_NumLockBit And 128)=128) Then S_InsertMode := True;
  938.   If  (S_ShowStatus)And(Not(S_Wait)) Then
  939.     Begin
  940.     FillChar(S_StAttrib,41,S_StColor);
  941.     FillChar(S_StAttrWork,21,S_StLabelColor);
  942.     S_StAttrib[0]  := #40;
  943.     S_StAttrWork[0]:= #20;
  944.     If  S_InsertMode   Then Move(S_StAttrWork[1],S_StAttrib[1],8);
  945.     If  S_Caps         Then Move(S_StAttrWork[1],S_StAttrib[10],6);
  946.     If  S_NumLock      Then Move(S_StAttrWork[1],S_StAttrib[17],10);
  947.     If  S_ScrollLock   Then Move(S_StAttrWork[1],S_StAttrib[28],13);
  948.     S_Write(25,21,40,S_StLine,S_StAttrib);
  949.     End;
  950.  
  951.   If  S_Count > 1 Then
  952.     Begin
  953.     S_Fkey := True;
  954.     S_Wait := False;
  955.     Exit;
  956.     End;
  957.   End;
  958.  
  959. {$IFDEF MOUSE}
  960. If (S_MouseActive And S_MouseVisable) Then
  961.    S_RemoveMouse;
  962. {$ENDIF}
  963.  
  964. If ClearLine Then
  965.   Begin
  966.   S_Wait := False;
  967.   S_Msg  := '';
  968.   S_DisplayMessage(S_MessBg,S_MessFg,S_Msg);
  969.   ClearLine := False;
  970.   End;
  971.  
  972. {$IFDEF MOUSE}
  973. if S_MouseEvent  Then
  974.    Begin
  975.    S_Ch_Num := 0;
  976.    Exit;
  977.    End;
  978. {$ENDIF}
  979.  
  980. S_Ch := ReadKey;
  981.  
  982. S_Done := True;
  983. Case S_Ch_Num of
  984.   9 : S_Tab:=True;
  985.  27 : Begin S_Esc:=True; S_Fkey:=True; Exit;End;
  986.  13 : Begin
  987.       If  S_EnterAsTab Then
  988.         S_Tab := True
  989.       Else
  990.         S_Enter := True;
  991.       End;
  992.   8 : Begin S_BkSp:=True; S_BackSpace:=True;End;
  993. Else
  994.   S_Done:=False;
  995. End;
  996.  
  997. If S_Done Then
  998.   Begin
  999.   S_Ch_Num := 0;
  1000.   Exit;
  1001.   End;
  1002.  
  1003. If S_Ctrl Then
  1004.   Begin
  1005.   If  S_Ch_Num = 127 Then
  1006.     Begin
  1007.     S_BackSpace := True;
  1008.     S_Ch        := #00;
  1009.     Exit;
  1010.     End;
  1011.   If  S_Ch_Num In [1..26] Then
  1012.     Begin
  1013.     S_Fkey   := True;
  1014.     S_Ch_Num := S_Ch_Num + 64;
  1015.     Exit
  1016.     End;
  1017.   End;
  1018.  
  1019. If S_Shift Then
  1020.   Begin
  1021.   S_Done := True;
  1022.   Case S_Ch of
  1023.     '8': S_Up   := True;
  1024.     '7': S_Home := True;
  1025.     '9': S_PgUp := True;
  1026.     '4': S_Left := True;
  1027.     '6': S_Right:= True;
  1028.     '1': S_End  := True;
  1029.     '2': S_Down := True;
  1030.     '3': S_PgDn := True;
  1031.     '0': S_Ins  := True;
  1032.     '.': S_Del  := True;
  1033.     Else
  1034.         S_Done := False;
  1035.     End;
  1036.   If  S_Done Then
  1037.     Begin
  1038.     S_Fkey   := True;
  1039.     S_Ch_Num := 0;
  1040.     Exit;
  1041.     End;
  1042.   End;
  1043.  
  1044. If  S_Ch_Num = 0 Then
  1045.   Begin
  1046.   S_Ch := ReadKey;
  1047.   Case S_Ch_Num Of
  1048.     84..93,135,136: S_Shift := True;
  1049.     94..103,115..119,132,137,138: S_Ctrl  := True;
  1050.     16..25,30..38,44..50,104..113,120..121,139,140 : S_Alt   := True;
  1051.     End;
  1052.   If  S_Alt Then
  1053.     Begin
  1054.     S_Done := True;
  1055.     Case S_Ch_Num Of
  1056.       30  :S_Ch:='A';
  1057.       48  :S_Ch:='B';
  1058.       46  :S_Ch:='C';
  1059.       32  :S_Ch:='D';
  1060.       18  :S_Ch:='E';
  1061.       33  :S_Ch:='F';
  1062.       34  :S_Ch:='G';
  1063.       35  :S_Ch:='H';
  1064.       23  :S_Ch:='I';
  1065.       36  :S_Ch:='J';
  1066.       37  :S_Ch:='K';
  1067.       38  :S_Ch:='L';
  1068.       50  :S_Ch:='M';
  1069.       49  :S_Ch:='N';
  1070.       24  :S_Ch:='O';
  1071.       25  :S_Ch:='P';
  1072.       16  :S_Ch:='Q';
  1073.       19  :S_Ch:='R';
  1074.       31  :S_Ch:='S';
  1075.       20  :S_Ch:='T';
  1076.       22  :S_Ch:='U';
  1077.       47  :S_Ch:='V';
  1078.       17  :S_Ch:='W';
  1079.       45  :S_Ch:='X';
  1080.       21  :S_Ch:='Y';
  1081.       44  :S_Ch:='Z';
  1082.       114 :S_Ch:='*';
  1083.       120 :S_Ch:='1';
  1084.       121 :S_Ch:='2';
  1085.       122 :S_Ch:='3';
  1086.       123 :S_Ch:='4';
  1087.       124 :S_Ch:='5';
  1088.       125 :S_Ch:='6';
  1089.       126 :S_Ch:='7';
  1090.       127 :S_Ch:='8';
  1091.       128 :S_Ch:='9';
  1092.       129 :S_Ch:='0';
  1093.       130 :S_Ch:='-';
  1094.       131 :S_Ch:='=';
  1095.     Else
  1096.       S_Done := False;
  1097.     End;
  1098.     If  S_Done Then
  1099.       Begin
  1100.       S_Fkey := True;
  1101.       Exit;
  1102.       End;
  1103.     End;
  1104.  
  1105.   S_Done := True;
  1106.   Case S_Ch_Num Of
  1107.     15 : S_Tab         := True;
  1108.     75 : Begin S_Left  := True;S_LeftArrow := True;End;
  1109.     77 : Begin S_Right := True;S_RightArrow:= True;End;
  1110.     82 : Begin S_Ins   := True;S_InsertKey := True;End;
  1111.     83 : Begin S_Del   := True;S_DeleteKey := True;End;
  1112.   Else
  1113.     S_Done := False;
  1114.   End;
  1115.  
  1116.   If  S_Done Then
  1117.     Begin
  1118.     S_Ch_Num := 0;
  1119.     Exit;
  1120.     End;
  1121.   S_Done := True;
  1122.   Case S_Ch_Num Of
  1123.     59,84,94,104  : S_F1:= True;
  1124.     60,85,95,105  : S_F2:= True;
  1125.     61,86,96,106  : S_F3:= True;
  1126.     62,87,97,107  : S_F4:= True;
  1127.     63,88,98,108  : S_F5:= True;
  1128.     64,89,99,109  : S_F6:= True;
  1129.     65,90,100,110 : S_F7:= True;
  1130.     66,91,101,111 : S_F8:= True;
  1131.     67,92,102,112 : S_F9:= True;
  1132.     68,93,103,113 : S_F10:= True;
  1133.     133,135,137,139 : S_F11:= True;
  1134.     134,136,138,140 : S_F12:= True;
  1135.     71,119        : S_Home:= True;
  1136.     79,117        : S_End:= True;
  1137.     72            : S_Up:= True;
  1138.     80            : S_Down:= True;
  1139.     73,132        : S_PgUp:= True;
  1140.     75,115        : S_Left:= True;
  1141.     77,116        : S_Right:= True;
  1142.     81,118        : S_PgDn:= True;
  1143.     82            : S_Ins:= True;
  1144.     83            : S_Del:= True;
  1145.   Else
  1146.     S_Done := False;
  1147.   End;
  1148.  
  1149.   If  S_Done Then
  1150.     Begin
  1151.     S_Fkey   := True;
  1152.     S_Ch_Num := 0;
  1153.     End;
  1154.   End;
  1155. End;
  1156.  
  1157.  
  1158.  
  1159.  
  1160.  
  1161. Procedure S_Get_Field_Value(X:Integer);
  1162. Var
  1163. RealWork: Real;
  1164. S_Result: Integer;
  1165.  
  1166. Begin
  1167. S_EditStr := '';
  1168. With S_Field^ Do
  1169.   Begin
  1170.   S_GetFieldType(S_Type[X]);
  1171.   If  S_FType IN [8,9] Then
  1172.     Move(S_WorkArea^[S_FieldPtr^[X]],S_EditStr,S_Len[X]+1)
  1173.   Else
  1174.     Begin
  1175.     Move(S_WorkArea^[S_FieldPtr^[X]],RealWork,6);
  1176.     IF  S_FType = 0 Then
  1177.       Str(RealWork:1:0,S_EditStr)
  1178.     Else
  1179.       Str(RealWork:1:S_FType-1,S_EditStr);
  1180.     End;
  1181.   S_DataLen[X] := Ord(S_EditStr[0]);
  1182.   End;
  1183. End;
  1184.  
  1185.  
  1186.  
  1187.  
  1188.  
  1189.  
  1190. Procedure S_PreEdit(HR,HL:Integer);
  1191. var
  1192. Work:String[4];
  1193. X  : integer;
  1194. Rec: LongInt;
  1195. Begin
  1196. FillChar(S_InitialValue,81,0);
  1197. FillChar(S_AutoHelpMsg,81,0);
  1198. FillChar(S_EditMask,81,0);
  1199. S_Force_EditMask := False;
  1200. X := 0;
  1201. While (((HR>0) And (X<3))) Do
  1202.   Begin
  1203.   If (S_VRec<>HR) Then
  1204.     Begin
  1205.     S_VRec  := HR;
  1206.     Seek(S_File,HR);
  1207.     Read(S_File,S_Validate^);
  1208.     End;
  1209.  
  1210.   Inc(X);
  1211.  
  1212.   If (((S_AutoHelp)Or(S_QuickHelp)) And
  1213.       (S_Validate^.S_RangeList[HL][1]='H')) Then
  1214.     S_AutoHelpMsg :=
  1215.      Copy(S_Validate^.S_RangeList[HL],6,Length(S_Validate^.S_RangeList[Hl])-5);
  1216.  
  1217.   If ((S_Validate^.S_RangeList [HL][1]='E')And
  1218.       (S_Validate^.S_RangeList [HL][2]='D')) Then
  1219.     Begin
  1220.     If (S_Validate^.S_RangeList[HL][6]='F') Then
  1221.       Begin
  1222.       S_Force_EditMask := True;
  1223.       S_EditMask :=
  1224.         Copy(S_Validate^.S_RangeList[HL],9,Length(S_Validate^.S_RangeList[Hl])-9);
  1225.       End
  1226.     Else
  1227.       Begin
  1228.       S_EditMask :=
  1229.         Copy(S_Validate^.S_RangeList[HL],7,Length(S_Validate^.S_RangeList[Hl])-7);
  1230.       End;
  1231.     End;
  1232.  
  1233.   If ((S_Validate^.S_RangeList[HL][1]='S')And
  1234.       (S_Validate^.S_RangeList[HL][2]='E')) Then
  1235.     Begin
  1236.     S_InitialValue:=
  1237.       Copy(S_Validate^.S_RangeList[HL],6,Length(S_Validate^.S_RangeList[Hl])-6);
  1238.     If (S_UpShiftedStr(S_InitialValue)='SYSDATE') Then
  1239.       Begin
  1240.       GetDate(S_Year,S_Month,S_Day,S_DayOfWeek);
  1241.       Str(S_Month:2,Work);
  1242.       If Work[1]=#32 Then Work[1]:='0';
  1243.       S_InitialValue := Work + '/';
  1244.       Str(S_Day:2,Work);
  1245.       If Work[1]=#32 Then Work[1]:='0';
  1246.       S_InitialValue := S_InitialValue + Work + '/';
  1247.       Str(S_Year:4,Work);
  1248.       S_InitialValue := S_InitialValue + Work;
  1249.       End;
  1250.     End;
  1251.   HR := S_Validate^.s_rangerec [HL];
  1252.   HL := S_Validate^.s_rangeline[HL];
  1253.   End;
  1254. End;
  1255.  
  1256.  
  1257.  
  1258.  
  1259. Procedure S_EditString (R,C,T,L,F,B,DF,DB,NF,NB,HR,HL:Integer;Var S:S_Str80);
  1260. Var
  1261. WorkNum: Real;
  1262. X,Y,Z,S_Result: Integer;
  1263. Begin
  1264. S_Fg:= 2;
  1265. S_Bg:= 0;
  1266. S_Pos:= 1;
  1267. S_Ins_Str:= ' ';
  1268. S_Attrib := Trunc((B*16) + F);
  1269. If S_Cursor In [S_Off,S_InverseNormal,S_InverseBold] Then
  1270.   Begin
  1271.   If S_Attrib > 16 Then
  1272.      Begin
  1273.      If  F = 0 Then
  1274.        S_Reverse := 15
  1275.      Else
  1276.        S_Reverse := F;
  1277.      End
  1278.   Else
  1279.      Begin
  1280.      If  F = 7 Then
  1281.        S_Reverse := 127
  1282.      Else
  1283.        S_Reverse := 112+F;
  1284.      End;
  1285.   End
  1286. Else
  1287.   S_Reverse := S_Attrib;
  1288.  
  1289. FillChar(S_EditAttrib,81,S_Attrib);
  1290.  
  1291. S_EditAttrib[0] := Chr(L+2);
  1292.  
  1293. If  T < 8 Then
  1294.   Begin
  1295.   If  Pos(S,'0.000000') > 0 Then S := '';
  1296.   If  Pos('0.',S) = 1  Then Delete(S,1,1);
  1297.   If  Pos('-0.',S) = 1 Then Delete(S,2,1);
  1298.   End;
  1299.  
  1300. S_StLabelColor:= S_SetColor(S_StLabelBg,S_StLabelFg);
  1301. S_StColor:= S_SetColor(S_StBg,S_StFg);
  1302. S_WorkStr:= S + S_Blanks;
  1303. S_WorkStr[0]:= Chr(L);
  1304. S_Max_Dig:= L - T;
  1305.  
  1306. If  S_LeftArrow Then
  1307.   Begin
  1308.   S_Pos := S_Length(S_WorkStr);
  1309.   If  S_Pos < L Then S_Pos := S_Pos + 1;
  1310.   End;
  1311.  
  1312. S_Setcursor(S_Cursor);
  1313.  
  1314. If  S_EditMask > '' Then
  1315.   Begin
  1316.   While Not(S_EditMask[S_Pos] In ['@','2','#','3','$','4']) Do
  1317.     If  S_LeftArrow Then Dec(S_Pos) Else Inc(S_Pos);
  1318.   For X := 1 to L do
  1319.     If  Not(S_EditMask[X] In ['@','2','#','3','$','4']) Then
  1320.       S_WorkStr[X] := S_EditMask[X];
  1321.   End;
  1322.  
  1323. Repeat
  1324.   If  (T<8) And (S_Pos > S_Length(S_WorkStr)) then
  1325.     S_Pos := S_Length(S_WorkStr)+1
  1326.   Else
  1327.     If  (S_EditMask[0]>#00) Then
  1328.       Begin
  1329.       While Not(S_EditMask[S_Pos] In ['@','2','#','3','$','4']) Do
  1330.         Begin
  1331.         S_WorkStr[S_Pos] := S_EditMask[S_Pos];
  1332.         If  (S_LeftArrow) Then Dec(S_Pos) Else Inc(S_Pos);
  1333.         End;
  1334.       End;
  1335.  
  1336.   S_EditAttrib[S_Pos+1]:=Chr(S_Reverse);
  1337.   S_Write(R,C,L+2,' ' + S_WorkStr + ' ',S_EditAttrib);
  1338.   GoToXY((C)+S_Pos,R);
  1339.   S_GetKey;
  1340.   S_EditAttrib[S_Pos+1]:=S_EditAttrib[1];
  1341.   S_Write(R,C,L+2,' '+S_WorkStr+' ',S_EditAttrib);
  1342.  
  1343.   If  S_LeftArrow Or S_BackSpace Then
  1344.     Begin
  1345.     If  S_Pos > 1 Then
  1346.       Begin
  1347.       S_Pos := S_Pos - 1;
  1348.       If  S_BackSpace Then
  1349.         S_DeleteKey := True;
  1350.       End
  1351.     Else
  1352.       If  S_LeftArrow Then
  1353.         Begin
  1354.         S_Shift := True;
  1355.         S_Tab   := True;
  1356.         End;
  1357.     End;
  1358.  
  1359.   If  S_RightArrow Then
  1360.     If  S_Pos < L Then
  1361.       Begin
  1362.       If  (T < 8) And (S_Pos > S_Length(S_WorkStr)) Then
  1363.         S_Tab := True
  1364.       Else
  1365.         S_Pos := S_Pos + 1;
  1366.       End
  1367.     Else
  1368.       S_Tab := True;
  1369.  
  1370.   If  (S_Shift And S_Del) Or (S_DeleteKey) Then
  1371.     Begin
  1372.     If  S_Length(S_WorkStr) > 0 Then
  1373.       Begin
  1374.       If  S_Shift Then
  1375.         Begin
  1376.         FillChar(S_WorkStr[S_Pos],(Length(S_WorkStr)-S_Pos)+1,32);
  1377.         S_Fkey := False;
  1378.         X := S_Pos;
  1379.         If  (S_EditMask[0]>#00) Then
  1380.           Begin
  1381.           While X <= L Do
  1382.             Begin
  1383.             If Not(S_EditMask[X] In ['@','2','#','3','$','4']) Then
  1384.                S_WorkStr[X] := S_EditMask[X];
  1385.             Inc(X);
  1386.             End;
  1387.           End;
  1388.         End
  1389.       Else
  1390.         Begin
  1391.         If  (S_EditMask > '') And (S_Pos < L) Then
  1392.           Begin
  1393.           Y := 0;
  1394.           X := S_Pos+1;
  1395.           Z := S_Pos;
  1396.           While X <= L Do
  1397.             Begin
  1398.             If  S_EditMask[X] In ['@','2','#','3','$','4'] Then
  1399.               Begin
  1400.               If  (S_EditMask[X] <> S_EditMask[Z]) Then
  1401.                 Begin
  1402.                 S_WorkStr[Z] := #32;
  1403.                 X := L+1
  1404.                 End
  1405.               Else
  1406.                 Begin
  1407.                 S_WorkStr[Z] := S_WorkStr[X];
  1408.                 Inc(Z);
  1409.                 While Not(S_EditMask[Z]In['@','2','#','3','$','4'])Do Inc(Z);
  1410.                 End;
  1411.               End;
  1412.             Inc(X);
  1413.             If  X > L Then S_WorkStr[Z] := #32
  1414.             End;
  1415.           End
  1416.         Else
  1417.           Begin
  1418.           Delete(S_WorkStr,S_Pos,1);
  1419.           S_WorkStr := S_WorkStr + #32;
  1420.           End;
  1421.         End;
  1422.       End;
  1423.     S_Fkey := False;
  1424.     End;
  1425.  
  1426.   If  (S_Pos=1) And (S_Ch='?') Then
  1427.     Begin
  1428.     S_QuickHelp := True;
  1429.     S_PreEdit(HR,HL);
  1430.     S_QuickHelp := False;
  1431.     If  S_AutoHelpMsg = '' Then
  1432.         S_AutoHelpMsg := ' No HELP available for this field. ';
  1433.     S_Ch := #00;
  1434.     End;
  1435.  
  1436.   If  (Not S_Ctrl) And
  1437.       (Not S_Alt ) And (Not S_Fkey) And (S_Ch In [#32..#127]) Then
  1438.     Begin
  1439.     If  T < 8 Then
  1440.       Begin
  1441.       Case S_Ch of
  1442.        '-' : If ((Pos('-',S_WorkStr) > 0) Or (S_Pos > 1)) Then S_Ch := #00;
  1443.        '.' : If ((T = 0 ) Or
  1444.                  (Pos('.',S_WorkStr) > 0)) And
  1445.                  (Pos('.',S_WorkStr) <> S_Pos)  Then S_Ch := #00;
  1446.        '0'..'9':
  1447.       Else
  1448.           S_Ch := #00;
  1449.       End;{Case of}
  1450.       End;
  1451.  
  1452.     If  T = 8 Then
  1453.       Begin
  1454.       If  (S_EditMask > '') And (S_EditMask[S_Pos] In ['@','2']) Then
  1455.         Begin
  1456.         If  Not(UpCase(S_Ch) In['A'..'Z']) Then
  1457.           Begin
  1458.           S_Ch       := #00;
  1459.           S_ErrorMsg := ' Only a value of "a" thru "z" or "A" thur "Z" acceptable here.';
  1460.           End;
  1461.         End
  1462.       Else
  1463.         If  Not (S_Ch In [#32,'A'..'Z','a'..'z']) Then S_Ch := #00;
  1464.       End;
  1465.  
  1466.     If  (T = 9) And (S_EditMask > '') Then
  1467.       Begin
  1468.       If  S_EditMask[S_Pos] in ['@','2'] Then
  1469.         Begin
  1470.         If  Not(UpCase(S_ch) In ['A'..'Z']) Then
  1471.           Begin
  1472.           S_ErrorMsg  := ' Only a value of "a" thru "z" or "A" thur "Z" is acceptable here.';
  1473.           S_Ch   := #00;
  1474.           End;
  1475.         End;
  1476.       If  S_EditMask[S_Pos] in ['3','#'] Then
  1477.         Begin
  1478.         If  Not(S_ch In ['0'..'9']) Then
  1479.           Begin
  1480.           S_ErrorMsg  := ' Only a value of "0" thru "9" is acceptable here.';
  1481.           S_Ch   := #00;
  1482.           End;
  1483.         End;
  1484.       End;
  1485.  
  1486.     If  S_ch > #00 Then
  1487.       Begin
  1488.       If  S_InsertMode = True Then
  1489.         Begin
  1490.         If  S_Pos <= L Then
  1491.           Begin
  1492.           If  (S_Pos < L) And (S_EditMask > '') Then
  1493.             Begin
  1494.             Y := 0;
  1495.             X := S_Pos;
  1496.             Z := S_Pos;
  1497.             While (Not(S_EditMask[X+1] In ['@','2','#','3','$','4']) Or
  1498.                    (S_EditMask[X+1] = S_EditMask[Z])) And
  1499.                   (X < L) Do Inc(X);
  1500.             Y := X - 1;
  1501.             While Y >= S_Pos Do
  1502.               Begin
  1503.               If  Not(S_EditMask[Y] In['@','2','#','3','$','4'])Then Dec(Y)
  1504.               Else
  1505.               If ((S_EditMask[Z]<>S_EditMask[X])Or
  1506.                   (Not(S_EditMask[X] In['@','2','#','3','$','4'])))Then
  1507.                   Begin Dec(X);Y:=X-1;End
  1508.               Else
  1509.                 Begin
  1510.                 S_WorkStr[X] := S_WorkStr[Y];
  1511.                 Dec(X);
  1512.                 Dec(Y);
  1513.                 End;
  1514.               End;
  1515.             S_WorkStr[S_Pos] := S_Ch;
  1516.             End
  1517.           Else
  1518.             Begin
  1519.             S_Ins_Str[1] := S_Ch;
  1520.             Insert(S_Ins_Str,S_WorkStr,S_Pos);
  1521.             End;
  1522.           End;
  1523.         End
  1524.       Else
  1525.         S_WorkStr[S_Pos] := S_ch;
  1526.       If  S_Pos < L Then
  1527.         S_Pos := S_Pos + 1
  1528.       Else
  1529.         Begin
  1530.         S_Tab   := True;
  1531.         S_Shift := False;
  1532.         End;
  1533.       S_WorkStr[0] := Chr(L);
  1534.       End;
  1535.     End;
  1536.  
  1537.   If  (Not S_Enter)And(S_Tab) Then
  1538.     Begin
  1539.     if ((S_Shift)And(S_Pos>1)) Then
  1540.       Begin
  1541.       X:=S_Pos-1;
  1542.       While Not (S_EditMask[X] In ['#','3','$','4','@','2']) Do Dec(X);
  1543.       S_Pos:=1;
  1544.       If  (X>1) And (S_EditMask[0]>#00) Then
  1545.         Begin
  1546.         If  S_EditMask[X] In ['#','3','$','4','@','2'] Then
  1547.           While ((X>1)And(S_EditMask[X] In ['#','3','$','4','@','2'])) do
  1548.             Dec(X);
  1549.         {
  1550.         While Not (S_EditMask[X] In ['#','3','$','4','@','2']) Do Dec(X);
  1551.         While ((X>1)And(S_EditMask[X] In ['#','3','$','4','@','2'])) Do Dec(X);
  1552.         }
  1553.         If  X > 1 Then Inc(X);
  1554.         S_Pos := X;
  1555.         End;
  1556.       S_Tab := False;
  1557.       S_Fkey:= False;
  1558.       End;
  1559.  
  1560.     If (Not(S_Shift)And(S_Pos<=L)) Then
  1561.       Begin
  1562.       If  S_EditMask[0]>#00 Then
  1563.         Begin
  1564.         X := S_Pos;
  1565.         While ((X<=L)And(S_EditMask[X] In ['#','3','$','4','@','2'])) Do
  1566.            Inc(x);
  1567.         While ((X<=L)And(Not(S_EditMask[X] In ['#','3','$','4','@','2']))) Do
  1568.            Inc(x);
  1569.         If (X<=L) Then
  1570.           Begin
  1571.           S_Pos := X;
  1572.           S_Tab:=False;
  1573.           S_Fkey:=False;
  1574.           End;
  1575.         End;
  1576.       End;
  1577.  
  1578.     End;
  1579.  
  1580.   If  S_Force_EditMask Then
  1581.     Begin
  1582.     If  (S_Enter) Or (S_Tab) Then
  1583.       Begin
  1584.       X := 0;
  1585.       While X <= L Do
  1586.         Begin
  1587.         Inc(X);
  1588.         If  (S_EditMask[X] In ['#','3','@','2']) And (S_WorkStr[X]  =  ' ') Then
  1589.           Begin
  1590.           S_Pos := X;
  1591.           S_ErrorMsg := '"'+S_Ch+'" does not fit edit mask '+ S_EditMask;
  1592.           S_Enter := False;
  1593.           S_Tab   := False;
  1594.           X       := L;
  1595.           End;
  1596.         End;
  1597.       End;
  1598.     End;
  1599.  
  1600. {$IFDEF MOUSE}
  1601. Until S_Enter Or S_Tab Or S_Esc Or S_Fkey Or S_MouseEvent;
  1602. {$ELSE}
  1603. Until S_Enter Or S_Tab Or S_Esc Or S_Fkey;
  1604. {$ENDIF}
  1605. S_SetCursor(S_Off);
  1606.  
  1607. S_WorkStr := Copy (S_WorkStr,1,S_Length(S_WorkStr));
  1608.  
  1609. If  length(S_WorkStr) > 0 Then
  1610.   S_Attrib := Trunc((DB*16) + DF)
  1611. Else
  1612.   S_Attrib := Trunc((NB*16) + NF);
  1613.  
  1614. FillChar(S_EditAttrib,81,S_Attrib);
  1615. S_EditAttrib[0] := Chr(L+2);
  1616.  
  1617. S_Msg := '';
  1618.  
  1619. If  T < 8 Then
  1620.   Begin
  1621.   If  S_WorkStr = '' then S_workstr := '0.0';
  1622.   If  S_WorkStr[1] = '.' Then S_WorkStr := '0'+S_WorkStr;
  1623.   If  Pos('-.',S_WorkStr) = 1 Then
  1624.     Begin
  1625.     S_Ins_Str[1] := '0';
  1626.     Insert(S_Ins_Str,S_WorkStr,2);
  1627.     End;
  1628.   Val(S_WorkStr,WorkNum,S_Result);
  1629.   If  T = 0 Then
  1630.     Str(WorkNum:L:T,S_WorkStr)
  1631.   Else
  1632.     Str(WorkNum:L:(T-1),S_WorkStr);
  1633.   While (S_WorkStr [1]= ' ') Or (Length(S_WorkStr)>L) Do
  1634.        Delete(S_WorkStr,1,1);
  1635.   If  Pos('0.',S_WorkStr) = 1  Then Delete(S_WorkStr,1,1);
  1636.   If  Pos('-0.',S_WorkStr) = 1 Then Delete(S_WorkStr,2,1);
  1637.   If  (T = 0) And (S_WorkStr = '') Then S_WorkStr := '0';
  1638.   End
  1639. Else
  1640.   Begin
  1641.   If  S_EditMask[0]>#00 Then
  1642.     Begin
  1643.     Y:=0;
  1644.     X:=0;
  1645.     While ((X<L)And(Y=0))do
  1646.       Begin
  1647.       Inc(X);
  1648.       If ((S_WorkStr[X]>#32)And
  1649.           (S_EditMask[X] In['#','3','@','2','$','4'])) Then Inc(Y);
  1650.       End;
  1651.     If  Y=0 Then FillChar(S_WorkStr,L,0);
  1652.     End
  1653.   Else
  1654.     Begin
  1655.     X := L;
  1656.     While ((X>0)And(S_WorkStr[X]<#33)) Do
  1657.        Begin
  1658.        S_WorkStr[X]:=#00;
  1659.        Dec(X);
  1660.        End;
  1661.     S_WorkStr[0]:=Chr(X);
  1662.     End;
  1663.   End;
  1664. S_AutoHelpMsg:= '';
  1665. S_EditMask   := '';
  1666. S_EditStr    := S_WorkStr;
  1667. S:= S_WorkStr;
  1668.  
  1669. S_DisplayScreenField(R,C,T,L,Length(S_EditStr),DF,DB,NF,NB,S)
  1670. End;
  1671.  
  1672.  
  1673.  
  1674. Function S_SetDisplayOn(X:Integer):Integer;
  1675. Var Z,Y:Integer;
  1676. Begin
  1677. Y:=0;
  1678. Z:=1;
  1679. S_Result := 0;
  1680. If  S_Indx^.S_Count[S_Num] > 1 Then
  1681.   Begin
  1682.   Repeat
  1683.      If (s_field^.s_type[Z] >= 0) And (s_field^.s_type[Z] <= 9) Then Inc(Y);
  1684.      Inc(Z);
  1685.   Until Z > S_Indx^.S_Count[S_Num];
  1686.  
  1687.   If (Y=0) Then  S_Result := 1;
  1688.   If Not (X In [1..S_Indx^.s_count[S_Num]]) Then S_Result := 2;
  1689.   If (s_field^.s_type[X] > 19) Then S_Result := 3;
  1690.   End
  1691. Else
  1692.   S_Result := 4;
  1693. If (S_Result = 0) And (s_field^.s_type[X] < 20) Then
  1694.    Inc(S_Field^.S_Type[X],90);
  1695. S_SetDisplayOn := S_Result;
  1696. End;
  1697.  
  1698.  
  1699.  
  1700.  
  1701. Function S_SetDisplayOff(X:Integer):Integer;
  1702. Begin
  1703. S_Result := 0;
  1704.  
  1705. If X < 1 Then S_Result := 4
  1706. Else
  1707. If Not(X In [1..S_Indx^.S_Count[S_Num]]) Then S_Result := 2
  1708. Else
  1709. If (S_Field^.S_Type[X] < 20) Then S_Result := 3
  1710. Else
  1711. If (S_Field^.S_Type[X] > 19) Then Dec(S_Field^.S_Type[X],90);
  1712.  
  1713. S_SetDisplayOff := S_Result;
  1714. End;
  1715.  
  1716.  
  1717.  
  1718.  
  1719. Function S_IsDupe(S_Index:Integer):Boolean;
  1720. Begin
  1721. If (S_Index in [1..S_Indx^.S_Count[S_Num]]) And
  1722.    (S_Field^.S_type[S_Index] In [10..19,100..109]) Then
  1723.   S_IsDupe := True
  1724. Else
  1725.   S_IsDupe := False;
  1726. End;
  1727.  
  1728.  
  1729.  
  1730.  
  1731. Function S_SetDupe(S_Index:Integer):Boolean;
  1732. Var X,Y : integer;
  1733. Begin
  1734. Y := 0;
  1735. X := 0;
  1736. While X < S_Indx^.S_Count[S_Num] Do
  1737.     Begin
  1738.     Inc(X);
  1739.     If S_Field^.S_Type[x] In [0..9] Then Inc(y);
  1740.     End;
  1741. S_SetDupeFields := False;
  1742.  
  1743. If (Not(S_Index in [1..S_Indx^.S_Count[S_Num]])) Or
  1744.    (S_Field^.S_type[S_Index] In [10..19,100..109]) Then
  1745.   S_SetDupe := False
  1746. Else
  1747.   If (Y > 1) Or
  1748.      (S_Field^.S_Type[S_Index] In [90..99]) Then
  1749.     Begin
  1750.     Inc(S_Field^.S_type[S_Index],10);
  1751.     S_SetDupe := True;
  1752.     If  S_Field^.S_Type[S_Index] In [10..19] Then
  1753.         S_SetDupeFields := True;
  1754.     End
  1755.   Else
  1756.     Begin
  1757.     S_ErrorMsg := 'At least one field must remain a data entry field.';
  1758.     S_SetDupe := False;
  1759.     End;
  1760. End;
  1761.  
  1762.  
  1763.  
  1764.  
  1765. Procedure S_ReSetDupe(S_Index:Integer);
  1766. Begin
  1767. If (S_Index in [1..S_Indx^.S_Count[S_Num]]) And
  1768.    (S_Field^.S_type[S_Index] In [10..19,100..109]) Then
  1769.   Dec(S_Field^.S_type[S_Index],10);
  1770. End;
  1771.  
  1772.  
  1773.  
  1774.  
  1775. Procedure S_ClearDupes;
  1776. Var
  1777. S_Index :Integer;
  1778. Dummy   :Boolean;
  1779. Begin
  1780. S_Index := 0;
  1781. While S_Index < S_Indx^.S_Count[S_Num] Do
  1782.   Begin
  1783.   If S_Field^.S_Type[S_Index] in [10..19,100..109] Then S_ReSetDupe(S_Index);
  1784.   Inc(S_Index);
  1785.   End;
  1786. End;
  1787.  
  1788.  
  1789.  
  1790.  
  1791. Procedure S_ClearScreen(Initialize:integer);
  1792. Var
  1793. X        : Integer;
  1794. RealWork : Real;
  1795. Begin
  1796. RealWork := 0;
  1797. Fillchar(S_InitialValue,80,0);
  1798. For X := 1 To S_Indx^.S_Count[S_Num] Do
  1799.   Begin
  1800.   S_GetFieldType(S_Field^.S_Type[X]);
  1801.   If  Initialize = 1 Then
  1802.     S_PreEdit(
  1803.       S_Field^.S_RangeNextRec[X],
  1804.       S_Field^.S_RangeNextLine[X]);
  1805.   If  Not S_DupType Then
  1806.     Begin
  1807.     If  S_FType < 8 Then
  1808.       Begin
  1809.       Val(S_InitialValue,RealWork,S_Result);
  1810.       Move(RealWork,S_WorkArea^[S_FieldPtr^[x]],SizeOf(Real));
  1811.       End
  1812.     Else
  1813.       Begin
  1814.       if S_initialValue > '' Then
  1815.          Begin
  1816.          S_InitialValue := S_InitialValue + S_Blanks;
  1817.          S_InitialValue[0] := Chr(S_Field^.S_Len[x]);
  1818.          End;
  1819.       MOVE(S_InitialValue,S_WorkArea^[S_FieldPtr^[x]],S_Field^.S_Len[x]+ 1);
  1820.       End;
  1821.     End;
  1822.   End;
  1823. End;
  1824.  
  1825.  
  1826.  
  1827.  
  1828.  
  1829. Procedure S_RefreshScreen;
  1830. Begin
  1831. If  S_Delayed Then
  1832.     S_Delayed := False;
  1833. S_PutScrMem(S_Record^.S_Video[1],Mem[S_Seg:S_Ofs],3840);
  1834. S_FillScreen;
  1835. End;
  1836.  
  1837.  
  1838.  
  1839.  
  1840. {$IFDEF COLORCHANGE}
  1841. Function S_ChangeScreenColor(CT,Bg,Fg:Byte;SR,ER,SC,EC:Integer):Integer;
  1842. Var
  1843. Row, Col, Ch, Color, Error, F, P:Integer;
  1844. Begin
  1845.  
  1846. If  (CT>4) Then
  1847.   S_ChangeScreenColor := 1
  1848. Else
  1849. If  (Bg>7) Then
  1850.   S_ChangeScreenColor := 2
  1851. Else
  1852. If  (Fg>30) Then
  1853.   S_ChangeScreenColor := 3
  1854. Else
  1855. If  ((SR < 1)Or(SR>24)) Then
  1856.   S_ChangeScreenColor := 4
  1857. Else
  1858. If  ((ER<SR)Or(ER>24)) Then
  1859.   S_ChangeScreenColor := 5
  1860. Else
  1861. If  ((SC < 1)Or(SC>80)) Then
  1862.   S_ChangeScreenColor := 6
  1863. Else
  1864. if  ((EC<SC)Or(EC>80)) Then
  1865.   S_ChangeScreenColor := 7
  1866. Else
  1867.   Begin
  1868.   F     :=1;
  1869.   Row   :=SR;
  1870.   Col   :=SC;
  1871.   Color := S_SetColor(Bg,Fg);
  1872.  
  1873.   While ((F<=S_Indx^.s_count[S_Num])And(S_Field^.s_row[F] <= Row)) Do Inc(F);
  1874.  
  1875.   While ((F<=S_Indx^.s_count[S_Num])And
  1876.          (((S_Field^.s_col[F])+(S_Field^.s_len[F]+1))<Col)
  1877.         ) Do Inc(F);
  1878.  
  1879.   If  (F>S_Indx^.s_count[S_Num]) Then F:=0;
  1880.  
  1881.   Repeat
  1882.     Begin
  1883.     if (F>0) Then
  1884.       Begin
  1885.       While(
  1886.          (F>0)And
  1887.          (Row=S_Field^.s_row[F])And
  1888.          (Col>((S_Field^.s_col[F])+(S_Field^.s_len[F]+1)))) Do
  1889.         Begin
  1890.         If (F<=S_Indx^.s_count[S_Num]) Then Inc(F) Else F:=0;
  1891.         End;
  1892.       While(
  1893.          (F>0)And
  1894.          (Row>=S_Field^.s_row[F])And
  1895.          (Col>=S_Field^.s_col[F])And
  1896.          (Col<=((S_Field^.s_col[F])+(S_Field^.s_len[F]+1)))) Do
  1897.         Begin
  1898.  
  1899.         Col := ((S_Field^.s_col[F])+(S_Field^.s_len[F]+2));
  1900.         Inc(F);
  1901.  
  1902.         if (Col>EC) Then Begin Inc(Row);Col:=SC;End;
  1903.  
  1904.         if (Row>S_Field^.s_row[F]) Then
  1905.            while ((F<S_Indx^.s_count[S_Num])And(Row>S_Field^.s_row[F])) Do
  1906.               Inc(F);
  1907.  
  1908.         while((Row=S_Field^.s_row[F])And
  1909.               (SC>((S_Field^.s_col[F])+(S_Field^.s_len[F]+1)))) Do Inc(F);
  1910.         if (F>S_Indx^.s_count[S_Num]) Then F:=0;
  1911.         End;
  1912.       End;
  1913.  
  1914.     if (Row<=ER) And (Col<=EC) Then
  1915.       Begin
  1916.       P:=(((Row-1)*160)+((Col-1)*2))+1;
  1917.       Ch:= Ord(s_record^.s_video[P]);
  1918.       Case CT of
  1919.         0 :s_record^.s_video[P+1]:=Chr(Color);
  1920.         1 :if Ch In [179,180,191..197,217,218] Then
  1921.             s_record^.s_video[P+1]:=Chr(Color);
  1922.         2 :if Ch in [181..190,198..216] Then
  1923.             s_record^.s_video[P+1]:=Chr(Color);
  1924.         3 :if Ch in [219..223] Then
  1925.             s_record^.s_video[P+1]:=Chr(Color);
  1926.         End;
  1927.       End;
  1928.     Inc(Col);
  1929.     if (Col>EC) Then Begin Inc(Row);Col:=SC;End;
  1930.     End;
  1931.   Until (Row>ER);
  1932.   S_ChangeScreenColor := 0;
  1933.   End;
  1934. End;
  1935.  
  1936.  
  1937.  
  1938.  
  1939. Function S_ChangeFieldColor(Fl,ST,Bg,Fg:Integer):Integer;
  1940. Begin
  1941. If (Fl>S_Indx^.s_count[S_Num]) Then
  1942.   S_ChangeFieldColor := 1
  1943. Else
  1944. If  (ST>2) Then
  1945.   S_ChangeFieldColor := 2
  1946. Else
  1947. If  (Bg>7) Then
  1948.   S_ChangeFieldColor := 3
  1949. Else
  1950. If  (Fg>30) Then
  1951.   S_ChangeFieldColor := 4
  1952. Else
  1953.   Begin
  1954.   Case ST of
  1955.     0 :Begin
  1956.        S_Field^.s_normalbg[Fl]:=Bg;
  1957.        S_Field^.s_normalfg[Fl]:=Fg;
  1958.        End;
  1959.     1 :Begin
  1960.        S_Field^.s_promptbg[Fl]:=Bg;
  1961.        S_Field^.s_promptfg[Fl]:=Fg;
  1962.        End;
  1963.     2 :Begin
  1964.        S_Field^.s_displaybg[Fl]:=Bg;
  1965.        S_Field^.s_displayfg[Fl]:=Fg;
  1966.        End;
  1967.     End;
  1968.   S_ChangeFieldColor := 0;
  1969.   End;
  1970. End;
  1971.  
  1972.  
  1973.  
  1974.  
  1975. Procedure S_StoreColorChanges;
  1976. Var
  1977. Hold : String[16];
  1978. A,B,C,X,Y,Z,RR:Integer;
  1979.  
  1980. Begin
  1981. If  S_Indx^.s_fieldsrecno[S_Num] > 0 Then
  1982.   Begin
  1983.   S_FirstField := (S_Indx^.s_firstfield[S_Num]);
  1984.   S_Point      := 0;
  1985.   X            := 0;
  1986.   While X < S_Indx^.s_count[S_Num] Do
  1987.     Begin
  1988.     Inc(X);
  1989.     Z := (((S_Field^.s_col[X])-1)*2)+1;
  1990.     A := (S_Field^.s_col[X]+S_Field^.s_len[X])*2;
  1991.     B := (S_Field^.s_row[X]-1)*160;
  1992.     s_record^.s_video[B+Z]:='[';
  1993.     s_record^.s_video[B+A]:=']';
  1994.     C := 1;
  1995.     Z := S_Field^.s_col[X]*2;
  1996.     While (C<16) Do
  1997.       Begin
  1998.       if  (S_Field^.s_fieldname[X][C] > #32) Then
  1999.         s_record^.s_video[B+Z] := S_Field^.s_fieldname[X][C]
  2000.       else
  2001.         C:=99;
  2002.       inc(Z,2);
  2003.       inc(C);
  2004.       End;
  2005.     End;
  2006.   Seek(S_File,S_Indx^.s_fieldsrecno[S_Num]);
  2007.   Write(S_File,S_Field^);
  2008.   End;
  2009. Seek(S_File,0);
  2010. Write(S_File,S_record^);
  2011. S_LoadScreen(S_Indx^.s_name[S_Num]);
  2012. End;
  2013.  
  2014. {$ENDIF}
  2015.  
  2016.  
  2017.  
  2018.  
  2019. {$IFDEF VALIDATE}
  2020. {$I VALIDATE.PAS}
  2021. {$ENDIF}
  2022.  
  2023.  
  2024.  
  2025.  
  2026. Procedure S_NextKey;
  2027. Begin
  2028. S_ErrorMsg := '';
  2029. S_UserMsg  := '';
  2030. S_AutoHelpMsg := '';
  2031. S_Wait := True;
  2032. S_FlushKeyBuf;
  2033. S_GetKey;
  2034. End;
  2035.  
  2036.  
  2037.  
  2038.  
  2039. Procedure S_ReadKey;
  2040. Begin
  2041. If  S_Delayed Then
  2042.     Begin
  2043.     S_RefreshScreen;
  2044.     S_Delayed := False;
  2045.     End;
  2046. If  S_Indx^.S_Count[S_Num] > 0 Then S_FillScreen;
  2047. S_FlushKeyBuf;
  2048. S_StLabelColor := S_SetColor(S_StLabelBg,S_StLabelFg);
  2049. S_StColor      := S_SetColor(S_StBg,S_StFg);
  2050. S_GetKey;
  2051. End;
  2052.  
  2053.  
  2054.  
  2055.  
  2056.  
  2057. Procedure S_ReadField;
  2058. Var
  2059. RealWork : Real;
  2060. S_Result : Integer;
  2061. Testcnt  : integer;
  2062.  
  2063. Begin
  2064. If  Not S_FileOpen Then
  2065.   Begin
  2066.   S_ErrorMsg := '** No screen has been opened.!! **';
  2067.   S_Readkey;
  2068.   Exit;
  2069.   End;
  2070.  
  2071. If  S_Delayed Then
  2072.     S_RefreshScreen;
  2073.  
  2074. If  S_Indx^.S_Count[S_Num] > 0 Then S_FillScreen;
  2075.  
  2076. If  (S_Point < 0) Or (S_Point > S_Indx^.S_Count[S_Num]) Then
  2077.   Begin
  2078.   S_ErrorMsg := ' Field number in S_Point is out of range ';
  2079.   S_ReadKey;
  2080.   Exit;
  2081.   End;
  2082.  
  2083. If  S_Field^.S_Type[S_Point] In [90..99,100..109] Then
  2084.   Begin
  2085.   S_ErrorMsg := ' Cannot do entry into a PROTECTED field - Any Key To Continue';
  2086.   S_Readkey;
  2087.   Exit;
  2088.   End;
  2089.  
  2090.  
  2091. If  S_Field^.S_Type[S_Point] In [10..19] Then
  2092.   Begin
  2093.   If  Not(S_SetDupFields) then
  2094.     Begin
  2095.     S_ErrorMsg := ' Invalid access of dupe (repeating) field - Any key to Continue';
  2096.     S_Readkey;
  2097.     Exit;
  2098.     End
  2099.   Else
  2100.     S_SetDupFields := False;
  2101.   End
  2102. Else
  2103.   If  S_SetDupFields Then
  2104.     Begin
  2105.     S_ErrorMsg := ' Invalid access of dupe (repeating) fields - Any key to Continue';
  2106.     S_Readkey;
  2107.     Exit;
  2108.     End;
  2109.  
  2110.  
  2111. S_PrevFld := S_Point;
  2112.  
  2113. Repeat
  2114.   S_Get_Field_Value(S_Point);
  2115.   S_GetFieldType   (S_Field^.S_Type[S_Point]);
  2116.   Repeat
  2117.     S_PreEdit(
  2118.       S_Field^.S_RangeNextRec[S_Point],
  2119.       S_Field^.S_RangeNextLine[S_Point]);
  2120.     S_EditString (
  2121.       S_Field^.S_Row[S_Point],
  2122.       S_Field^.S_Col[S_Point],
  2123.       S_FType,
  2124.       S_Field^.S_Len[S_Point],
  2125.       S_Field^.S_PromptFG[S_Point],
  2126.       S_Field^.S_PromptBG[S_Point],
  2127.       S_Field^.S_DisplayFg[S_Point],
  2128.       S_Field^.S_DisplayBg[S_Point],
  2129.       S_Field^.S_NormalFg[S_Point],
  2130.       S_Field^.S_NormalBg[S_Point],
  2131.       S_Field^.S_RangeNextRec[S_Point],
  2132.       S_Field^.S_RangeNextLine[S_Point],
  2133.       S_EditStr);
  2134.   S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  2135.   If  S_FType in [0..7] Then
  2136.     Begin
  2137.     Val(S_EditStr,RealWork,S_Result);
  2138.     Move(RealWork,S_WorkArea^[S_FieldPtr^[S_Point]],6);
  2139.     End
  2140.   Else
  2141.     Begin
  2142.     Fillchar(S_WorkStr,80,0);
  2143.     Move(S_EditStr,S_WorkStr,Length(S_EditStr)+1);
  2144.     MOVE(S_WorkStr,S_WorkArea^[S_FieldPtr^[S_Point]],
  2145.     S_Field^.S_Len[S_Point] + 1);
  2146.     End;
  2147.  
  2148.   If  S_Tab Then S_Fkey := True;
  2149.  
  2150. {$IFDEF MOUSE}
  2151.   Until ((S_MouseEvent) Or (S_Enter) or (S_PrevFld <> S_Point) or (S_Fkey));
  2152. {$ELSE}
  2153.   Until ((S_Enter) or (S_PrevFld <> S_Point) or (S_Fkey));
  2154. {$ENDIF}
  2155.  
  2156.   S_Point := S_PrevFld;
  2157.   If  (S_Enter)Or(S_Tab)Or(S_LeftArrow)Or(S_RightArrow) Then
  2158.     Begin
  2159. {$IFDEF VALIDATE}
  2160.     If  (S_Field^.S_RangeNextRec[S_Point] > 0) Then
  2161.       Begin
  2162.       S_ValidateField := S_Point;
  2163.       S_ValidateScreen;
  2164.       S_ValidateField := 0;
  2165.       If  not S_ScreenValid Then S_ResetKeyFlags;
  2166.       End
  2167.     Else
  2168. {$ENDIF}
  2169.       If  (Length(S_EditStr) > S_Field^.S_Len[S_Point]) Or (S_Enter) Then
  2170.         S_ScreenValid := True;
  2171.     End;
  2172.  
  2173. {$IFDEF MOUSE}
  2174.   Until (S_MouseEvent) Or (S_ScreenValid) OR (S_Fkey);
  2175. {$ELSE}
  2176.   Until (S_ScreenValid) OR (S_Fkey);
  2177. {$ENDIF}
  2178. End;
  2179.  
  2180.  
  2181.  
  2182.  
  2183.  
  2184.  
  2185. Procedure S_ReadScreen;
  2186. Var
  2187. RealWork: Real;
  2188. S_Result: Integer;
  2189. Begin
  2190. If  Not S_FileOpen Then
  2191.   Begin
  2192.   S_ErrorMsg := '** No screen has been opened.!! **';
  2193.   S_Readkey;
  2194.   Exit;
  2195.   End;
  2196.  
  2197. If  S_Delayed Then
  2198.     S_RefreshScreen;
  2199.  
  2200. Case S_Indx^.S_CompiledInd [S_Num] Of
  2201.  1,2 : S_ReadKey;
  2202.    3 : Begin
  2203.        S_ScreenValid   := False;
  2204.        S_ValidateField := 0;
  2205.        Repeat
  2206.          S_FillScreen;
  2207.          If  S_Point = 0 Then S_PrevFld := 9999;
  2208.          S_Direction := 1;
  2209.          If  Not(S_Point In [1..S_Indx^.S_Count[S_Num]]) Then
  2210.              S_Point     := S_Indx^.S_FirstField[S_Num];
  2211.          Repeat
  2212.            If  (S_Field^.S_Type[S_Point] > 19) Or
  2213.                (Not S_SetDupeFields)And(S_Field^.S_Type[S_Point] > 9) Then
  2214.              Begin
  2215.              S_PrevFld := 0;
  2216.              Repeat
  2217.                If  S_Direction > 0 then S_Point := S_Field^.S_Next [S_Point];
  2218.                If  S_Direction < 0 then S_Point := S_Field^.S_Prev [S_Point];
  2219.                S_GetFieldType(S_Field^.S_Type[S_Point]);
  2220.                If  (S_EntryType)Or
  2221.                    ((Not(S_DispType)And(S_DupType)And(S_Direction = -1))) Then
  2222.                  S_PrevFld := S_Point;
  2223.              Until S_PrevFld > 0;
  2224.              End
  2225.            Else
  2226.              S_SetDupeFields := False;
  2227.  
  2228.          S_PrevFld := S_Point;
  2229.  
  2230.          S_Get_Field_Value(S_Point);
  2231.          S_PreEdit(
  2232.            S_Field^.S_RangeNextRec[S_Point],
  2233.            S_Field^.S_RangeNextLine[S_Point]);
  2234.          S_EditString(
  2235.            S_Field^.S_Row[S_Point],
  2236.            S_Field^.S_Col[S_Point],
  2237.            S_FType,
  2238.            S_Field^.S_Len[S_Point],
  2239.            S_Field^.S_PromptFG[S_Point],
  2240.            S_Field^.S_PromptBG[S_Point],
  2241.            S_Field^.S_DisplayFg[S_Point],
  2242.            S_Field^.S_DisplayBg[S_Point],
  2243.            S_Field^.S_NormalFg[S_Point],
  2244.            S_Field^.S_NormalBg[S_Point],
  2245.            S_Field^.S_RangeNextRec[S_Point],
  2246.            S_Field^.S_RangeNextLine[S_Point],
  2247.            S_EditStr);
  2248.  
  2249.                     S_Field^.S_DataLen[S_Point] := S_Length(S_EditStr);
  2250.  
  2251.          If  S_FType in [0..7] Then
  2252.            Begin
  2253.            Val(S_EditStr,RealWork,S_Result);
  2254.            Move(RealWork,S_WorkArea^[S_FieldPtr^[S_Point]],SizeOf(Real));
  2255.            End
  2256.          Else
  2257.            Begin
  2258.            Fillchar(S_WorkStr,80,0);
  2259.            Move(S_EditStr,S_WorkStr,Length(S_EditStr)+1);
  2260.            MOVE(S_WorkStr,S_WorkArea^[S_FieldPtr^[S_Point]],
  2261.              S_Field^.S_Len[S_Point] + 1);
  2262.            End;
  2263.  
  2264. {$IFDEF VALIDATE}
  2265.          If  S_AutoValidate Then
  2266.            Begin
  2267.            If  (S_Field^.S_RangeNextRec[S_Point] > 0) Then
  2268.              Begin
  2269.              S_ValidateField := S_Point;
  2270.              S_ValidateScreen;
  2271.              S_ValidateField := 0;
  2272.              If  not S_ScreenValid Then
  2273.                S_Tab  := False;
  2274.              End;
  2275.            End;
  2276. {$ENDIF}
  2277.          If  S_Tab Then
  2278.            Begin
  2279.            S_PrevFld := 0;
  2280.            If  S_Shift then
  2281.              Begin
  2282.              S_Direction := -1;
  2283.              S_Point := S_Field^.S_Prev [S_Point];
  2284.              If S_Field^.S_Type[S_Point] In [10..20] Then
  2285.                 S_SetDupeFields := True;
  2286.              End
  2287.            Else
  2288.              Begin
  2289.              S_Direction := 1;
  2290.              S_Point := S_Field^.S_Next [S_Point];
  2291.              End;
  2292.            S_Fkey  := False;
  2293.            S_Shift := False;
  2294.            End;
  2295.  
  2296. {$IFDEF MOUSE}
  2297.        Until (S_MouseEvent) Or (S_Enter) OR (S_Fkey);
  2298. {$ELSE}
  2299.        Until (S_Enter) OR (S_Fkey);
  2300. {$ENDIF}
  2301.  
  2302. {$IFDEF VALIDATE}
  2303.        If  S_ENTER then S_ValidateScreen;
  2304. {$ELSE}
  2305.        S_ScreenValid := True;
  2306. {$ENDIF}
  2307.  
  2308. {$IFDEF MOUSE}
  2309.      Until (S_MouseEvent) Or (S_ScreenValid) OR (S_Fkey);
  2310. {$ELSE}
  2311.      Until (S_ScreenValid) OR (S_Fkey);
  2312. {$ENDIF}
  2313.  
  2314.   End; {End Case Of}
  2315.   End;
  2316. End;
  2317.  
  2318.  
  2319.  
  2320. Begin
  2321. S_ScrEditPrevExit := ExitProc;
  2322. ExitProc          := @S_ExitProc;
  2323. FillChar (S_Msg,81,00);
  2324. FillChar (S_Blanks,81,32);
  2325. S_Blanks[0] := Chr(80);
  2326. FillChar(S_StAttrWork,21,112);
  2327. S_StAttrWork[0] := #20;
  2328. FillChar(S_NormAttrib,81,00);
  2329. S_StLine    := '[Insert] [Caps] [Num Lock] [Scroll Lock]';
  2330.  
  2331. S_StLabelBg := 7;
  2332. S_StLabelFg := 0;
  2333. S_StBg := 0;
  2334. S_StFg := 2;
  2335. S_FastVideo     := False;
  2336. S_Wait          := False;
  2337. S_SetDupeFields := False;
  2338. S_QuickHelp     := False;
  2339. S_DelayScreen   := False;
  2340. S_Delayed       := False;
  2341. S_BufferOnly    := False;
  2342. S_UserBg := 4;
  2343. S_UserFg := 15;
  2344. S_UserSound := True;
  2345. S_UserFreq  := 300;
  2346. S_UserDur   := 150;
  2347. S_UserMsg   := '';
  2348.  
  2349. S_ErrorBg := 4;
  2350. S_ErrorFg := 15;
  2351. S_ErrorSound := True;
  2352. S_ErrorFreq  := 300;
  2353. S_ErrorDur   := 150;
  2354. S_ErrorMsg   := '';
  2355.  
  2356. S_HelpBg := 4;
  2357. S_HelpFg := 15;
  2358. S_HelpSound := True;
  2359. S_HelpFreq  := 300;
  2360. S_HelpDur   := 150;
  2361. S_AutoHelp := False;
  2362. S_AutoHelpMsg := '';
  2363. S_AutoValidate:= False;
  2364.  
  2365. S_EditMask := '';
  2366. S_Force_EditMask := False;
  2367. S_Cursor := S_Off;
  2368. S_Msg    := '';
  2369. S_MessBg  := 4;
  2370. S_MessFg  := 15;
  2371. S_Sound  := True;
  2372. S_Freq   := 300;
  2373. S_Dur    := 100;
  2374.  
  2375. S_EnterAsTab := False;
  2376.  
  2377. S_Ch := Chr(00);
  2378. S_Point := 0;
  2379. S_Direction:= 1;
  2380. S_NewStr := '';
  2381. S_Padding := '';
  2382. S_VRec  := 0;
  2383. S_RecNo := 0;
  2384. S_ValidateLine:= 0;
  2385.  
  2386. S_ResetKeyFlags;
  2387.  
  2388. S_Seg := $B000;
  2389.  
  2390. If  S_VideoPort = $3B4 Then
  2391.   Begin
  2392.   S_Ofs     := $0000;
  2393.   S_Mono    := True;
  2394.   End
  2395. Else
  2396.   Begin
  2397.   S_Mono := False;
  2398.   S_Ofs  := $8000;
  2399.   End;
  2400.  
  2401. S_BW := False;
  2402. For S_Count := 1 to ParamCount Do
  2403.   Begin
  2404.   S_WorkStr := ParamStr(S_Count);
  2405.   If  S_UpShiftedStr(S_WorkStr) = '/BW' Then S_BW := True;
  2406.   End;
  2407.  
  2408. If  S_BW Then
  2409.   Begin
  2410.   S_UserBg := 0;
  2411.   S_UserFg := 15;
  2412.   S_MessBg := 0;
  2413.   S_MessFg := 15;
  2414.   S_HelpBg := 0;
  2415.   S_HelpFg := 15;
  2416.   S_ErrorBg := 0;
  2417.   S_ErrorFg := 15;
  2418.   End;
  2419.  
  2420. If  MaxAvail > 25000 Then
  2421.   Begin
  2422.   GetMem(S_Indx,    SizeOf(S_Indx^));
  2423.   GetMem(S_Record,  SizeOf(S_Indx^));
  2424.   GetMem(S_Field,   SizeOf(S_Indx^));
  2425.   GetMem(S_Validate,SizeOf(S_Indx^));
  2426.   GetMem(S_FieldPtr,SizeOf(S_FieldPtr^));
  2427.   GetMem(S_BuffPtr, SizeOf(S_BuffPtr^));
  2428.   FillChar(S_BuffPtr^, SizeOf(S_BuffPtr^),0);
  2429.   FillChar(S_FieldPtr^,SizeOf(S_FieldPtr^),0);
  2430.   End
  2431. Else
  2432.   Begin
  2433.   ClrScr;
  2434.   Write ('Not enough free heap memory for Turbo ScrEdit to run properly ');
  2435.   Halt;
  2436.   End;
  2437.  
  2438. S_SetCursor(S_GetCursor);
  2439. S_SetCursor(S_Off);
  2440. End.{Unit}
  2441.