home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MGTP4.ZIP / MGPROG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-14  |  29.6 KB  |  1,202 lines
  1. {  ** Start of MGPROG.INC **
  2. Author : Eric H. Snyder
  3.          1417 Evergreen
  4.          Homewood, IL  60430
  5.  
  6. Note   : The user must declare the number of windows in the program
  7.          as follows;
  8.          Const
  9.            ScreenCount = N;      Where N = the # of windows being defined.
  10.                                  I have set a default number of eight.
  11. }
  12.  
  13. Unit MGProg;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   Dos,
  19.   Crt;
  20.  
  21. Type
  22.   MG_Str80    = String[80];
  23.   MG_ExitsTyp = Set of Byte;
  24.   MG_Edits    = Set of Char;
  25.   MG_Str255   = String;
  26.   MG_ScreenObjLLPtr = ^MG_ScreenObjLLTyp;
  27.   MG_ScreenObjLLTyp =  Record
  28.                          LLForward : MG_ScreenObjLLPtr;
  29.                          LLWindow  : Byte;
  30.                          LLTyp     : Char;
  31.                          LLCol, LLRow, LLAtr, LLlen : Integer;
  32.                          LLTxt     : MG_Str80;
  33.                        End;
  34.  
  35. Const
  36.   ScreenCount = 20;
  37.   MG_TimeOut  : Integer = 300;
  38.  
  39. Var
  40.   MG_ScreenType :  Char;
  41.   UpperByte,LowerByte    :  Byte;          { Used                    }
  42.   UpperInt,LowerInt      :  Integer;       {      in range           }
  43.   UpperReal,LowerReal    :  Real;          {               checking  }
  44.   UserEditSet            :  Set of Char;   { User declared char set  }
  45.   UserExitSet            :  MG_ExitsTyp;
  46.   MG_RiteFlag            :  Array[1..ScreenCount] of Boolean;
  47.   MG_ScreenLLBase        :  MG_ScreenObjLLPtr;
  48.   MG_ScreenObjLL         :  MG_ScreenObjLLPtr;
  49.   RightShift,LeftShift   :  Boolean;
  50.   AltKey,CtrlKey         :  Boolean;
  51.  
  52. Procedure Rite(S:MG_Str80;Col,Row:Integer;Attr:Byte);
  53. Procedure WinRite(S:MG_Str80;X,Y:Byte;Attr:Integer);
  54. Procedure DefineScreen(Ind,dfX1,dfY1,dfX2,dfY2,dfBgCol,dfFrameTyp,dfFrCol:Byte);
  55. Procedure OpenWindow(Ind:Byte);
  56. Procedure CloseWindow;
  57. Procedure CloseAllWindows;
  58. Procedure TerminateScreens;
  59. Procedure MaxLimits;
  60. Procedure CharOut(ScrOfs,Ch:Integer;Attr:Byte);
  61.  
  62. Function EnterChar(Var Value     : Char;
  63.                        GoodChars : MG_Edits;
  64.                        Exits     : MG_ExitsTyp) : Integer;
  65.  
  66. Function EnterData(Var Variable;                 { Variable being entered  }
  67.                        VarTyp     : Char;        { Indicated Variable type }
  68.                        XLoc,YLoc,                { X & Y Co-ordinates      }
  69.                        Len,                      { Length of field         }
  70.                        Decs,                     { No. of decimal places   }
  71.                        FieldAttr,
  72.                        CursorAttr : Byte;
  73.                        Exits      : MG_ExitsTyp):Integer;
  74.                                                  {Exits in addition to  }
  75.                                                  { -1 : Param error     }
  76.                                                  {  0 : Typing out      }
  77.                                                  { 13 : Carriage Return }
  78.                                                  {-13 : ^M              }
  79. Function Menu( Window  : Byte;
  80.                S       : MG_Str255;
  81.                Selections,NormAttr,ReverseAttr
  82.                        : Byte;
  83.                Exits   : MG_ExitsTyp) : Byte;
  84.  
  85. Implementation
  86.  
  87. Type
  88.   MG_CharPtr        =  ^Char;
  89.   MG_ScreenImage    =  array[1..25,1..80] of integer;
  90.   MG_ScreenDef      =  Record
  91.                          X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol : Byte;
  92.                        End;
  93.  
  94.   MG_SavedScreen    = ^MG_SavedScreenRec;
  95.   MG_SavedScreenRec =  Record
  96.                          BackLink        : MG_SavedScreen;
  97.                          XLoc,Yloc       : Integer;
  98.                          ScreenStats     : MG_ScreenDef;
  99.                          MG_SavedWindow  : MG_CharPtr;
  100.                        End;
  101.  
  102.   MG_FrameChars = Record
  103.                     TL,TR,BL,BR,HC,VC : Char;
  104.                    End;
  105.  
  106. Const           { Delete unused frame character constant records }
  107.   MG_LastOpened  : MG_ScreenDef = (X1:0;Y1:0;X2:81;Y2:26;BgCol:0;FrameTyp:0;FrCol:0);
  108.   MG_FirstScreen : Boolean = True;
  109.  
  110. Var
  111.   MG_PhysicalScreen      : MG_CharPtr;
  112.   MG_CurrentScreen,
  113.   MG_NewScreen           :  MG_SavedScreen;
  114.   MG_DefinedScreens      :  Array[1..ScreenCount] of MG_ScreenDef;
  115.   MG_Registers           :  Registers;
  116.   
  117.  
  118. Procedure CharOut;
  119. Begin
  120. Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + ScrOfs)]     := Ch;
  121. Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + ScrOfs + 1)] := Attr;
  122. End; {CharOut}
  123.  
  124. Procedure Rite;
  125. Var
  126.   I,ScrOfs : Integer;
  127. Begin
  128. Row := (Row - 1) * 160;
  129. For I := 1 to Length(S) do
  130.   Begin
  131.   ScrOfs := Row + ((Col + I - 2) * 2);
  132.   CharOut(ScrOfs,Ord(S[I]),Attr);
  133.   End;
  134. End; {Rite}
  135.  
  136. Procedure WinRite;
  137. Begin
  138. With MG_LastOpened do
  139.   Begin
  140.   X := X + X1;
  141.   Y := Y + Y1;
  142.   End;
  143. Rite(S,X,Y,Attr);
  144. End; {WinRite}
  145.  
  146. Procedure DefineScreen;
  147. Begin
  148. With MG_DefinedScreens[Ind] do
  149.   Begin
  150.   X1       := dfX1;
  151.   Y1       := dfY1;
  152.   X2       := dfX2;
  153.   Y2       := dfY2;
  154.   BgCol    := dfBgCol;
  155.   FrameTyp := dfFrameTyp;
  156.   FrCol    := dfFrCol;
  157.   End;
  158. End;
  159.  
  160. Procedure MakeFrame(X1,Y1,X2,Y2,BgCol,Border,LinAttr : Integer);
  161. Type
  162.   BorderCharacters = Array[1..8] of Integer;
  163. Const
  164.   BorderTypes : Array[1..8] of BorderCharacters =
  165.                   (
  166.                   (218,196,191,179,179,192,196,217),
  167.                   (201,205,187,186,186,200,205,188),
  168.                   (213,205,184,179,179,212,205,190),
  169.                   (214,196,183,186,186,211,196,189),
  170.                   (194,196,194,179,179,192,196,217),
  171.                   (203,205,203,186,186,200,205,188),
  172.                   (209,205,209,179,179,212,205,190),
  173.                   (210,196,210,186,186,211,196,189)
  174.                   );
  175. Var
  176.   LLHoriz,LLVert : Integer;
  177.   TLCorner       : Integer;
  178.   THLine         : Integer;
  179.   TRCorner       : Integer;
  180.   LVLine         : Integer;
  181.   RVLine         : Integer;
  182.   BLCorner       : Integer;
  183.   BHLine         : Integer;
  184.   BRCorner       : Integer;
  185.  
  186. Procedure BorderLine(Row,Col,Num,Ch,Direction,Attr : Integer);
  187. Var
  188.   I,ScrOfs : Integer;
  189. Begin
  190. ScrOfs := ((Row - 1) * 160) + ((Col - 1) * 2);
  191. For I := 1 to Num do
  192.   Begin
  193.   CharOut(ScrOfs,Ch,Attr);
  194.   If Direction = 0 then
  195.     ScrOfs := ScrOfs + 160
  196.   Else
  197.     ScrOfs := ScrOfs + 2;
  198.   End;
  199. End; {BorderLine}
  200.  
  201. Begin
  202. Window(X1,Y1,X2,Y2);
  203. TextBackground(BgCol);
  204. ClrScr;
  205. LLHoriz   := X2 - X1 + 1;
  206. LLVert    := Y2 - Y1 + 1;
  207. TLCorner  := BorderTypes[Border,1];
  208. THLine    := BorderTypes[Border,2];
  209. TRCorner  := BorderTypes[Border,3];
  210. LVLine    := BorderTypes[Border,4];
  211. RVLine    := BorderTypes[Border,5];
  212. BLCorner  := BorderTypes[Border,6];
  213. BHLine    := BorderTypes[Border,7];
  214. BRCorner  := BorderTypes[Border,8];
  215. CharOut( (((Y1 - 1) * 160) + ((X1 - 1) * 2)),TLCorner,LinAttr);
  216. BorderLine(Y1,(X1 + 1),(LLHoriz - 2),THLine,1,LinAttr);
  217. CharOut( (((Y1 - 1) * 160) + ((X2 - 1) * 2)),TRCorner,LinAttr);
  218. BorderLine((Y1 + 1),X1,(LLVert - 2),LVLine,0,LinAttr);
  219. BorderLine((Y1 + 1),X2,(LLVert - 2),RVLine,0,LinAttr);
  220. CharOut( (((Y2 - 1) * 160) + ((X1 - 1) * 2)),BLCorner,LinAttr);
  221. BorderLine(Y2,(X1 + 1),(LLHoriz - 2),BHLine,1,LinAttr);
  222. CharOut( (((Y2 - 1) * 160) + ((X2 - 1) * 2)),BRCorner,LinAttr);
  223. Window((X1 + 1),(Y1 + 1),(X2 - 1),(Y2 - 1));
  224. GotoXY(1,1);
  225. End; {MakeFrame}
  226.  
  227. Procedure OpenWindow;
  228.  
  229. Var
  230.   SD      : MG_ScreenDef;
  231.   LLObj   : MG_ScreenObjLLPtr;
  232.   WorkStr : MG_Str80;
  233.   I,J     : Integer;
  234.  
  235. Function SaveWindowContents(X1,Y1,X2,Y2 : Integer):MG_CharPtr;
  236.  
  237. Var
  238.   I,J     : Integer;
  239.   LLHoriz,LLVert : Integer;
  240.   Width   : Integer;
  241.   MovePtr : MG_CharPtr;
  242.  
  243. Begin
  244. LLHoriz := X2 - X1 + 1;
  245. LLVert  := Y2 - Y1 + 1;
  246. Width   := LLHoriz * 2;
  247. j       := ((Y1 - 1) * 160) + ((X1 - 1) * 2);
  248. GetMem(MovePtr,((LLHoriz * LLVert) * 2));
  249. SaveWindowContents := MovePtr;
  250. For I := 1 to LLVert do
  251.   Begin
  252.   Move(Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + J)],MovePtr^,Width);
  253.   J       := J + 160;
  254.   MovePtr := Ptr(Seg(MovePtr^),(Ofs(MovePtr^) + Width));
  255.   End;
  256. End; {SaveWindowContents}
  257.  
  258. Begin
  259. SD := MG_DefinedScreens[Ind];
  260. New(MG_NewScreen);
  261. With MG_NewScreen^ do
  262.   Begin
  263.   XLoc := WhereX;
  264.   YLoc := WhereY;
  265.   With SD do
  266.     MG_SavedWindow := SaveWindowContents(X1,Y1,X2,Y2);
  267.   ScreenStats := MG_LastOpened;
  268.   If MG_FirstScreen then
  269.     Begin
  270.     BackLink        := nil;
  271.     MG_FirstScreen  := False;
  272.     End
  273.   Else
  274.     BackLink       := MG_CurrentScreen;
  275.   MG_CurrentScreen := MG_NewScreen
  276.   End;
  277. With SD do
  278.     MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol);
  279. MG_LastOpened := SD;
  280. If not MG_RiteFlag[Ind] then
  281.   Exit;
  282. LLObj := MG_ScreenLLBase;
  283. While (LLObj^.LLforward <> Nil) and
  284.       (LLObj^.LLWindow <> Ind)  do
  285.   LLObj := LLObj^.LLForward;
  286. If LLObj^.LLForward = Nil then
  287.   Exit;
  288. While (LLObj <> Nil) and
  289.       (LLObj^.LLWindow = Ind)   do
  290.   Begin
  291.   With LLObj^ do
  292.     Case LLTyp of
  293.   'T','H' : WinRite(LLTxt,LLCol,LLRow,LLAtr);
  294.       'F' : Begin
  295.             FillChar(WorkStr[1],LLlen,' ');
  296.             WorkStr[0] := Chr(Ord(LLlen));
  297.             WinRite(WorkStr,LLCol,LLRow,LLAtr);
  298.             End;
  299.       'V' : Begin
  300.             J := ((LLRow - 1) * 160) + ((LLCol - 1) * 2);
  301.             For I := 1 to Length(LLTxt) do
  302.               Begin
  303.               CharOut(J,Ord(LLTxt[I]),LLAtr);
  304.               J := J + 160;
  305.               End;
  306.             End;
  307.       End; {case}
  308.   LLObj := LLObj^.LLForward;
  309.   End;
  310. End; {OpenWindow}
  311.  
  312. Procedure CloseWindow;
  313.  
  314. Procedure  ReDisplayWindowContents(X1,Y1,X2,Y2 : Integer;
  315.                                        MovePtr : MG_CharPtr);
  316. Var
  317.   I,J     : Integer;
  318.   LLHoriz,LLVert : Integer;
  319.   Width   : Integer;
  320.   P       : MG_CharPtr;
  321.  
  322. Begin
  323. P       := MovePtr;
  324. LLHoriz := X2 - X1 + 1;
  325. LLVert  := Y2 - Y1 + 1;
  326. Width   := LLHoriz * 2;
  327. J       := ((Y1 - 1) * 160) + ((X1 - 1) * 2);
  328. For i := 1 to LLVert do
  329.   Begin
  330.   Move(MovePtr^,Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + J)],Width);
  331.   J       := J + 160;
  332.   MovePtr := Ptr(Seg(MovePtr^),(Ofs(MovePtr^) + Width));
  333.   End;
  334. FreeMem(P,((LLHoriz * LLVert)*2));
  335. End; {ReDisplayWindowContents}
  336.  
  337. Begin
  338. MG_NewScreen := MG_CurrentScreen;
  339. With MG_NewScreen^ do
  340.   Begin
  341.   With MG_LastOpened do
  342.     ReDisplayWindowContents(X1,Y1,X2,Y2,MG_SavedWindow);
  343.   With ScreenStats do
  344.     Window(X1+1,Y1+1,X2-1,Y2-1);
  345.   GotoXY(XLoc,YLoc);
  346.   MG_LastOpened    := ScreenStats;
  347.   MG_CurrentScreen := BackLink;
  348.   End;
  349. Dispose(MG_NewScreen);
  350. End; {CloseWindow}
  351.  
  352. Procedure CloseAllWindows;
  353. Begin
  354. While MG_CurrentScreen <> nil do
  355.   CloseWindow;
  356. End; {CloseAllWindows}
  357.  
  358. Procedure TerminateScreens;
  359. Var
  360.   LLBase,LLDispose : MG_ScreenObjLLPtr;
  361. Begin
  362. If Not MG_FirstSCreen then
  363.   CloseAllWindows;
  364. LLBase := MG_ScreenLLBase;
  365. While LLBase <> nil do
  366.   Begin
  367.   LLDispose := LLBase;
  368.   LLBase    := LLBase^.LLForward;
  369.   Dispose(LLDispose);
  370.   End;
  371. End; {TerminateScreens}
  372.  
  373. {*******************************************************************}
  374. {** End of windowing routines **}{** Start of data entry routines **}
  375. {*******************************************************************}
  376.  
  377. Procedure MaxLimits;
  378. Begin
  379. LowerByte := 0;         UpperByte := 255;
  380. LowerInt  := -32767;    UpperInt  := MaxInt;
  381. LowerReal := 1E-38;     UpperReal := 1E+37;
  382. End; {MaxLimits}
  383.  
  384. Procedure ScreenSaver(TimeOut:Integer);
  385.  
  386. Const
  387.   CrtModePort : array[0..1] of Integer = ($03B8,$03D8);
  388. Var
  389.   StartTime,EndTime : Integer;
  390.   ScreenBlanked     : Boolean;
  391.   Ch                : Char;
  392.   CrtModeByte       : Byte absolute $0040:$0065;
  393.   DisplayAdapter            : Integer;
  394.   Hour,Minute,Second,Sec100 : Word;
  395.  
  396. Begin
  397. Case MG_ScreenType of
  398.   'M' : DisplayAdapter := 0;
  399.   'C' : DisplayAdapter := 1;
  400.   End;
  401. Repeat
  402.   ScreenBlanked := False;
  403.   GetTime(Hour,Minute,Second,Sec100);
  404.   StartTime := (Minute * 60) + Second;
  405.   While not KeyPressed do
  406.     If not ScreenBlanked then
  407.       Begin
  408.       GetTime(Hour,Minute,Second,Sec100);
  409.       EndTime := (Minute * 60) + Second;
  410.       If EndTime < StartTime then
  411.         EndTime := EndTime + 3600;
  412.       If ((EndTime - StartTime) >= TimeOut) then
  413.         Begin
  414.         ScreenBlanked := True;
  415.         Port[CrtModePort[DisplayAdapter]] := CrtModeByte and $F7;
  416.         End;
  417.        End;
  418.   If ScreenBlanked then
  419.     Begin
  420.     ScreenBlanked := False;
  421.     Port[CrtModePort[DisplayAdapter]] := CrtModeByte or $08;
  422.     While KeyPressed do
  423.       Ch := ReadKey;
  424.     End;
  425. Until KeyPressed and not ScreenBlanked;
  426. End; {ScreenSaver}
  427.  
  428. Procedure GetShiftStatus;
  429. Var
  430.   Regs       : Registers;
  431.   StatusByte : Byte;
  432. Begin
  433. RightShift := False;
  434. LeftShift  := False;
  435. AltKey     := False;
  436. CtrlKey    := False;
  437. Regs.AH    := 2;
  438. Intr($16,Regs);
  439. StatusByte := Regs.AL;
  440. If ((StatusByte and $08) = 8) then
  441.   AltKey     := True;
  442. If ((StatusByte and $04) = 4) then
  443.   CtrlKey    := True;
  444. If ((StatusByte and $02) = 2) then
  445.   LeftShift  := True;
  446. If ((StatusByte and $01) = 1) then
  447.   RightShift := True;
  448. End; {GetShiftStatus}
  449.  
  450. Function EnterChar;
  451.  
  452. Var
  453.   Ch    : Char;
  454.   Order : Byte;
  455.   Done  : Boolean;
  456.  
  457. Begin
  458. Done      := False;
  459. EnterChar := 0;
  460. Repeat
  461.   ScreenSaver(MG_TimeOut);
  462.   Ch    := ReadKey;
  463.   GetShiftStatus;
  464.   Order := Ord(Ch);
  465.   If (Ch = #00) then
  466.     Begin
  467.     Order := Ord(ReadKey);
  468.     If (Order in Exits) then
  469.       Begin
  470.       EnterChar := Order;
  471.       Done      := True;
  472.       End;
  473.     End
  474.   Else
  475.     If (Order in Exits) then
  476.       Begin
  477.       EnterChar := Order;
  478.       Done      := True;
  479.       End
  480.     Else
  481.       If (Ch in GoodChars) then
  482.         Begin
  483.         Value := Ch;
  484.         Done  := True;
  485.         End;
  486. Until Done;
  487. End; {EnterChar}
  488.  
  489. Function EnterData;
  490.  
  491. Const
  492.   BytIntEdits : MG_Edits = ['0'..'9','+','-',' '];        {Pre-defined edit types}
  493.   RealEdits   : MG_Edits = ['0'..'9','+','-','.','E',' '];
  494.   StrEditsAll : MG_Edits = [' '..'}'];
  495.   Alpha       : MG_Edits = ['A'..'Z','a'..'z',' '];
  496.   UpperCase   : MG_Edits = ['A'..'Z',' '];
  497.   LowerCase   : MG_Edits = ['a'..'z',' '];
  498.   Numeric     : MG_Edits = ['0'..'9'];
  499.   Anything    : MG_Edits = [#32..#254];
  500.   Date        : MG_Edits = ['0'..'9','/'];
  501.   ClickOn     : Boolean = False;
  502.   InsertOn    : Boolean = False;
  503.  
  504. Var
  505.   BytVar     : Byte     absolute Variable;
  506.   IntVar     : Integer  absolute Variable;
  507.   RealVar    : Real     absolute Variable;
  508.   StrgVar    : MG_Str80 absolute Variable;
  509.   WorkStr    : MG_Str80;
  510.   OrigStr    : MG_Str80;
  511.   ValidChars : MG_Edits;
  512.   Done       : Boolean;
  513.   Converted  : Boolean;
  514.   CtrlEmm    : Boolean;
  515.   CharIn     : Char;
  516.   Position   : Byte;
  517.  
  518. Procedure Beep;
  519. Begin
  520. Sound(800);
  521. Delay(50);
  522. Nosound;
  523. End; {Beep}
  524.  
  525. Procedure MakeClickNoise;
  526. Begin
  527. Sound(2000);
  528. Delay(5);
  529. NoSound;
  530. End; {ClickNoise}
  531.  
  532. Procedure RefreshDisplay;
  533. Var
  534.   TempStr   : MG_Str80;
  535.   WrkLen,I  : Integer;
  536.   Tail      : Char;
  537.  
  538. Begin
  539. TempStr := WorkStr;
  540. Tail := #95;
  541. If Done then
  542.   Tail := #32;
  543. For I := Length(WorkStr) + 1 to Len do
  544.   TempStr := Concat(TempStr,Tail);
  545. Rite (TempStr,XLoc,YLoc,FieldAttr);
  546. If not Converted then
  547.   CharOut(((YLoc-1)*160+(XLoc+Position-2)*2),Ord(TempStr[Position]),CursorAttr);
  548. End; {RefreshDisplay}
  549.  
  550. Procedure QueryExits;
  551. Var
  552.   StatusByte : Byte;
  553. Begin
  554. If CharIn = #13 then                { CR always exits }
  555.   Begin
  556.   Done      := True;
  557.   EnterData := 13;
  558.   With MG_Registers do
  559.     Begin
  560.     AX := 2 shl 8;
  561.     Intr($16,MG_Registers);
  562.     StatusByte := Lo(AX);
  563.     If (StatusByte and $04 > 0) then
  564.       Begin
  565.       EnterData := -13;
  566.       CtrlEmm   := True;
  567.       End;
  568.     End
  569.   End
  570. Else
  571.   If (Ord(CharIn) in Exits) then
  572.     Begin
  573.     Done      := True;
  574.     EnterData := Ord(CharIn);
  575.     End
  576.   Else
  577.     Begin
  578.     Beep;
  579.     CharIn := #255;
  580.     End;
  581. End;
  582.  
  583. Procedure CursorRight;
  584. Var
  585.   NewPos : Byte;
  586. Begin
  587. If ((Position = Len) and (Length(WorkStr) = Len)) then
  588.   Begin
  589.   Beep;
  590.   Exit;
  591.   End;
  592. NewPos := Position + 1;
  593. If NewPos <= (Length(WorkStr)+1) then
  594.   Position := NewPos
  595. Else
  596.   Beep;
  597. End; {CursorRight}
  598.  
  599. Procedure CursorLeft;
  600. Var
  601.   NewPos : Byte;
  602. Begin
  603. NewPos := Position - 1;
  604. If NewPos >= 1 then
  605.   Position := NewPos
  606. Else
  607.   Beep;
  608. End; {CursorLeft}
  609.  
  610. Procedure JumpRightWord;
  611. Var
  612.   I,WrkLen : Integer;
  613. Begin
  614. WrkLen := Length(WorkStr);
  615. If (not (VarTyp in ['B','I','R'])) then
  616.   If (Position < WrkLen) then
  617.     Begin
  618.     I := Position;
  619.     If (WorkStr[I] <> ' ') then
  620.       While ((I < WrkLen) and (WorkStr[I] <> ' ')) do
  621.         I := I + 1;
  622.     While ((I < WrkLen) and (WorkStr[I] = ' ')) do
  623.       I := I + 1;
  624.     Position := I;
  625.     End
  626.   Else
  627.     Beep
  628. Else
  629.   Beep;
  630. End; {JumpRightWord}
  631.  
  632. Procedure JumpLeftWord;
  633. Var
  634.   I,WrkLen : Integer;
  635. Begin
  636. If (not (VarTyp in ['B','I','R'])) then
  637.   If (Position > 1) then
  638.     Begin
  639.     I := Position - 1;
  640.     If (WorkStr[I] = ' ') then
  641.       While ((I > 1) and (WorkStr[I] = ' ')) do
  642.         I := I -1;
  643.     While (I > 1) and (WorkStr[I] <> ' ') do
  644.       I := I - 1;
  645.     Position := I;
  646.     If (I > 1) then
  647.       Position := I + 1;
  648.     End
  649. Else
  650.   Beep;
  651. End; {JumpLeftWord}
  652.  
  653. Procedure JumpRightField;
  654. Begin
  655. If Length(WorkStr) = Len then
  656.   If Position = Len then
  657.     Beep
  658.   Else
  659.     Position := Len
  660. Else
  661.   If Position = Length(WorkStr) + 1 then
  662.     Beep
  663.   Else
  664.     Position := Length(WorkStr) + 1;
  665. End;
  666.  
  667. Procedure RightJustify;
  668. Var
  669.   StatusByte : Byte;
  670. Begin
  671. With MG_Registers do
  672.   Begin
  673.   AX := 2 shl 8;
  674.   Intr($16,MG_Registers);
  675.   StatusByte := Lo(AX);
  676.   If (StatusByte and $04 > 0) then
  677.     Begin
  678.     QueryExits;
  679.     Exit;
  680.     End;
  681.   End;
  682. If (VarTyp in ['B','I','R']) or (Length(WorkStr) = 0) then
  683.   Beep
  684. Else
  685.   If (Length(WorkStr) < Len) then
  686.     Begin
  687.     Position := 1;
  688.     While WorkStr[Length(WorkStr)] = ' ' do
  689.       Delete(WorkStr,Length(WorkStr),1);
  690.     While Length(WorkStr) < Len do
  691.       Begin
  692.       WorkStr  := Concat(' ',WorkStr);
  693.       Position := Position + 1;
  694.       End;
  695.     End;
  696. End; {RightJustify}
  697.  
  698. Procedure LeftJustify;
  699. Begin
  700. If (VarTyp in ['B','I','R']) or (Length(WorkStr) = 0) then
  701.   Beep
  702. Else
  703.   Begin
  704.   While WorkStr[1] = ' ' do
  705.     Delete(WorkStr,1,1);
  706.   Position := 1;
  707.   End;
  708. End; {LeftJustify}
  709.  
  710. Procedure Change2UpperCase;
  711. Var
  712.   I : Integer;
  713. Begin
  714. If not (VarTyp in ['S','A']) then
  715.   Beep
  716. Else
  717.   For I := 1 to Length(WorkStr) do
  718.     If WorkStr[I] in ['a'..'z'] then
  719.       WorkStr[I] := Chr(Ord(WorkStr[I])-32);
  720. End; {Change2UpperCase}
  721.  
  722. Procedure Change2LowerCase;
  723. Var
  724.   I : Integer;
  725. Begin
  726. If not (VarTyp in ['S','A']) then
  727.   Beep
  728. Else
  729.   For I := 1 to Length(WorkStr) do
  730.     If WorkStr[I] in ['A'..'Z'] then
  731.       WorkStr[I] := Chr(Ord(WorkStr[I])+32);
  732. End; {Change2LowerCase}
  733.  
  734. Procedure AddACharacter;
  735. Var
  736.   NewPos : Integer;
  737. Begin
  738. If Position < Len then
  739.   NewPos := Position + 1
  740. Else
  741.   If Length(WorkStr) <> Len then
  742.     NewPos := Position
  743.   Else
  744.    Begin
  745.    Beep;
  746.    Exit;
  747.    End;
  748. If NewPos <= Len then
  749.   Begin
  750.   WorkStr  := Concat(WorkStr,CharIn);
  751.   If Position < Len then
  752.     Position := Position + 1;
  753.   If (VarTyp in ['S','A','U','L','N','D','X']) and
  754.      (Length(WorkStr) = Len)  then
  755.        Begin
  756.        Done      := True;
  757.        EnterData := 0;
  758.        End;
  759.   End;
  760. End; {AddACharacter}
  761.  
  762. Procedure ChangeACharacter;
  763. Begin
  764. WorkStr[Position] := CharIn;
  765. If (Position < Len) then
  766.   Position := Position + 1;
  767. End;
  768.  
  769. Procedure InsertACharacter;
  770. Begin
  771. If (Length(WorkStr) + 1) <= Len then
  772.   Begin
  773.   Insert(CharIn,WorkStr,Position);
  774.   Position := Position + 1;
  775.   End
  776. Else
  777.   Beep;
  778. End; {InsertACharacter}
  779.  
  780. Procedure DeleteACharacter;
  781. Begin
  782. If Length(WorkStr) > 0 then
  783.   Delete(WorkStr,Position,1)
  784. Else
  785.   Beep;
  786. End; {DeleteACharacter}
  787.  
  788. Procedure DestructiveBackspace;
  789. Begin
  790. If (Length(WorkStr) > 0)  and
  791.    (Position > 1)         then
  792.   Begin
  793.   Position := Position - 1;
  794.   Delete(WorkStr,Position,1);
  795.   End
  796. Else
  797.   Beep;
  798. End;
  799.  
  800. Function Initialized : Boolean;
  801. Begin
  802. Initialized := False;
  803. If VarTyp in ['B','I','R'] then
  804.   Begin
  805.   Case VarTyp of
  806.     'B' : Str(BytVar,WorkStr);
  807.     'I' : Str(IntVar,WorkStr);
  808.     'R' : Begin
  809.           Str(RealVar:Len:Decs,WorkStr);
  810.           While WorkStr[1] = ' ' do
  811.             Delete(WorkStr,1,1);
  812.           End;
  813.     End;
  814.   If Length(WorkStr) <= Len then
  815.     Begin
  816.     Initialized := True;
  817.     OrigStr     := WorkStr;
  818.     RefreshDisplay;
  819.     End;
  820.   End
  821. Else
  822.   If VarTyp in ['S','A','U','L','N','D','X'] then
  823.     Begin
  824.     WorkStr     := StrgVar;
  825.     Initialized := True;
  826.     OrigStr     := WorkStr;
  827.     RefreshDisplay;
  828.     End;
  829. End; {Initialized}
  830.  
  831. Procedure AssignValues;
  832. Var
  833.   RetnCode,WrkLen,TempInt  : Integer;
  834.   TempReal                 : Real;
  835.   ConvertStr               : MG_Str80;
  836.  
  837. Function Clean(NumericString:MG_Str80):MG_Str80;
  838. Begin
  839. While (Length(NumericString) > 0) and
  840.       (NumericString[1] = ' ') do
  841.   Delete(NumericString,1,1);
  842. While (Length(NumericString) > 0) and
  843.       (NumericString[Length(NumericString)] = ' ') do
  844.   Delete(NumericString,Length(NumericString),1);
  845. If (Length(NumericString) = 0) then
  846.   NumericString := ' ';
  847. Clean := NumericString;
  848. End; {Clean}
  849.  
  850. Procedure NumericFormat;
  851. Var
  852.   I,PLoc : Integer;
  853. Begin
  854. ConvertStr := Clean(ConvertStr);
  855. If (Pos('E',ConvertStr) > 0) then
  856.   Begin
  857.   While (Length(ConvertStr) < Len) do
  858.     ConvertStr := Concat(' ',ConvertStr);
  859.   WorkStr := ConvertStr;
  860.   RefreshDisplay;
  861.   Exit;
  862.   End;
  863. PLoc := Pos('.',ConvertStr);
  864. If PLoc = 0 then
  865.   I := Length(ConvertStr) + 1
  866. Else
  867.   I := PLoc;
  868. While I > 1 do
  869.   Begin
  870.   I := I - 3;
  871.   If I > 1 then
  872.     Insert(',',ConvertStr,I);
  873.   End;
  874. If Length(ConvertStr) <= Len then
  875.   Begin
  876.   While Length(ConvertStr) < Len do
  877.     ConvertStr := Concat(' ',ConvertStr);
  878.   WorkStr := ConvertStr;
  879.   RefreshDisplay;
  880.   End
  881. Else
  882.   Begin
  883.   While Length(WorkStr) < Len do
  884.     WorkStr := Concat(' ',WorkStr);
  885.   RefreshDisplay;
  886.   End;
  887. End; {NumericFormat}
  888.  
  889. Begin
  890. If ((Ord(CharIn) in Exits) or CtrlEmm) then
  891.   If (not (Ord(CharIn) in UserExitSet)) or CtrlEmm then
  892.     Begin
  893.     Converted := True;
  894.     WorkStr   := OrigStr;
  895.     RefreshDisplay;
  896.     Exit;
  897.     End;
  898. If VarTyp in ['B','I','R'] then
  899.   Begin
  900.   ConvertStr := WorkStr;
  901.   Case VarTyp of
  902.     'B' : Val(Clean(ConvertStr),TempInt,RetnCode);
  903.     'I' : Val(Clean(ConvertStr),TempInt,RetnCode);
  904.     'R' : Val(Clean(ConvertStr),TempReal,RetnCode);
  905.     End; {case}
  906.   If RetnCode = 0 then
  907.     Begin
  908.     Case VarTyp of
  909.       'B' : If (TempInt >= LowerByte) and (TempInt <= UpperByte) then
  910.               Begin
  911.               BytVar    := TempInt;
  912.               Converted := True;
  913.               End;
  914.       'I' : If (TempInt >= LowerInt) and (TempInt <= UpperInt) then
  915.               Begin
  916.               IntVar    := TempInt;
  917.               Converted := True;
  918.               End;
  919.       'R' : If (TempReal >= LowerReal) and (TempReal <= UpperReal) then
  920.               Begin
  921.               RealVar   := TempReal;
  922.               Converted := True;
  923.               End;
  924.       End; {case}
  925.     If Converted then
  926.       NumericFormat
  927.     Else
  928.       Begin
  929.       Done     := False;
  930.       Position := 1;
  931.       RefreshDisplay;
  932.       Beep;
  933.       End;
  934.     End
  935.   Else
  936.     Begin
  937.     Done     := False;
  938.     Position := RetnCode;
  939.     RefreshDisplay;
  940.     Beep;
  941.     End;
  942.   End
  943. Else
  944.   Begin
  945.   StrgVar   := WorkStr;
  946.   Converted := True;
  947.   RefreshDisplay;
  948.   End;
  949. End; {AssignValues}
  950.  
  951. Begin
  952. Done      := False;
  953. Converted := False;
  954. CtrlEmm   := False;
  955. Position  := 1;
  956. Case VarTyp of
  957.   'B','I'
  958.       : ValidChars := BytIntEdits;
  959.   'R' : ValidChars := RealEdits;
  960.   'S' : ValidChars := StrEditsAll;
  961.   'A' : ValidChars := Alpha;
  962.   'U' : ValidChars := UpperCase;
  963.   'L' : ValidChars := LowerCase;
  964.   'N' : ValidChars := Numeric;
  965.   'D' : ValidChars := Date;
  966.   'X' : ValidChars := Anything;
  967.   'M' : Begin
  968.         ValidChars := UserEditSet;
  969.         VarTyp     := 'X';
  970.         End;
  971. Else
  972.   Begin
  973.   EnterData := -1;
  974.   Exit;
  975.   End;
  976. End; {case}
  977. With MG_LastOpened do
  978.   Begin
  979.   XLoc := XLoc + X1;
  980.   YLoc := YLoc + Y1;
  981.   End;
  982. If not Initialized then
  983.   Begin
  984.   EnterData := -1;
  985.   Exit;
  986.   End;
  987. Repeat  {Data Conversion Loop}
  988.   Repeat  {Data Entry Loop}
  989.     ScreenSaver(MG_TimeOut);
  990.     CharIn := ReadKey;
  991.     GetShiftStatus;
  992.     If ClickOn then
  993.       MakeClickNoise;
  994.     If (CharIn = #00) then
  995.       Begin
  996.       CharIn := ReadKey;{ If you are processing an extended scan code, then }
  997.       Case CharIn of          { translate is as a commands }
  998.         #77 : CharIn := ^D;      { Unshft RArr }
  999.         #75 : CharIn := ^S;      { Unshft LArr }
  1000.         #116: CharIn := ^F;      { Ctrl'd RArr }
  1001.         #115: CharIn := ^A;      { Ctrl'd LArr }
  1002.         #82,#165
  1003.             : CharIn := ^V;      { Ins : Unshft, Ctrl'd }
  1004.         #83,#166
  1005.             : CharIn := ^G;      { Del : Unshft, Ctrl'd }
  1006.         #71 : Begin
  1007.               If Position = 1 then
  1008.                 Beep
  1009.               Else
  1010.                 Position := 1;
  1011.               CharIn := #255;
  1012.               End;
  1013.         #79 : Begin              { UnShft End }
  1014.               JumpRightField;
  1015.               CharIn := #255;
  1016.               End;
  1017.         #15 : Begin
  1018.               LeftJustify;
  1019.               CharIn := #255;
  1020.               End;
  1021.                               { or process it as an exit - delete unused exits }
  1022.         #59..#68,  #84..#93,
  1023.         #94..#103, #104..#113    { All function keys }
  1024.             : QueryExits;
  1025.         #119,                    { Ctrl'd Home }
  1026.         #117,                    { End  : Ctrl'd }
  1027.         #73,#132,                { PgUp : Unshft, Ctrl'd }
  1028.         #81,#118                 { PgDn : Unshft, Ctrl'd }
  1029.             : QueryExits;
  1030.         #72,#80                  { UArr, DArr : Unshft }
  1031.             : QueryExits;
  1032.         #3,#114,                 { Ctrl'd 2, Ctrl'd * }
  1033.         #120..#131               { Alt'd 1..9,0,-,= }
  1034.             : QueryExits;
  1035.         #30,#48,#46,#32,#18,#33,#34,#35,#23,#36,#37,#38,#50,
  1036.         #49,#24,#25,#16,#19,#31,#20,#22,#47,#17,#45,#21,#44
  1037.             : QueryExits;        { Alt'd alphabetica, A..Z }
  1038.       Else                    { or declare it to be invalid. }
  1039.               CharIn := #00;
  1040.         End; {case}
  1041.       End;
  1042.  
  1043.     If CharIn in [#27,#13,#10] then  { other exits }
  1044.       QueryExits;
  1045.  
  1046.     If not Done then      { If an exit has not been entered, }
  1047.       Begin
  1048.       Case VarTyp of
  1049.         'U' : If CharIn in ['a'..'z'] then
  1050.                 CharIn := Chr(Ord(CharIn)-32);
  1051.         'L' : If CharIn in ['A'..'Z'] then
  1052.                 CharIn := Chr(Ord(CharIn)+32);
  1053.         End;
  1054.       Case CharIn of                { Process CharIn as a command  }
  1055.         ^D : CursorRight;
  1056.         ^S : CursorLeft;
  1057.         ^A : JumpLeftWord;
  1058.         ^F : JumpRightWord;
  1059.        #09 : RightJustify;          { Tab = #15 = ^I }
  1060.         ^G : DeleteACharacter;
  1061.         ^H,#127
  1062.            : DestructiveBackspace;
  1063.         ^B : ClickOn  := not ClickOn;
  1064.         ^U : Change2UpperCase;
  1065.         ^L : Change2LowerCase;
  1066.         ^V : InsertOn := not InsertOn;
  1067.         ^E : WorkStr  := Copy(WorkStr,1,(Position-1));
  1068.         ^X : Begin
  1069.              WorkStr  := '';
  1070.              Position := 1;
  1071.              End;
  1072.         ^C,^K,^N,^O,^P,^Q,^R,^T,^W,^Y,^Z
  1073.            : QueryExits;
  1074.       Else                    { or as a normal character. }
  1075.         If (not (CharIn in ValidChars)) then
  1076.           If (CharIn <> #255) then
  1077.             Beep
  1078.           Else
  1079.         Else
  1080.           If InsertOn then
  1081.             If Position <= Length(WorkStr) then
  1082.               InsertACharacter
  1083.             Else
  1084.               AddACharacter
  1085.           Else
  1086.             If Position <= Length(WorkStr) then
  1087.               ChangeACharacter
  1088.             Else
  1089.               AddACharacter;
  1090.       End; {case}
  1091.     RefreshDisplay;
  1092.     End;
  1093.   Until Done;
  1094. AssignValues;
  1095. Until Converted;
  1096. End; {EnterData}
  1097.  
  1098. {*******************************************************************}
  1099.  
  1100.  
  1101. Function Menu;
  1102. Var
  1103.   XLoc,YLoc,Block,Width : Integer;
  1104.                      Ch : Char;
  1105.  
  1106. Procedure WriteSelections(XLoc,YLoc:Byte);
  1107. Var
  1108.   InitialAttr : Byte;
  1109.   I : Integer;
  1110. Begin
  1111. For I := 1 to Selections do
  1112.   Begin
  1113.   InitialAttr := NormAttr;
  1114.   If I = 1 then
  1115.     InitialAttr := ReverseAttr;
  1116.   Rite(Copy(S,1,(Pos('\',S)-1)),XLoc,(YLoc+I-1),InitialAttr);
  1117.   Delete(S,1,Pos('\',S));
  1118.   End;
  1119. End; {WriteSelections}
  1120.  
  1121. Procedure ReverseBG(X,Y:Byte;Attr:Integer);
  1122. Var
  1123.   Loc,I : Integer;
  1124. Begin
  1125. Attr := Attr shl 8;
  1126. For I := 1 to Width do
  1127.   Begin
  1128.   Loc := (Y-1)*160+(X+I-2)*2;
  1129.   MemW[Seg(MG_PhysicalScreen^):Loc] := Attr or Lo(MemW[Seg(MG_PhysicalScreen^):Loc]);
  1130.   End;
  1131. End; {ReverseBG}
  1132.  
  1133. Procedure MakeSelections;
  1134. Begin
  1135. Block := 1;
  1136. Repeat
  1137.   ScreenSaver(MG_TimeOut);
  1138.   Ch := ReadKey;
  1139.   GetShiftStatus;
  1140.   If KeyPressed then
  1141.     Begin
  1142.     Ch := ReadKey;
  1143.     If (Ord(Ch) = 72) and (Block > 1) then
  1144.       Begin                                      { 72 : Unshft Up Arrow }
  1145.       ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
  1146.       Block := Block - 1;
  1147.       ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
  1148.       End
  1149.     Else
  1150.       If (Ord(Ch) = 80) and (Block < (Selections)) then
  1151.         Begin                                    { 80 : Unshft Down Arrow }
  1152.         ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
  1153.         Block := Block + 1;
  1154.         ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
  1155.         End;
  1156.     End;
  1157. Until (Ord(Ch) in [13,27]) or (Ord(Ch) in Exits);
  1158. If Ord(Ch) = 27 then
  1159.   Menu := 0
  1160. Else
  1161.   If Ord(Ch) in Exits then
  1162.     Menu := Ord(Ch)
  1163.   Else
  1164.     Menu := Block;
  1165. End; {MakeSelections}
  1166.  
  1167. Begin
  1168. OpenWindow(Window);
  1169. With MG_LastOpened do
  1170.   Begin
  1171.   XLoc  := X1 + 1;
  1172.   YLoc  := Y1 + 1;
  1173.   Width := X2 - X1 -1;
  1174.   End;
  1175. If not MG_RiteFlag[Window] then
  1176.   WriteSelections(XLoc,YLoc);
  1177. MakeSelections;
  1178. CloseWindow;
  1179. End; {Menu}
  1180.  
  1181. Var
  1182.   Init_I : Integer;
  1183.  
  1184. Begin
  1185. MG_ScreenLLBase := Nil;
  1186. UserEditSet     := [];
  1187. UserExitSet     := [];
  1188. For Init_I := 1 to ScreenCount do
  1189.   MG_RiteFlag[Init_I] := False;
  1190. MaxLimits;
  1191. Intr($11,MG_Registers);
  1192. If (Lo(MG_Registers.AX) and $30 = $30) then
  1193.   Begin
  1194.   MG_PhysicalScreen    := Ptr($B000,$0000);
  1195.   MG_ScreenType        := 'M';
  1196.   End
  1197. Else
  1198.   Begin
  1199.   MG_PhysicalScreen    := Ptr($B800,$0000);
  1200.   MG_ScreenType        := 'C';
  1201.   End;
  1202. End. {MGProg}