home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / m / msh_ut11.zip / MINIWIND.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-09  |  17KB  |  607 lines

  1. UNIT MiniWindow;
  2. {-----------------------------------------------------}
  3. { Jens Pirnay <pirnay@rphs1.physik.uni-regensburg.de> }
  4. { This file is subject to the copyleft-regulations    }
  5. { of the Free Software Foundation (the guys from GNU) }
  6. {-----------------------------------------------------}
  7. {$R-,S-,V-}
  8. {
  9.   Quick'n Dirty - Alert - Boxes, of course
  10.   one could improve a lot, so just do it
  11. }
  12.  
  13. INTERFACE
  14.  
  15. USES crt, dos;
  16.  
  17. FUNCTION Alert ( MessageStr  : STRING;
  18.                  QuestionStr : STRING ) : BYTE;
  19. { Display a window on the screen and offer several possibilities }
  20.  
  21. PROCEDURE StartInfo  (InfoTxt1, InfoTxt2 : STRING);
  22. PROCEDURE UpdateInfo (nr : BYTE; InfoTxt : STRING;
  23.                       current, maximum : LONGINT);
  24. PROCEDURE EndInfo;
  25.  
  26. PROCEDURE InputStr (Msg : STRING; BlanksOK : BOOLEAN; VAR inp : STRING);
  27.  
  28. IMPLEMENTATION
  29.  
  30. CONST FrameF = Yellow;       FrameB = Red;
  31.       TextF  = White;        TextB  = Red;
  32.       HiF    = Black;        HiB    = LightGray;
  33.       FInfoF = Black;        FInfoB = White;
  34.       TInfoF = Blue;         TInfoB = White;
  35.       IInfoF = Yellow;       IInfoB = Blue;
  36.  
  37.       { Replace with your own color customization }
  38.  
  39. TYPE Buffer = ARRAY [0..$8000] OF BYTE;
  40.  
  41. VAR ScreenPtr      : POINTER;
  42.     VideoWidth,
  43.     VideoDepth     : BYTE;
  44.  
  45. PROCEDURE SaveArea (X1, Y1, X2, Y2 : BYTE; VAR AreaPtr : POINTER);
  46. VAR
  47.    I, J         : BYTE;
  48.    Wid          : WORD;
  49.    ScreenAdr    : INTEGER;
  50.    BufAdr       : INTEGER;
  51.    SSEG, SOfs   : WORD;
  52.    Pntr         : ^Buffer;
  53.    MemNeeded    : LONGINT;
  54. BEGIN
  55.    MemNeeded := SUCC (X2 - X1) * SUCC (Y2 - Y1) * 2;
  56.    GETMEM (AreaPtr, MemNeeded);
  57.    Pntr := AreaPtr;
  58.    SSEG := SEG (ScreenPtr^);
  59.    SOfs := OFS (ScreenPtr^);
  60.    Wid  := VideoWidth * 2;
  61.    BufAdr := 0;
  62.    FOR I := Y1 TO Y2 DO
  63.    BEGIN
  64.      ScreenAdr := PRED (I) * Wid + PRED (X1) * 2; { first char }
  65.      FOR J := X1 TO X2 DO
  66.      BEGIN
  67.        Pntr^ [BufAdr  ] := Mem [SSEG : SOfs + ScreenAdr];
  68.        Pntr^ [BufAdr + 1] := Mem [SSEG : SOfs + ScreenAdr + 1];
  69.        INC (BufAdr, 2);
  70.        INC (ScreenAdr, 2);
  71.      END;
  72.    END;
  73. END;
  74.  
  75. PROCEDURE RestoreArea (X1, Y1, X2, Y2 : BYTE; VAR AreaPtr : POINTER);
  76. {}
  77. VAR
  78.    I, J, w    : BYTE;
  79.    SSEG, SOfs,
  80.    Wid        : WORD;
  81.    ScreenAdr  : INTEGER;
  82.    BufAdr     : INTEGER;
  83.    Pntr       : ^Buffer;
  84.    MemNeeded  : LONGINT;
  85. BEGIN
  86.    MemNeeded := SUCC (X2 - X1) * SUCC (Y2 - Y1) * 2;
  87.    Pntr   := AreaPtr;
  88.    Wid    := VideoWidth * 2;
  89.    BufAdr := 0;
  90.    SSEG   := SEG (ScreenPtr^);
  91.    SOfs   := OFS (ScreenPtr^);
  92.    FOR I := Y1 TO Y2 DO
  93.    BEGIN
  94.      ScreenAdr := PRED (I) * Wid + PRED (X1) * 2; { first char }
  95.      FOR J := X1 TO X2 DO
  96.      BEGIN
  97.        Mem [SSEG : SOfs + ScreenAdr    ] := Pntr^ [BufAdr];
  98.        Mem [SSEG : SOfs + ScreenAdr + 1] := Pntr^ [BufAdr + 1];
  99.        INC (BufAdr, 2);
  100.        INC (ScreenAdr, 2);
  101.      END;
  102.    END;
  103.    FREEMEM (AreaPtr, MemNeeded);
  104. END;
  105.  
  106. PROCEDURE CheckVideo;
  107. VAR Regs       : REGISTERS;
  108.     ScreenBase : WORD;
  109. BEGIN
  110.    WITH Regs DO
  111.    BEGIN
  112.       Ax := $0F00;
  113.       INTR ($10, Regs);  {get video display mode}
  114.       IF Al = 7 THEN
  115.         ScreenBase := $B000  {Mono}
  116.        ELSE
  117.         ScreenBase := $B800; {Color}
  118.    END;
  119.  
  120.    VideoWidth := SUCC (LO (WindMax) );
  121.    VideoDepth := SUCC (HI (WindMax) );
  122.  
  123.    ScreenPtr :=  PTR (ScreenBase, 0);
  124.  
  125.    { At last let's look for DesqView }
  126.    WITH Regs DO
  127.    BEGIN
  128.       AX := $2B01;
  129.       CX := $4445;
  130.       DX := $5351;
  131.       INTR ($21, Regs);
  132.       IF Al <> $FF THEN {DesqView present}
  133.       BEGIN
  134.          Ah := $FE;
  135.          INTR ($10, Regs);
  136.          ScreenPtr := PTR (ES, DI);
  137.       END;
  138.    END;
  139. END;
  140.  
  141. PROCEDURE DoFrame (X1, Y1, X2, Y2 : BYTE; FF, FB : BYTE);
  142. CONST Frame : STRING [6] = { '┌┐└┘─│' } { for single top, single side }
  143.                            {}'╒╕╘╛═│'{} { for double top, single side }
  144.                            { '╔╗╚╝═║' } { for double top, double side }
  145.                            { '╓╖╙╜─║' } { for single top, double side }
  146.                            ;
  147. VAR i : BYTE; regs : REGISTERS;
  148. BEGIN
  149.   { Frame }
  150.   i := ioresult;
  151.   TEXTCOLOR (FF); TEXTBACKGROUND (FB);
  152.   CLRSCR;
  153.   WRITE (Frame [1]);
  154.   FOR i := X1 + 1 TO X2 - 1 DO
  155.   BEGIN
  156.     WRITE (Frame [5]);
  157.   END;
  158.   WRITE (Frame [2]);
  159.   FOR i := Y1 + 1 TO Y2 - 1 DO
  160.   BEGIN
  161.     GOTOXY (1, i - Y1 + 1);          WRITE (Frame [6]); { left }
  162.     GOTOXY (X2 - X1 + 1, i - Y1 + 1); WRITE (Frame [6]); { right }
  163.   END;
  164.   GOTOXY (1, Y2 - Y1 + 1);
  165.   WRITE (Frame [3]);
  166.   FOR i := X1 + 1 TO X2 - 1 DO
  167.   BEGIN
  168.     WRITE (Frame [5]);
  169.   END;
  170.   WITH regs DO BEGIN
  171.     ah := 9; al := ORD (Frame [4]);
  172.     bh := 0; bl := $8 * FB + FF;
  173. (*    bh := 0; bl := $10 * FB + FF; *)
  174.     cx := 1; INTR ($10, regs);
  175.   END;
  176. END;
  177.  
  178. VAR InfoArea           : POINTER;
  179.     IX1, IX2, IY1, IY2 : BYTE;
  180.     ILastMin, ILastMax : WORD;
  181.     ioldCursX, ioldCursY : BYTE;
  182.     LastText           : ARRAY [1..2] OF STRING [40];
  183. CONST InfoSize = 25;
  184.  
  185. PROCEDURE UpdateInfo (nr : BYTE; InfoTxt : STRING;
  186.                       current, maximum : LONGINT);
  187. VAR rel : LONGINT;  i : BYTE;
  188. BEGIN
  189.   i := ioresult;
  190.   rel := InfoSize;
  191.   IF maximum = 0 THEN
  192.     rel := 0
  193.    ELSE
  194.     rel := (current * rel) DIV maximum;
  195.   IF InfoTxt <> LastText [nr] THEN
  196.   BEGIN
  197.     GOTOXY (3, nr * 3);
  198.     TEXTCOLOR (TInfoF); TEXTBACKGROUND (TInfoB);
  199.     WRITE (InfoTxt);
  200.     FOR i := LENGTH (InfoTxt) TO LENGTH (LastText [nr]) DO
  201.       WRITE (' ');
  202.     LastText [nr] := InfoTxt;
  203.   END;
  204.   GOTOXY (3, nr * 3 + 1);
  205.   TEXTCOLOR (IInfoF); TEXTBACKGROUND (IInfoB);
  206.   FOR i := 1 TO rel DO
  207.     WRITE ('█');
  208.   FOR i := rel + 1 TO InfoSize DO
  209.     WRITE ('░');
  210. (*
  211.   REPEAT UNTIL KeyPressed; WHILE KeyPressed DO if ReadKey=#27 THEN ;
  212. *)
  213. END;
  214.  
  215. PROCEDURE StartInfo  (InfoTxt1, InfoTxt2 : STRING);
  216. BEGIN
  217.   iLastMin := WindMin;
  218.   iLastMax := WindMax;
  219.   ioldCursX := WHEREX;
  220.   ioldCursY := WHEREY;
  221.   IX2 := InfoSize;
  222.   IY2 := 5;
  223.   IX1 := VideoWidth DIV 2 - ( IX2 + 4 ) DIV 2;
  224.   IX2 := VideoWidth DIV 2 + ( IX2 + 4 ) DIV 2;
  225.   iY1 := VideoDepth DIV 2 - ( IY2 + 4 ) DIV 2;
  226.   IY2 := VideoDepth DIV 2 + ( IY2 + 4 ) DIV 2;
  227.   SaveArea (IX1, IY1, IX2, IY2, InfoArea);
  228.   WINDOW   (IX1, IY1, IX2, IY2);
  229.   DoFrame  (IX1, IY1, IX2, IY2, FInfoF, FInfoB);
  230.   LastText [1] := '';
  231.   LastText [2] := '';
  232.   UpdateInfo (1, InfoTxt1, 0, 100);
  233.   UpdateInfo (2, InfoTxt2, 0, 100);
  234. END;
  235.  
  236. PROCEDURE EndInfo;
  237. BEGIN
  238.   NORMVIDEO;
  239.   WINDOW (SUCC (LO (ILastMin) ), SUCC (HI (ILastMin) ),
  240.           SUCC (LO (ILastMax) ), SUCC (HI (ILastMax) ) );
  241.   RestoreArea (IX1, IY1, IX2, IY2, InfoArea);
  242.   GOTOXY (ioldCursX, ioldCursY);
  243. END;
  244.  
  245. FUNCTION Alert ( MessageStr  : STRING;
  246.                  QuestionStr : STRING ) : BYTE;
  247.  
  248. VAR Res            : BYTE;
  249.     X1, Y1, X2, Y2 : BYTE;
  250.     AreaPtr        : POINTER;
  251.     LastMin,
  252.     LastMax        : WORD;
  253.     oldCursX,
  254.     oldCursY       : BYTE;
  255.  
  256. PROCEDURE ComputeArea (Msg, Ques : STRING; VAR cols, rows : BYTE);
  257. VAR i, j : BYTE;
  258. BEGIN
  259.   j    := 0;
  260.   rows := 1;
  261.   cols := 0;
  262.   FOR i := 1 TO LENGTH (Msg) DO
  263.   BEGIN
  264.     IF Msg [i] = '|' THEN
  265.     BEGIN
  266.       IF j > cols THEN cols := j;
  267.       j := 0;
  268.       INC (rows);
  269.     END
  270.     ELSE
  271.       INC (j);
  272.   END;
  273.   IF j > cols THEN cols := j;
  274.   j := 0;
  275.   FOR i := 1 TO LENGTH (Ques) DO
  276.     IF Ques [i] = '|' THEN j := j + 1;
  277.  
  278.   IF cols < LENGTH (Ques) + 2 * j THEN cols := LENGTH (Ques) + 2 * j;
  279. END;
  280.  
  281. PROCEDURE WriteIt (MessageStr : STRING; X1, Y1, X2, Y2 : BYTE);
  282. VAR i, j : BYTE;
  283.     regs : REGISTERS;
  284.     Sub  : STRING [80];
  285. BEGIN
  286.   Sub := '';
  287.   j   := 2;
  288.   FOR i := 1 TO LENGTH (MessageStr) DO
  289.   BEGIN
  290.     IF MessageStr [i] = '|' THEN
  291.     BEGIN
  292.       IF Sub <> '' THEN
  293.       BEGIN
  294.         GOTOXY ( (X2 - X1) DIV 2 - LENGTH (Sub) DIV 2 + 1, j); WRITE (sub);
  295.       END;
  296.       Sub := '';
  297.       INC (j);
  298.     END
  299.     ELSE
  300.       Sub := Sub + MessageStr [i];
  301.   END;
  302.   IF Sub <> '' THEN
  303.   BEGIN
  304.     GOTOXY ( (X2 - X1) DIV 2 - LENGTH (Sub) DIV 2 + 1, j); WRITE (sub);
  305.   END;
  306. END;
  307.  
  308. FUNCTION ProcessIt (QuestionStr : STRING; X1, Y1, X2, Y2 : BYTE) : BYTE;
  309. VAR ch    : CHAR;
  310.     i, j, k, len,
  311.     cur, num,
  312.     Res   : BYTE;
  313.     redraw,
  314.     ready : BOOLEAN;
  315.     Sub   : STRING [80];
  316. BEGIN
  317.   Res    := 255; { Special code for escape }
  318.   cur    := 1;
  319.   num    := 1;
  320.   FOR i := 1 TO LENGTH (QuestionStr) DO
  321.     IF QuestionStr [i] = '|' THEN
  322.       INC (num);
  323.   len := (LENGTH (QuestionStr) - num + 1) DIV num; { average len }
  324.   redraw := TRUE;
  325.   REPEAT
  326.     IF redraw THEN
  327.     BEGIN
  328.       IF num > X2 - X1 - LENGTH (QuestionStr) THEN
  329.         j   := 2
  330.        ELSE
  331.         j   := (X2 - X1 - LENGTH (QuestionStr) - num) DIV 2;
  332.       k   := 1;
  333.       Sub := '';
  334.       FOR i := 1 TO LENGTH (QuestionStr) DO
  335.       BEGIN
  336.         IF QuestionStr [i] = '|' THEN
  337.         BEGIN
  338.           IF Sub <> '' THEN
  339.           BEGIN
  340.             GOTOXY (j, (Y2 - Y1) );
  341.             IF k = cur THEN
  342.             BEGIN
  343.               TEXTCOLOR (HiF); TEXTBACKGROUND (HiB);
  344.             END
  345.             ELSE
  346.             BEGIN
  347.               TEXTCOLOR (TextF); TEXTBACKGROUND (TextB);
  348.             END;
  349.             WRITE (Sub);
  350.             j := j + LENGTH (Sub) + 3;
  351.             Sub := '';
  352.             INC (k);
  353.           END;
  354.         END
  355.         ELSE
  356.           Sub := Sub + QuestionStr [i];
  357.       END;
  358.       IF Sub <> '' THEN
  359.       BEGIN
  360.         GOTOXY (j, (Y2 - Y1) );
  361.         IF k = cur THEN
  362.         BEGIN
  363.           TEXTCOLOR (HiF); TEXTBACKGROUND (HiB);
  364.         END
  365.         ELSE
  366.         BEGIN
  367.           TEXTCOLOR (TextF); TEXTBACKGROUND (TextB);
  368.         END;
  369.         WRITE (Sub);
  370.       END;
  371.       redraw := FALSE;
  372.     END;
  373.     ready := FALSE;
  374.     ch := READKEY;
  375.     CASE ch OF
  376.       #0  : BEGIN
  377.               IF KEYPRESSED THEN
  378.               BEGIN
  379.                 ch := READKEY;
  380.                 IF ch = #75 THEN { Left }
  381.                 BEGIN
  382.                   DEC (cur); IF cur = 0 THEN cur := num;
  383.                   redraw := TRUE;
  384.                 END;
  385.                 IF ch = #77 THEN { Right }
  386.                 BEGIN
  387.                   INC (cur); IF cur > num THEN cur := 1;
  388.                   redraw := TRUE;
  389.                 END;
  390.               END;
  391.             END;
  392.       #27 : ready := TRUE;
  393.       #13 : BEGIN ready := TRUE; res := cur; END;
  394.     END;
  395.   UNTIL ready;
  396.   ProcessIt := Res;
  397. END;
  398.  
  399. BEGIN
  400.   LastMin := WindMin;
  401.   LastMax := WindMax;
  402.   oldCursX := WHEREX;
  403.   oldCursY := WHEREY;
  404.   ComputeArea (MessageStr, QuestionStr, X2, Y2);  { Nr. of columns, Nr. of Lines }
  405.   X1 := VideoWidth DIV 2 - ( X2 + 4 ) DIV 2;
  406.   X2 := VideoWidth DIV 2 + ( X2 + 4 ) DIV 2;
  407.   Y1 := VideoDepth DIV 2 - ( Y2 + 4 ) DIV 2;
  408.   Y2 := VideoDepth DIV 2 + ( Y2 + 4 ) DIV 2;
  409.   SaveArea    (X1, Y1, X2, Y2, AreaPtr);
  410.   WINDOW      (X1, Y1, X2, Y2);
  411.   DoFrame (X1, Y1, X2, Y2, FrameF, FrameB);
  412.   TEXTCOLOR (TextF); TEXTBACKGROUND (TextB);
  413.   WriteIt     (MessageStr, X1, Y1, X2, Y2);
  414.   Res := ProcessIt (QuestionStr, X1, Y1, X2, Y2);
  415.   WINDOW      (SUCC (LO (LastMin) ), SUCC (HI (LastMin) ),
  416.                SUCC (LO (LastMax) ), SUCC (HI (LastMax) ) );
  417.   NORMVIDEO;
  418.   RestoreArea (X1, Y1, X2, Y2, AreaPtr);
  419.   GOTOXY (oldCursX, oldCursY);
  420.   alert := res;
  421. END;
  422.  
  423.  
  424. PROCEDURE InputStr (Msg : STRING; BlanksOK : BOOLEAN; VAR inp : STRING);
  425. VAR Res            : BYTE;
  426.     X1, Y1, X2, Y2 : BYTE;
  427.     AreaPtr        : POINTER;
  428.     LastMin,
  429.     LastMax        : WORD;
  430.     oldCursX,
  431.     oldCursY       : BYTE;
  432.     ready, refresh,
  433.     overwrite,
  434.     first          : BOOLEAN;
  435.     SPos, Len      : BYTE;
  436.     ch             : CHAR;
  437.  
  438.     PROCEDURE Cursor(small : BOOLEAN);
  439.     VAR regs : Registers;
  440.         C, T, B : BYTE;
  441.     BEGIN
  442.      WITH Regs DO              { Get CharHeight-Info }
  443.      BEGIN
  444.         Ah := $11;
  445.         Al := $30;
  446.         BX := $0;
  447.         INTR ($10, Regs);
  448.         C := CX;
  449.       END;
  450.       if small THEN
  451.       begin
  452.         t := C DIV 2;
  453.         b := PRED (C);
  454.       end
  455.       else
  456.       begin
  457.         t := 0;
  458.         b := Pred(C);
  459.       end;
  460.       WITH regs DO
  461.       BEGIN
  462.          AX := $0100;
  463.          IF (T = 0) AND (B = 0) THEN
  464.             CX := $2000
  465.          ELSE
  466.          BEGIN
  467.          (*
  468.          If you have an odd video bios and cursor changes
  469.          are strange, enable this next line.
  470.             mem[$40:$87] := mem[$40:$87] or $01; {get cursor ownership from BIOS}
  471.          *)
  472.             Ch := T;
  473.             Cl := B;
  474.          END;
  475.          INTR ($10, Regs);
  476.       END;
  477.     END;
  478.  
  479. BEGIN
  480.   LastMin := WindMin;
  481.   LastMax := WindMax;
  482.   oldCursX := WHEREX;
  483.   oldCursY := WHEREY;
  484.   X2 := 60;
  485.   X1 := VideoWidth DIV 2 - ( X2 + 4 ) DIV 2;
  486.   X2 := VideoWidth DIV 2 + ( X2 + 4 ) DIV 2;
  487.   Y1 := VideoDepth DIV 2 - 2;
  488.   Y2 := VideoDepth DIV 2 + 1;
  489.   SaveArea    (X1, Y1, X2, Y2, AreaPtr);
  490.   WINDOW      (X1, Y1, X2, Y2);
  491.   DoFrame (X1, Y1, X2, Y2, FrameF, FrameB);
  492.   TEXTCOLOR (TextF); TEXTBACKGROUND (TextB);
  493.   GOTOXY (3, 2); WRITE (Msg);
  494.   TEXTCOLOR (TInfoF); TEXTBACKGROUND (TInfoB);
  495.   GOTOXY (3, 3); WRITE (Inp);
  496.   TEXTCOLOR (FInfoF); TEXTBACKGROUND (FInfoB);
  497.   FOR Spos := 1 TO LENGTH (Inp) DO    { all should be capital }
  498.     Inp [SPos] := UPCASE (Inp [Spos]);
  499.   refresh   := FALSE;
  500.   ready     := FALSE;
  501.   first     := TRUE;
  502.   overwrite := FALSE;
  503.   Cursor(overwrite);
  504.   spos    := LENGTH (Inp) + 1;
  505.   REPEAT
  506.     IF refresh THEN
  507.     BEGIN
  508.       TEXTCOLOR (TextF); TEXTBACKGROUND (TextB);
  509.       GOTOXY (3, 3); FOR len := 1 TO 60 DO WRITE (' ');
  510.       TEXTCOLOR (FInfoF); TEXTBACKGROUND (FInfoB);
  511.       GOTOXY (3, 3); WRITE (Inp);
  512.       Refresh := FALSE;
  513.     END;
  514.     GOTOXY (2 + spos, 3);
  515.     ch := READKEY;
  516.     CASE ch OF
  517.       #0  : IF KEYPRESSED THEN
  518.             BEGIN
  519.               ch := READKEY;
  520.               IF first THEN refresh := TRUE;
  521.               first := FALSE;
  522.               CASE ch OF
  523.                #82 : { Insert }
  524.                      BEGIN
  525.                        overwrite := NOT overwrite;
  526.                        Cursor(overwrite);
  527.                      END;
  528.                #83 : { Delete }
  529.                      IF Spos <= LENGTH (inp) THEN
  530.                      BEGIN
  531.                        refresh := TRUE;
  532.                        DELETE (inp, Spos, 1);
  533.                      END;
  534.                #71 : { Home  } Spos := 1;
  535.                #75 : { Left  } IF spos > 1 THEN DEC (spos);
  536.                #77 : { Right } IF spos <= LENGTH (Inp) THEN INC (spos);
  537.                #79 : { End   } spos := LENGTH (Inp) + 1;
  538.               END;
  539.             END;
  540.       #8  : { backspace }
  541.             BEGIN
  542.               if first then refresh := TRUE;
  543.               first := FALSE;
  544.               IF (spos > 1) THEN
  545.               BEGIN
  546.                 DEC (spos);
  547.                 DELETE (Inp, spos, 1);
  548.                 refresh := TRUE;
  549.               END;
  550.             END;
  551.       #11 : { CtrlK  } BEGIN { delete to end of input }
  552.                          first   := FALSE;
  553.                          refresh := TRUE;
  554.                          IF (spos<=Length(Inp)) THEN
  555.                          BEGIN
  556.                            Inp[0] := CHR(spos-1);   { Cut string }
  557.                            spos := Length(Inp) + 1;
  558.                          END;
  559.                        END;
  560.       #13 : { Return } ready := TRUE;
  561.       #27 : { Escape } BEGIN ready := TRUE; Inp := ''; END;
  562.       #0..#31, #127 : { Non-printable }
  563.              IF first THEN
  564.              BEGIN
  565.                first := FALSE;
  566.                refresh := TRUE;
  567.              END;
  568.       ELSE
  569.             { Valid Characters }
  570.              BEGIN
  571.                ch := UPCASE (ch);
  572.                IF BlanksOK OR (ch<>' ') THEN
  573.                BEGIN
  574.                  IF first THEN
  575.                  BEGIN
  576.                    Inp  := ch;
  577.                    spos := 2;
  578.                  END
  579.                  ELSE
  580.                  BEGIN
  581.                    IF spos > LENGTH (Inp) THEN
  582.                      Inp := Inp + ch
  583.                     ELSE
  584.                      IF overwrite THEN
  585.                        Inp [spos] := ch
  586.                       ELSE
  587.                        INSERT (ch, Inp, spos);
  588.                     INC (spos);
  589.                  END;
  590.                END;
  591.                refresh := TRUE;
  592.                first   := FALSE;
  593.              END;
  594.     END;
  595.   UNTIL ready;
  596.   Cursor(true);
  597.   WINDOW      (SUCC (LO (LastMin) ), SUCC (HI (LastMin) ),
  598.                SUCC (LO (LastMax) ), SUCC (HI (LastMax) ) );
  599.   NORMVIDEO;
  600.   RestoreArea (X1, Y1, X2, Y2, AreaPtr);
  601.   GOTOXY (oldCursX, oldCursY);
  602. END;
  603.  
  604. BEGIN
  605.   CheckVideo;
  606. END.
  607.