home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / tttsrc51.zip / READTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-12  |  37KB  |  1,135 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10a                             }
  5. {                                (Europe)                                  }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  ReadTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {History:         2/24/89   5.00a  Reversed return codes in ReadLine
  18.                   3/05/89   5.00b  Added Box proc to Read_Real
  19.                             5.01a  Added DEBUG compiler directive and added
  20.                                    mouse Enter/Esc support
  21.                  01/04/93   5.10   DPMI compatible version
  22.                  05/12/93   5.10a  Enter/Esc correction
  23. }
  24.  
  25. {$S-,R-,V-}
  26. {$IFNDEF DEBUG}
  27. {$D-}
  28. {$ENDIF}       
  29.  
  30. Unit ReadTTT5;
  31.  
  32. Interface
  33.  
  34. Uses CRT,FastTTT5,WinTTT5,StrnTTT5,KeyTTT5;
  35.  
  36. Type
  37.    R_Display = record
  38.                     WhiteSpace  : char;        {used to pad input field - default ··········} 
  39.                     AllowEsc    : boolean;     {allow the he user to escape?} 
  40.                     Beep        : Boolean;     {allow the old proverbial beep} 
  41.                     Insert      : boolean;     {initially in insert mode?} 
  42.                     BegCursor   : boolean;     {place cursor at beginning of line} 
  43.                     AllowNull   : boolean;     {allow user to input a '' or null value} 
  44.                     RightJustify: Boolean;     {right justify string on termination} 
  45.                     EraseDefault: Boolean;     {clear entry of alphanumeric pressed} 
  46.                     SuppressZero: Boolean;     {have empty field is value = zero}
  47.                     FCol        : byte;        {normal foreground color of input field}
  48.                     BCol        : byte;        {normal background of input field}
  49.                     HiFCol      : byte;        {highlighted fgnd color for Read_Select}
  50.                     HiBCol      : byte;        {highlighted bgnd color for Read_Select}
  51.                     LoFCol      : byte;        {normal fgnd color for Read_Select}
  52.                     LoBCol      : byte;        {normal bgnd color for Read_Select}
  53.                     PFcol       : byte;        {prompt foreground color}
  54.                     PBCol       : byte;        {prompt background color}
  55.                     BoxFCol     : byte;        {box foreground color}
  56.                     BoxBCol     : byte;        {Box background color}
  57.                     Msg_FCol    : byte;        {Foreground color for error messages}
  58.                     Msg_BCol    : byte;        {Background color for error messages}
  59.                     Msg_Line    : byte;        {line for error messages}
  60.                     End_chars   : set of char; {end of input chars}
  61.                     RealDP      : byte;        {no of decimal places on real}
  62.                end;
  63.  
  64. const
  65.     NoPrompt:string[1] = '';
  66. Var
  67.   RTTT : R_Display;
  68.   R_Char : char;
  69.   R_Null : boolean;
  70.  
  71. Procedure Default_Settings;
  72. Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  73. Procedure Read_String(X,Y,L:byte;
  74.                       Prompt:StrScreen; 
  75.                       BoxType: byte;
  76.                       Var Txt:StrScreen);
  77. Procedure Read_String_Upper(X,Y,L:byte;
  78.                             Prompt:StrScreen;
  79.                             BoxType: byte;
  80.                             Var Txt:StrScreen);
  81. Procedure Read_Password(X,Y,L:byte;
  82.                         Prompt:StrScreen;
  83.                         BoxType: byte;
  84.                         Var Txt:StrScreen);
  85. Procedure Read_Alpha(X,Y,L:byte;
  86.                      Prompt:StrScreen;
  87.                      BoxType: byte;
  88.                      Var Txt:StrScreen);
  89. Procedure Read_YN(X,Y:byte;
  90.                   Prompt:StrScreen;
  91.                   BoxType: byte;
  92.                   Var Yes:Boolean);
  93. Procedure Read_Byte(X,Y,L:byte; 
  94.                     Prompt:StrScreen;
  95.                     BoxType: byte;
  96.                     Var B : Byte;
  97.                     Min, Max : Byte);
  98. Procedure Read_Word(X,Y,L:byte; 
  99.                     Prompt:StrScreen;
  100.                     BoxType: byte;
  101.                     Var W : word;
  102.                     Min, Max : word);
  103. Procedure Read_Int(X,Y,L:byte;
  104.                    Prompt:StrScreen;
  105.                    BoxType: byte;
  106.                    Var W : integer;
  107.                    Min, Max : integer);
  108. Procedure Read_LongInt(X,Y,L:byte;
  109.                        Prompt:StrScreen;
  110.                        BoxType: byte;
  111.                        Var W : longint;
  112.                        Min, Max : longint);
  113. Procedure Read_Real(X,Y,L:byte;
  114.                     Prompt:StrScreen;
  115.                     BoxType: byte;
  116.                     Var W : real;
  117.                     Min, Max : real);
  118. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  119. Implementation
  120.  
  121. CONST
  122.     PassChar    = #15;
  123.     CursorRight = #205;
  124.     CursorLeft  = #203;
  125.     CursorDown  = #208;
  126.     CursorUp    = #200;
  127.     EnterKey    = #13;
  128.     EscKey      = #27;
  129.     EndKey      = #207;
  130.     HomeKey     = #199;
  131.     DelKey      = #211;
  132.     Backspace   = #8;
  133.     InsKey      = #210;
  134.     Zap         = #160;      {Alt D to delete the field}
  135.     MinInt              = -32768;
  136.     MaxLongInt:longint  =  2147483647;
  137.     MinLongInt:longint  = -2147483647;
  138.     MaxWord             =  65535;
  139.     MinWord             =  0;
  140.     
  141. VAR
  142.    Cursor_X,
  143.    Cursor_Y,
  144.    ScanTop,
  145.    ScanBot   : byte;
  146.  
  147. Procedure Default_Settings;
  148. begin
  149.    with RTTT do
  150.    begin
  151.        WhiteSpace   := #250;
  152.        Beep         := true;
  153.        BegCursor    := false;
  154.        Insert       := false;
  155.        AllowEsc     := true;
  156.        AllowNull    := true;
  157.        RightJustify := false;
  158.        EraseDefault := false;
  159.        SuppressZero := true;
  160.        End_Chars := [#13,#133];  {Enter}
  161.        RealDP := 2;  
  162.        If not ColorScreen then
  163.        begin
  164.            FCol := black;
  165.            BCol := lightgray;
  166.            HiFCol := white;
  167.            HiBCol := black;
  168.            LoFCol := lightgray;
  169.            LoBCol := black;
  170.            PFCol := white;
  171.            PBCol := black;
  172.            BoxFCol := white;
  173.            BoxBCol := black;
  174.            Msg_FCol := white;
  175.            Msg_BCol := black;
  176.            Msg_Line := 0;
  177.        end
  178.        else
  179.        begin
  180.            FCol := black;
  181.            BCol := lightgray;
  182.            HiFCol := black;
  183.            HiBCol := lightgray;
  184.            LoFCol := lightgray;
  185.            LoBCol := black;
  186.            PFCol := white;
  187.            PBCol := black;
  188.            BoxFCol := white;
  189.            BoxBCol := black;
  190.            Msg_FCol := lightred;
  191.            Msg_BCol := black;
  192.            Msg_Line := 0;
  193.        end;
  194.    end;
  195. end;
  196.  
  197. Procedure Clang;
  198. begin
  199.     If RTTT.Beep then
  200.     begin
  201.         sound(500);
  202.         delay(50);
  203.         nosound;
  204.     end;
  205. end;
  206.  
  207. Procedure Read_Line(X,Y,L,F,B,Format:byte;
  208.                      var Text   :string);
  209. {
  210. X is X coord of first character in field
  211. Y is Y coord of field
  212. L is the maximum length of the input field
  213. F is the foreground color
  214. B is the background color
  215. Fornat Codes:      1   Any String
  216.                    2   Force Upper String
  217.                    3   Yes/No
  218.                    4   Alphabetics only
  219.                    5   Integer
  220.                    6   LongInteger
  221.                    7   Real
  222.                    8   Word
  223.                    (*   Maybe
  224.                    9   Date    (MM/DD/YY)
  225.                    10  Date    (DD/MM/YY)
  226.                    *)
  227.                    11  Echo a Password
  228. Text is a string updated with the string equivalent of user input
  229. }
  230. var
  231.     TempText : string;
  232.     CursorPos : byte;
  233.     InsertMode,
  234.     Password,
  235.     Alldone : boolean;
  236.     FirstCharPress: boolean;
  237.     Ch : char;
  238.  
  239.     Procedure Check_Parameters;
  240.     begin
  241.         TempText := Text;
  242.         If length(TempText) > L then
  243.            Delete(Temptext,L+1,length(TempText)-L);
  244.         If not X in [1..80] then
  245.            X := 1;
  246.         If X + L - 1 > 80 then X := 81 - L;
  247.         If not Y in [1..25] then
  248.            Y := 1;
  249.         If RTTT.BegCursor then
  250.            CursorPos := 1
  251.         else
  252.         begin
  253.             If length(TempText) < L then
  254.                CursorPos := length(TempText) + 1
  255.             else
  256.                CursorPos := length(TempText);
  257.         end;
  258.         InsertMode  := RTTT.Insert;
  259.         Alldone := False;
  260.         If Format = 11 then
  261.         begin
  262.             Password := true;
  263.             Format := 1;
  264.         end
  265.         else
  266.            Password := false;
  267.     end;  {sub Proc Check_Parameters}
  268.  
  269.     Function FillWhiteSpace(Str:string):string;
  270.     var I : integer;
  271.     begin
  272.         If Password then
  273.            Str := replicate(length(Str),PassChar);
  274.         while length(Str) < L do
  275.               Str := Str + RTTT.WhiteSpace;
  276.         FillWhiteSpace := Str;
  277.     end; {sub Func FillWhiteSpace}
  278.  
  279.     Procedure MoveTheCursor;
  280.     begin
  281.         GotoXY(X+CursorPos-1,Y);
  282.     end;  {sub Proc MoveTheCursor}
  283.  
  284.     Procedure Write_String;
  285.     begin
  286.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText));
  287.         MoveTheCursor;
  288.     end;
  289.  
  290.     Procedure Erase_Field;
  291.     begin
  292.         TempText := '';
  293.         CursorPos := 1;
  294.         Write_String;
  295.     end;
  296.  
  297.     Procedure Char_Backspace;
  298.     begin
  299.         If CursorPos > 1 then
  300.         begin
  301.             CursorPos := Pred(CursorPos);
  302.             Delete(TempText,CursorPos,1);
  303.             Write_String;
  304.        end;
  305.     end;   {sub Proc Char_Backspace}
  306.  
  307.     Procedure Char_Del;
  308.     begin
  309.         If CursorPos <= length(TempText) then
  310.         begin
  311.             Delete(TempText,CursorPos,1);
  312.             Write_String;
  313.         end;
  314.     end;   {sub Proc Char_Del}
  315.  
  316.     Procedure Add_Char(Ch:char);
  317.     begin
  318.         If InsertMode then
  319.         begin
  320.             If length(TempText) < L then
  321.             begin
  322.                 Insert(Ch,TempText,CursorPos);
  323.                 If CursorPos < L then
  324.                    CursorPos := Succ(CursorPos);
  325.            end;
  326.         end
  327.         else {not insertmode}
  328.         begin
  329.             Delete(TempText,CursorPos,1);
  330.             Insert(Ch,TempText,CursorPos);
  331.             If CursorPos < L then
  332.                CursorPos := Succ(CursorPos);
  333.         end;   {if insert}
  334.         Write_String;
  335.     end;   {sub proc Add_Char}
  336.  
  337.  
  338. begin                  {main Procedure Read_Line}
  339.     Check_Parameters;
  340.     R_Null := false;
  341.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);
  342.     If RTTT.Insert then
  343.        HalfCursor
  344.     else
  345.        OnCursor;
  346.     Write_String;
  347.     FirstCharPress := true;
  348.     Repeat
  349.          Ch := Getkey;
  350.          If Format in [2,3] then
  351.             Ch := upcase(Ch);
  352.          If Ch in RTTT.End_Chars then
  353.          begin
  354.             AllDone := True;
  355.             If Ch <> #027 then Text := TempText;
  356.          end
  357.          else
  358.          if Extended then
  359.          begin
  360.              Case Ch of
  361.              #131,              {mouseright}
  362.              CursorRight   :  begin
  363.                                   If (CursorPos < L)
  364.                                   and (CursorPos <= length(TempText)) then
  365.                                   begin
  366.                                       CursorPos := Succ(CursorPos);
  367.                                       MoveTheCursor;
  368.                                   end;
  369.                               end;
  370.              #130,               {mouseleft}
  371.              CursorLeft    :  begin
  372.                                   If CursorPos > 1 then
  373.                                   begin
  374.                                       CursorPos := Pred(CursorPos);
  375.                                       MoveTheCursor;
  376.                                   end;
  377.                               end;
  378.              HomeKey       :  begin
  379.                                   CursorPos := 1;
  380.                                   MoveTheCursor;
  381.                               end;
  382.              EndKey        :  begin
  383.                                   If CursorPos < L then
  384.                                   If length(TempText) < L then
  385.                                       CursorPos := length(TempText) + 1
  386.                                   else
  387.                                       CursorPos := L;
  388.                                   MoveTheCursor;
  389.                               end;
  390.             InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
  391.                              begin
  392.                                  InsertMode := not InsertMode;
  393.                                  If InsertMode then
  394.                                     HalfCursor
  395.                                  else
  396.                                     OnCursor;
  397.                              end;
  398.             DelKey        :  Char_Del;
  399.             Zap           :  Erase_Field;
  400.             #132,
  401.             EscKey        :  If RTTT.AllowEsc then
  402.                                  Alldone := true
  403.                              else
  404.                                 Clang;
  405.             #133          :  begin
  406.                                  Alldone := true;
  407.                                  Text := TempText;
  408.                              end;
  409.             #128,#129     :;    {absorb stray mouse movement to avoid Clang'n}
  410.           else Clang;
  411.       end; {case}
  412.       end
  413.       else  {not extended}
  414.       begin
  415.           Case Ch of
  416.            BackSpace     :  Char_Backspace;
  417.            EnterKey      :  begin
  418.                                  Alldone := true;
  419.                                  Text := TempText;
  420.                             end;
  421.            #33 .. #42,                                 {! to *}
  422.            #44,#47,                                    {, /}
  423.            #58 .. #64,                                 {: to @}
  424.            #91 .. #96,                                 {[ to '}
  425.            #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
  426.                              begin
  427.                                  If FirstCharPress and RTTT.EraseDefault then
  428.                                     Erase_Field;
  429.                                  Add_Char(Ch);
  430.                              end
  431.                              else
  432.                                  Clang;
  433.            #43, #45       : If (Format in [1,2])       { + - }
  434.                             or ( (CursorPos=1) and (Format in [5,6,7])) then
  435.                             begin
  436.                                 If FirstCharPress and RTTT.EraseDefault then
  437.                                     Erase_Field;
  438.                                 Add_Char(Ch);
  439.                             end
  440.                             else
  441.                                Clang;
  442.            #46            : If (Format in [1,2])       {.}
  443.                             or ( (Pos('.',TempText)=0) and (Format = 7)) then
  444.                             begin
  445.                                 If FirstCharPress and RTTT.EraseDefault then
  446.                                     Erase_Field;
  447.                                 Add_Char(Ch);
  448.                             end
  449.                             else
  450.                                Clang;
  451.            #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
  452.                             begin
  453.                                 If FirstCharPress and RTTT.EraseDefault then
  454.                                     Erase_Field;
  455.                                 Add_Char(Ch);
  456.                             end
  457.                             else
  458.                                Clang;
  459.            #32,                                              {space}
  460.            #65..#77,                                         {A to M}
  461.            #79..#88,                                         {O to X}
  462.            #90,                                              {Z}
  463.            #97..#255      : If (Format in [1,2,4]) then      {a to z}
  464.                             begin
  465.                                 If FirstCharPress and RTTT.EraseDefault then
  466.                                     Erase_Field;
  467.                                 Add_Char(Ch);
  468.                             end
  469.                             else
  470.                                Clang;
  471.             #132,                                               {5.10a}
  472.             EscKey        :  If RTTT.AllowEsc then
  473.                                  Alldone := true
  474.                              else
  475.                                 Clang;
  476.             #78,#89        : If (Format in [1..4]) then        {N Y}
  477.                             begin
  478.                                 Add_Char(Ch);
  479.                                 If Format = 3 then
  480.                                 begin
  481.                                     Alldone := true;
  482.                                     Text := TempText;
  483.                                 end;
  484.                             end
  485.                             else
  486.                                Clang;
  487.  
  488.           end; {case}
  489.       end;
  490.       FirstCharPress := false;
  491.       Until Alldone;
  492.       R_Char := Ch;
  493.       If  RTTT.RightJustify
  494.       and (Format > 4) then
  495.       begin
  496.           Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
  497.           Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
  498.       end
  499.       else
  500.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
  501.       GotoXY(Cursor_X,Cursor_Y);
  502.       SizeCursor(ScanTop,ScanBot);
  503. end;  {Proc Read_Line}
  504.  
  505. Procedure Display_Box_and_Prompt(var X1,Y: byte;
  506.                                  BoxType:byte;
  507.                                  Prompt: StrScreen;
  508.                                  L:byte);
  509. {ensures that the input will fit on the screen, then draws box and prompt}
  510. const
  511.    Upchar = '^';
  512.    DnChar = '_';
  513. var
  514.   P,
  515.   width:byte;
  516.   InBorder : byte;    {is title in box border - 0 no, 1 upper, 2 lower}
  517. begin
  518.     If not ( (Y-ord(BoxType > 0)) in [1..DisplayLines] ) then
  519.        Y := 2;
  520.     If (X1 < 1) then
  521.        X1 := 2;
  522.     P := length(Prompt);
  523.     If (P > 1) and (Boxtype > 0) then    {check and see if prompt is in box}
  524.     begin
  525.        If Prompt[1] = Upchar then
  526.        begin
  527.            delete(Prompt,1,1);
  528.            dec(P);
  529.            InBorder := 1;
  530.        end
  531.        else
  532.           If Prompt[1] = DnChar then
  533.           begin
  534.               delete(Prompt,1,1);
  535.               dec(P);
  536.               InBorder := 2;
  537.           end
  538.           else
  539.              InBorder := 0;
  540.     end
  541.     else
  542.        InBorder := 0;
  543.     If InBorder > 0 then                      {determine dimensions of box}
  544.     begin
  545.         If P > L then
  546.            width := succ(P)
  547.         else
  548.            width := succ(L);
  549.     end
  550.     else
  551.        width := succ(P+l);
  552.     If pred(X1 + width) > 80 then
  553.        X1 :=  succ(80 - width);
  554.     If BoxType > 0 then         {draw the box}
  555.        FBox(X1,pred(Y),X1+width,succ(Y),RTTT.BoxFCol,RTTT.BoxBCol,BoxType);
  556.     If P > 0 then               {Draw the prompt}
  557.         Case InBorder of
  558.         0 : If BoxType> 0 then
  559.                Fastwrite(succ(X1),Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt) {left Justified in upper border}
  560.             else
  561.                Fastwrite(X1,Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  562.         1 : FastWrite(succ(X1),pred(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  563.         2 : FastWrite(X1+width-P,succ(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);   {right justified in lower border}
  564.         end;
  565.     If InBorder > 0 then        {return var X1 adjusted to position of input field}
  566.     begin
  567.        If Boxtype > 0 then
  568.           X1 := succ(X1);
  569.     end
  570.     else
  571.     begin
  572.        If Boxtype > 0 then
  573.           X1 := succ(X1) + p
  574.        else
  575.           X1 := X1 + P;
  576.     end;
  577. end;
  578. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  579.  
  580.  Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  581.  {compatibility module with TTT 4.0}
  582.  begin
  583.      Read_Line(X,Y,L,F,B,1,Text);
  584.      If R_Char = #027 then
  585.         RetCode := 1         {5.00a}
  586.      else
  587.         Retcode := 0;        {5.00a}
  588.  end; {of proc ReadLine}
  589.  
  590.  
  591. Procedure Read_String(X,Y,L:byte;
  592.                       Prompt:StrScreen;
  593.                       BoxType: byte;
  594.                       Var Txt:StrScreen);
  595. begin
  596.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  597.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,1,Txt);
  598. end;
  599.  
  600. Procedure Read_String_Upper(X,Y,L:byte;
  601.                             Prompt:StrScreen;
  602.                             BoxType: byte;
  603.                             Var Txt:StrScreen);
  604. begin
  605.     Txt :=  Upper(Txt);
  606.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  607.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,2,Txt);
  608. end;
  609.  
  610. Procedure Read_Password(X,Y,L:byte;
  611.                         Prompt:StrScreen;
  612.                         BoxType: byte;
  613.                         Var Txt:StrScreen);
  614. begin
  615.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  616.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,11,Txt);
  617. end;
  618.  
  619. Procedure Read_Alpha(X,Y,L:byte;
  620.                      Prompt:StrScreen;
  621.                      BoxType: byte;
  622.                      Var Txt:StrScreen);
  623. begin
  624.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  625.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,4,Txt);
  626. end;
  627.  
  628. Procedure Read_YN(X,Y:byte;
  629.                   Prompt:StrScreen;
  630.                   BoxType: byte;
  631.                   Var Yes:Boolean);
  632.  
  633. var
  634.   Global_Insert : boolean;
  635.   Txt : StrScreen;
  636. begin
  637.     If Yes then
  638.        Txt := 'Y'
  639.     else
  640.        Txt := 'N';
  641.     Global_Insert := RTTT.insert;
  642.     RTTT.Insert := false;            {force to overwrite mode}
  643.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,1);
  644.     Read_Line(X,Y,1,RTTT.FCol,RTTT.BCol,3,Txt);
  645.     RTTT.Insert := Global_Insert;    {reset back}
  646.     If Txt = 'Y' then
  647.        Yes := true
  648.     else
  649.        Yes := false;
  650. end;
  651.  
  652. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  653.  
  654. Procedure Invalid_Message(Y : byte; var CH : char);
  655. begin
  656.    Clang;
  657.    TempMessageCH(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,
  658.                PadCenter('Invalid number - press any key to resume',80,' '),CH);
  659. end;
  660.  
  661. Procedure OutOfRange_Message(Y : byte;MinS,MaxS : StrScreen;var CH:char);
  662. var S : StrScreen;
  663. begin
  664.    Clang;
  665.    S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key to resume';
  666.    TempMessageCh(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,PadCenter(S,80,' '),CH);
  667. end;
  668.  
  669. Function MessageLine(Y : byte):byte;
  670. begin
  671.     If (RTTT.Msg_Line = 0) or (RTTT.Msg_Line > DisplayLines) then
  672.     begin
  673.         If Y < DisplayLines then    {set message Line}
  674.            MessageLine := succ(Y)
  675.         else
  676.            MessageLine := pred(Y);
  677.     end
  678.     else
  679.        MessageLine := RTTT.Msg_Line;
  680. end;
  681.  
  682. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  683.  
  684. Procedure Read_Byte(X,Y,L:byte; 
  685.                     Prompt:StrScreen;
  686.                     BoxType: byte;
  687.                     Var B : byte; 
  688.                     Min, Max : byte);
  689. var
  690.    Temp : byte;
  691.    Txt : StrScreen;
  692.    Valid : boolean;
  693.    Code : integer;
  694.    YT : byte;
  695.    CHB : char;
  696. begin
  697.     If Max = 0 then
  698.       Max := 255;
  699.     If Min >= Max then
  700.        Min := 0;
  701.     If (B < Min) or (B > Max) then
  702.         B := Min;
  703.     If ((B = 0) and RTTT.SuppressZero) then
  704.        Txt := ''
  705.     else
  706.        Txt := Int_To_Str(B);
  707.     Temp := B;
  708.     Valid := false;
  709.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  710.     YT := MessageLine(Y);
  711.     Repeat
  712.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  713.          If ((R_Char = #027) and RTTT.AllowEsc)
  714.          or ((Txt = '') and (RTTT.AllowNull)) then
  715.          begin
  716.              If Txt = '' then R_Null := true;
  717.              exit;
  718.          end
  719.          else
  720.          begin
  721.              val(Txt,Temp,code);
  722.              If code <> 0 then
  723.              begin
  724.                 Invalid_Message(YT,CHB);
  725.                 If ChB = #027 then
  726.                         Txt := Int_To_Str(B);
  727.              end
  728.              else
  729.              begin
  730.                  If (Temp < Min) 
  731.                  or (Temp > Max) 
  732.                  or ((length(Txt) > 2) and (Txt > '255')) then
  733.                  begin
  734.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),CHB);
  735.                     If ChB = #027 then
  736.                         Txt := Int_To_Str(B);
  737.                  end
  738.                  else
  739.                  begin
  740.                      B := temp;
  741.                      Valid := true;
  742.                  end;
  743.              end;
  744.          end;
  745.     Until Valid or ((R_Char = #027) and RTTT.AllowEsc);
  746. end;
  747.  
  748. Procedure Read_Word(X,Y,L:byte; 
  749.                     Prompt:StrScreen;
  750.                     BoxType: byte;
  751.                     Var W : word; 
  752.                     Min, Max : word);
  753. var
  754.    Temp : word;
  755.    Txt : StrScreen;
  756.    Valid : boolean;
  757.    Code : integer;
  758.    YT : byte;
  759.    ChW : char;
  760. begin
  761.     If Max = 0 then
  762.       Max := MaxWord;
  763.     If Min >= Max then
  764.        Min := MinWord;
  765.     If (W < Min) or (W > Max) then
  766.         W := Min;
  767.     If ((W = 0) and RTTT.SuppressZero) then
  768.        Txt := ''
  769.     else
  770.        Txt := Int_To_Str(W);
  771.     Temp := W;
  772.     Valid := false;
  773.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  774.     YT := MessageLine(Y);
  775.     Repeat
  776.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  777.          If ((R_Char = #027) and RTTT.AllowEsc)
  778.          or ((Txt = '') and (RTTT.AllowNull)) then
  779.          begin
  780.              If Txt = '' then R_Null := true;
  781.              exit;
  782.          end
  783.          else
  784.          begin
  785.              val(Txt,Temp,code);
  786.              If code <> 0 then
  787.              begin
  788.                 Invalid_Message(YT,ChW);
  789.                 If ChW = #027 then
  790.                         Txt := Int_To_Str(W);
  791.              end
  792.              else
  793.              begin
  794.                  If (Temp < Min) 
  795.                  or (Temp > Max) 
  796.                  or ((length(Txt) > 4) and (Txt > Int_To_Str(MaxWord))) then
  797.                  begin
  798.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChW);
  799.                     If ChW = #027 then
  800.                         Txt := Int_To_Str(W);
  801.                  end
  802.                  else
  803.                  begin
  804.                      W := temp;
  805.                      Valid := true;
  806.                  end;
  807.              end;
  808.          end;
  809.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  810. end;
  811.  
  812.  
  813. Procedure Read_Int(X,Y,L:byte;
  814.                    Prompt:StrScreen;
  815.                    BoxType: byte;
  816.                    Var W : integer;
  817.                    Min, Max : integer);
  818. var
  819.    Temp : integer;
  820.    Txt : StrScreen;
  821.    Valid : boolean;
  822.    Code : integer;
  823.    YT : byte;
  824.    ChI : char;
  825. begin
  826.     If Max = 0 then
  827.       Max := MaxInt;
  828.     If Min >= Max then
  829.        Min := MinInt;
  830.     If (W < Min) or (W > Max) then
  831.         W := Min;
  832.     If ((W = 0) and RTTT.SuppressZero) then
  833.        Txt := ''
  834.     else
  835.        Txt := Int_To_Str(W);
  836.     Temp := W;
  837.     Valid := false;
  838.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  839.     YT := MessageLine(Y);
  840.     Repeat
  841.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  842.          If ((R_Char = #027) and RTTT.AllowEsc)
  843.          or ((Txt = '') and (RTTT.AllowNull)) then
  844.          begin
  845.              If Txt = '' then R_Null := true;
  846.              exit;
  847.          end
  848.          else
  849.          begin
  850.              val(Txt,Temp,code);
  851.              If code <> 0 then
  852.              begin
  853.                 Invalid_Message(YT,ChI);
  854.                 If ChI = #027 then
  855.                    Txt := Int_to_Str(W);
  856.  
  857.              end
  858.              else
  859.              begin
  860.                  If (Temp < Min) or (Temp > Max) then
  861.                  begin
  862.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  863.                     If ChI = #027 then
  864.                        Txt := Int_to_Str(W);
  865.                  end
  866.                  else
  867.                  begin
  868.                      W := temp;
  869.                      Valid := true;
  870.                  end;
  871.             end;
  872.         end;
  873.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  874. end;
  875.  
  876. Procedure Read_LongInt(X,Y,L:byte;
  877.                    Prompt:StrScreen;
  878.                    BoxType: byte;
  879.                    Var W : longint;
  880.                    Min, Max : longint);
  881. var
  882.    Temp : longint;
  883.    Txt : StrScreen;
  884.    Valid : boolean;
  885.    Code : integer;
  886.    YT : byte;
  887.    ChI : char;
  888. begin
  889.     If Max = 0 then
  890.       Max := MaxLongInt;
  891.     If Min >= Max then
  892.        Min := MinLongInt;
  893.     If (W < Min) or (W > Max) then
  894.         W := Min;
  895.     If ((W = 0) and RTTT.SuppressZero) then
  896.        Txt := ''
  897.     else
  898.        Txt := Int_To_Str(W);
  899.     Temp := W;
  900.     Valid := false;
  901.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  902.     YT := MessageLine(Y);
  903.     Repeat
  904.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  905.          If ((R_Char = #027) and RTTT.AllowEsc)
  906.          or ((Txt = '') and (RTTT.AllowNull)) then
  907.          begin
  908.              If Txt = '' then R_Null := true;
  909.              exit;
  910.          end
  911.          else
  912.          begin
  913.              val(Txt,Temp,code);
  914.              If code <> 0 then
  915.              begin
  916.                 Invalid_Message(YT,ChI);
  917.                 If ChI = #027 then
  918.                    Txt := Int_to_Str(W);
  919.              end
  920.              else
  921.              begin
  922.                  If (Temp < Min) or (Temp > Max) then
  923.                  begin
  924.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  925.                     If ChI = #027 then
  926.                        Txt := Int_to_Str(W);
  927.                  end
  928.                  else
  929.                  begin
  930.                      W := temp;
  931.                      Valid := true;
  932.                  end;
  933.             end;
  934.         end;
  935.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  936. end;
  937.  
  938. Procedure Read_Real(X,Y,L:byte;
  939.                     Prompt:StrScreen;
  940.                     BoxType: byte;
  941.                     Var W : real; 
  942.                     Min, Max : real);
  943. var
  944.    Temp : Real;
  945.    Txt : StrScreen;
  946.    Valid : boolean;
  947.    Code : integer;
  948.    YT : byte;
  949.    ChR : char;
  950. begin
  951.     If Max = 0 then
  952.       Max := 99999999;
  953.     If Min >= Max then
  954.        Min := -99999999;
  955.     If (W < Min) or (W > Max) then
  956.         W := Min;
  957.     If Min < 0 then    {add room for - sign}
  958.        Inc(L);
  959.     If ((W = 0.0) and RTTT.SuppressZero) then
  960.        Txt := ''
  961.     else
  962.        Txt := Real_To_Str(W,RTTT.RealDP);
  963.     Temp := W;
  964.     Valid := false;
  965.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);      {5.00b}
  966.     YT := MessageLine(Y);
  967.     Repeat
  968.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
  969.          If ((R_Char = #027) and RTTT.AllowEsc)
  970.          or ((Txt = '') and (RTTT.AllowNull)) then
  971.          begin
  972.              If Txt = '' then R_Null := true;
  973.              exit;
  974.          end
  975.          else
  976.          begin
  977.              val(Txt,Temp,code);
  978.              If code <> 0 then
  979.              begin
  980.                 Invalid_Message(YT,ChR);
  981.                 If ChR = #027 then
  982.                    Txt := Real_to_Str(W,RTTT.RealDP);
  983.              end
  984.              else
  985.              begin
  986.                  If (Temp < Min) or (Temp > Max) then
  987.                  begin
  988.                     OutOfRange_Message(Yt,Real_To_Str(Min,RTTT.RealDP),Real_To_Str(Max,RTTT.RealDP),ChR);
  989.                     If ChR = #027 then
  990.                        Txt := Real_to_Str(W,RTTT.RealDP);
  991.                  end
  992.                  else
  993.                  begin
  994.                      W := temp;
  995.                      Valid := true;
  996.                  end;
  997.             end;
  998.         end;
  999.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  1000. end;
  1001.   
  1002. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  1003. Const
  1004.      UpChar:string[1] = '^';
  1005.      JoinChar:string[1] = '_';
  1006. var
  1007.   W : byte;
  1008.   I : integer;
  1009.   Horiz : boolean;
  1010.      Function Replace_JoinChar(Str:string): string;
  1011.      {}
  1012.      var I : integer;
  1013.      begin
  1014.          For I := 1 to length(Str) do
  1015.              If Str[I] = JoinChar then
  1016.                 Str[I] := ' ';
  1017.          Replace_JoinChar := Str;
  1018.      end; {of func Replace_JoinChar}
  1019.  
  1020.      Procedure HiLightWord(W:byte;Hi:boolean);
  1021.      var Col : byte;
  1022.      begin
  1023.          If Hi then
  1024.             Col := attr(RTTT.HiFCol,RTTT.HiBcol)
  1025.          else
  1026.             Col := attr(RTTT.LoFcol,RTTT.LoBcol);
  1027.          If Horiz then
  1028.              Fastwrite(pred(X)+PosWord(W,Txt),Y,Col,Replace_JoinChar(ExtractWords(W,1,Txt)))
  1029.          else
  1030.              Fastwrite(X,pred(Y)+W,Col,Replace_JoinChar(ExtractWords(W,1,Txt)));
  1031.          If Hi then
  1032.          begin
  1033.             If Horiz then
  1034.                GotoXY(pred(X)+PosWord(W,Txt),Y)
  1035.             else
  1036.                GotoXY(X,Pred(Y)+W);
  1037.          end;
  1038.      end;
  1039.  
  1040.      Procedure Process_Keys;
  1041.      var
  1042.        ChP : char;
  1043.        Finished : boolean;
  1044.      begin
  1045.          Finished := false;
  1046.          Repeat
  1047.               ChP := getKey;
  1048.               If ChP in RTTT.End_Chars then
  1049.                   Finished := True
  1050.               else
  1051.               Case upcase(ChP) of
  1052.               #132,
  1053.               EscKey      : If RTTT.AllowEsc then
  1054.                                 Finished := true;
  1055.               ' ',#9,                                 {tab}
  1056.               CursorDown,
  1057.               CursorRight : begin
  1058.                                 HiLightWord(Choice,false);
  1059.                                 If Choice < W then
  1060.                                    Inc(Choice)
  1061.                                 else
  1062.                                    Choice := 1;
  1063.                                 HiLightWord(Choice,true);
  1064.                             end;
  1065.               #143,                     {Shift tab}
  1066.               CursorUp,
  1067.               CursorLeft  : begin
  1068.                                 HiLightWord(Choice,false);
  1069.                                 If Choice > 1 then
  1070.                                    Dec(Choice)
  1071.                                 else
  1072.                                    Choice := W;
  1073.                                 HiLightWord(Choice,true);
  1074.                             end;
  1075.               #131        : If (Choice < W) and Horiz then    {mouse right}
  1076.                             begin
  1077.                                 HiLightWord(Choice,false);
  1078.                                 Inc(Choice);
  1079.                                 HiLightWord(Choice,true);
  1080.                             end;
  1081.               #130        : If (Choice > 1) and Horiz then    {mouse left}
  1082.                             begin
  1083.                                 HiLightWord(Choice,false);
  1084.                                 Dec(Choice);
  1085.                                 HiLightWord(Choice,true);
  1086.                             end;
  1087.               #129        : If (Choice < W) and (Horiz = false) then    {mouse down}
  1088.                             begin
  1089.                                 HiLightWord(Choice,false);
  1090.                                 Inc(Choice);
  1091.                                 HiLightWord(Choice,true);
  1092.                             end;
  1093.               #128        : If (Choice > 1) and (Horiz = false) then    {mouse up}
  1094.                             begin
  1095.                                 HiLightWord(Choice,false);
  1096.                                 Dec(Choice);
  1097.                                 HiLightWord(Choice,true);
  1098.                             end;
  1099.  
  1100.               end; {case}
  1101.          until Finished;
  1102.          R_Char := ChP;
  1103.      end;
  1104.  
  1105. begin
  1106.     If Txt[1] = UpChar then
  1107.     begin
  1108.         Horiz := False;
  1109.         Delete(Txt,1,1);
  1110.     end
  1111.     else
  1112.        Horiz := true;
  1113.     W := Wordcnt(Txt);
  1114.     If W < 2 then exit;              {only show choices if there are two or more}
  1115.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);   {record cursor settings}
  1116.     If (Choice > W) or (Choice < 1) then               {check that W is sensible}
  1117.        Choice := 1;
  1118.     If Pmt <> '' then
  1119.     begin
  1120.         Fastwrite(X,Y,attr(RTTT.PFcol,RTTT.PBCol),Pmt);
  1121.         X := X+length(Pmt);
  1122.     end;
  1123.     For I := 1 to W do
  1124.         HiLightWord(I,False);
  1125.     OnCursor;
  1126.     HiLightWord(Choice,True);
  1127.     Process_keys;
  1128.     GotoXY(Cursor_X,Cursor_Y);           {reset cursor}
  1129.     SizeCursor(ScanTop,ScanBot);
  1130. end;  {proc Read_Select}
  1131.  
  1132. begin
  1133.    Default_Settings;
  1134. end.
  1135.