home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ENTRT101.ZIP / ENTERIT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-03-10  |  23.3 KB  |  597 lines
  1.  
  2.  {$A+,B-,D-,E-,F-,I+,N-,O-,R+,S-,V+}
  3.  
  4. (****************************************************************************)
  5. (* ENTERIT.PAS - Data-entry unit.                                           *)
  6. (* version 1.01 (March 10, 1992)                                            *)
  7. (* TP required: 6.0                                                         *)
  8. (* by Guy McLoughlin                                                        *)
  9. (* Released to the public domain.                                           *)
  10. (****************************************************************************)
  11.  
  12. unit EnterIt;      (* Data-entry field unit.                                *)
  13.  
  14. (****************************************************************************)
  15.  interface
  16. (****************************************************************************)
  17.  
  18. uses
  19.   Qwriter;
  20.  
  21. (****************************************************************************)
  22. (*  Unit Routines                                                           *)
  23. (****************************************************************************)
  24.  
  25.                    (* Set ErrorMessage X-Y position, and color.             *)
  26.   procedure InitErrorMess(Xaxis, Yaxis : byte; Cattr : word);
  27.  
  28.  
  29.                    (* Get a string from User.                               *)
  30.   function EnterString(FieldWidth,                (* Width of entry-field.  *)
  31.                        Xaxis,                     (* Where to place this    *)
  32.                        Yaxis : byte;              (* entry-field.           *)
  33.                        Cattr : word) : VidString; (* Field-attribute.       *)
  34.  
  35.  
  36.                    (* Format a string with commas, expanded to Width size.  *)
  37.   function Comma(InString : VidString; Width : byte) : VidString;
  38.  
  39.  
  40.                    (* Get a short sized number from User.                   *)
  41.   function EnterShort(Min, Max : shortint;      (* Min, Max shortint values.*)
  42.                       FieldWidth,               (* Width of entry-field.    *)
  43.                       Xaxis,                    (* Where to place this      *)
  44.                       Yaxis : byte;             (* entry-field.             *)
  45.                       Cattr : word) : shortint; (* Field-attribute.         *)
  46.  
  47.  
  48.                    (* Get a byte sized number from User.                    *)
  49.   function EnterByte(Min, Max,                   (* Min, Max byte values.   *)
  50.                      FieldWidth,                 (* Width of entry-field.   *)
  51.                      Xaxis,                      (* Where to place this     *)
  52.                      Yaxis : byte;               (* entry-field.            *)
  53.                      Cattr : word) : byte;       (* Field Field-attribute.  *)
  54.  
  55.  
  56.                    (* Get a integer sized number from User.                 *)
  57.   function EnterInt(Min, Max : integer;       (* Min, Max integer values.   *)
  58.                     FieldWidth,               (* Width of entry-field.      *)
  59.                     Xaxis,                    (* Where to place this        *)
  60.                     Yaxis : byte;             (* entry-field.               *)
  61.                     Cattr : word) : integer;  (* Field-attribute.           *)
  62.  
  63.  
  64.                    (* Get a word sized number from User.                    *)
  65.   function EnterWord(Min, Max : word;            (* Min, Max word values.   *)
  66.                      FieldWidth,                 (* Width of entry-field.   *)
  67.                      Xaxis,                      (* Where to place this     *)
  68.                      Yaxis : byte;               (* entry-field.            *)
  69.                      Cattr : word) : word;       (* Field Field-attribute.  *)
  70.  
  71.  
  72.                    (* Get a long sized number from User.                    *)
  73.   function EnterLong(Min, Max : longint;       (* Min, Max longint values.  *)
  74.                      FieldWidth,               (* Width of entry-field.     *)
  75.                      Xaxis,                    (* Where to place this       *)
  76.                      Yaxis : byte;             (* entry-field.              *)
  77.                      Cattr : word) : longint;  (* Field-attribute.          *)
  78.  
  79.  
  80.                    (* Get a Real sized number from User.                    *)
  81.   function EnterReal(Min, Max : real;          (* Min, Max Real values.     *)
  82.                      DecNum,                   (* Format with N decimals.   *)
  83.                      FieldWidth,               (* Width of entry-field.     *)
  84.                      Xaxis,                    (* Where to place this       *)
  85.                      Yaxis : byte;             (* entry-field.              *)
  86.                      Cattr : word) : real;     (* Field-attribute.        *)
  87.  
  88. (****************************************************************************)
  89.  implementation
  90. (****************************************************************************)
  91.  
  92. type               (* Enumerated entry data-types.                          *)
  93.   EntryType  = (Eshortint, Ebyte, Einteger, Eword, Elongint, Estring);
  94.  
  95. const              (* One blank space.                                      *)
  96.   SpaceChar = #32;
  97.  
  98.                    (* Sets of valid entry characters, by data-type.         *)
  99.   ShortSet     = ['+', '-', '0'..'9'];      (* Valid chars for shortints    *)
  100.   ByteSet      = ['+', '0'..'9'];           (* Valid chars for bytes.       *)
  101.   WordSet      = [',','0'..'9'];            (* Valid chars for Words.       *)
  102.   RealSet      = ['+'..'-', '.', '0'..'9']; (* Valid chars for Reals.       *)
  103.   StringSet    = [' '..'}'];                (* Valid chars for Strings.     *)
  104.  
  105.   ErrorBlank = '                            ';
  106.  
  107. var
  108.   ErrorX,           (* Xaxis for ErrorMessage.                              *)
  109.   ErrorY,           (* Yaxis for ErrorMessage.                              *)
  110.   ErrorAttr : word; (* Error message attribute.                             *)
  111.  
  112.                    (* String used to clear entry-field.                     *)
  113.   BlankString : VidString;
  114.  
  115.  
  116.                    (* Set ErrorMessage X-Y position, and color.             *)
  117.   procedure InitErrorMess(Xaxis, Yaxis : byte; Cattr : word);
  118.   begin
  119.     ErrorX := Xaxis;
  120.     ErrorY := Yaxis;
  121.     ErrorAttr := Cattr
  122.   end;
  123.  
  124.  
  125.                    (* Display Error-message.                                *)
  126.   procedure ErrorMessage(MsgNum : byte);
  127.   begin
  128.  
  129.                    (* Make a beep.                                          *)
  130.     Beep;
  131.  
  132.                    (* Display error-message.                                *)
  133.     case MsgNum of
  134.       1 : QWrite('  Invalid Number format!!!  ', ErrorX, ErrorY,
  135.                  ErrorAttr);
  136.       2 : QWrite('   Number is too Small!!!   ', ErrorX, ErrorY,
  137.                  ErrorAttr);
  138.       3 : QWrite('    Number is too Big!!!    ', ErrorX, ErrorY,
  139.                  ErrorAttr)
  140.     end;
  141.  
  142.                    (* Wait for any key to be pressed.                       *)
  143.     Pause(AnyKey);
  144.  
  145.                    (* Clear the error-message.                              *)
  146.     QWrite(ErrorBlank, ErrorX, ErrorY, NormAttr)
  147.   end;
  148.  
  149.  
  150.                    (* Format a string with commas, expanded to Width size.  *)
  151.   function Comma(InString : VidString; Width : byte) : VidString;
  152.   var
  153.     SignPos    : byte; NumSigned : boolean absolute SignPos;
  154.     SignChar   : char;
  155.     Index      : byte;
  156.     TempString : string;
  157.   begin
  158.     TempString := InString;
  159.  
  160.                    (* Delete all blank spaces.                              *)
  161.     while (pos(' ', TempString) <> 0) do
  162.       delete(TempString, pos(' ', TempString), 1);
  163.  
  164.                    (* Check if number string is negative signed.            *)
  165.     SignPos := pos('-', TempString);
  166.  
  167.                    (* If number string is negative, record sign and delete. *)
  168.     if NumSigned then
  169.       begin
  170.         SignChar := '-';
  171.         delete(TempString, SignPos, 1)
  172.       end
  173.  
  174.                    (* Else, the number string is not negative signed.       *)
  175.     else
  176.       begin
  177.  
  178.                    (* Check number string is positive signed.               *)
  179.         SignPos := pos('+', TempString);
  180.  
  181.                    (* If number string is signed, record sign, then delete. *)
  182.         if NumSigned then
  183.           begin
  184.             SignChar := '+';
  185.             delete(TempString, SignPos, 1)
  186.           end
  187.       end;
  188.  
  189.                    (* Check for a decimal point.                            *)
  190.     Index :=  pos('.', TempString);
  191.     if (Index <> 0) then
  192.       dec(Index, 1)
  193.     else
  194.       Index := length(TempString);
  195.  
  196.                    (* Insert commas in appropriate spots.                   *)
  197.     while (Index > 3) do
  198.       begin
  199.         dec(Index, 3);
  200.         insert(',', TempString, (Index + 1))
  201.       end;
  202.  
  203.                    (* If number string was signed, add the sign back.       *)
  204.     if NumSigned then
  205.       TempString := SignChar + TempString;
  206.  
  207.                    (* Pad the number string with blanks if neccessary.      *)
  208.     while (length(TempString) < Width) do
  209.       TempString := ' ' + TempString;
  210.     Comma := TempString
  211.   end;
  212.  
  213.  
  214.                    (* Internal unit string function.                        *)
  215.   function GetString (Ntype : EntryType;
  216.                       FieldWidth,
  217.                       Xaxis,
  218.                       Yaxis : byte;
  219.                       Cattr : word) : VidString;
  220.   var
  221.     TempString : VidString;
  222.     KeyChoice  : word;
  223.     KeyChar    : char absolute KeyChoice;
  224.     KeyOK      : boolean;
  225.     EntryIndex : word;
  226.   begin
  227.                    (* Clear the temporary string buffer.                    *)
  228.     fillchar(TempString, sizeof(TempString), 0);
  229.  
  230.                    (* Limit the maximum string size.                        *)
  231.     if (FieldWidth > Columns) then
  232.       FieldWidth := Columns;
  233.  
  234.                    (* Set the length of the "blank" string.                 *)
  235.     BlankString[0] := chr(FieldWidth);
  236.  
  237.                    (* Initialize variables.                                 *)
  238.     EntryIndex := 1;
  239.     TempString := '';
  240.  
  241.                    (* Blank out the entry-field area.                       *)
  242.     QWrite(BlankString, Xaxis, Yaxis, Cattr);
  243.  
  244.                    (* Clear the key-buffer.                                 *)
  245.     ClearKeyBuff;
  246.  
  247.     repeat         (* Repeat..Until a number has been entered.              *)
  248.  
  249.                    (* Reset boolean.                                        *)
  250.       KeyOK := false;
  251.  
  252.                    (* Read the User's key press.                            *)
  253.       KeyChoice := ReadKeyWord;
  254.  
  255.                    (* Decide how to handle the key press.                   *)
  256.       case Ntype of
  257.         Eshortint,
  258.         Einteger,
  259.         Elongint : if (KeyChar in ShortSet) then
  260.                      KeyOK := true;
  261.         Ebyte    : if (KeyChar in ByteSet) then
  262.                      KeyOK := true;
  263.         Eword    : if (KeyChar in WordSet) then
  264.                      KeyOK := true;
  265.         Estring  : if (KeyChar in StringSet) then
  266.                      KeyOK := true
  267.       end;
  268.  
  269.                    (* If the key entered is OK, then...                     *)
  270.       if KeyOK and (EntryIndex <= FieldWidth) then
  271.         begin
  272.           inc(EntryIndex, 1);
  273.           TempString := TempString + KeyChar;
  274.           QWrite(TempString,
  275.                  ((Xaxis + FieldWidth) - length(TempString)),
  276.                  Yaxis, Cattr)
  277.         end
  278.  
  279.                    (* Else, the key entered is not OK...                    *)
  280.       else
  281.         if ((KeyChoice = BackSpaceKey)
  282.             or (KeyChoice = RightArrowKey)
  283.             or (KeyChoice = DeleteKey))
  284.         and (EntryIndex > 1) then
  285.           begin
  286.             dec(EntryIndex, 1);
  287.             delete(TempString, length(TempString), 1);
  288.             QWrite((SpaceChar + TempString),
  289.                    ((Xaxis + FieldWidth) - (length(TempString) + 1)),
  290.                    Yaxis, Cattr)
  291.           end
  292.  
  293.                    (* Repeat..Until a number string is entered.             *)
  294.     until (TempString <> '') and (KeyChoice = EnterKey);
  295.     GetString := TempString
  296.   end;
  297.  
  298.  
  299.                    (* Get a string from User.                               *)
  300.   function EnterString(FieldWidth,                (* Width of entry-field.  *)
  301.                        Xaxis,                     (* Where to place this    *)
  302.                        Yaxis : byte;              (* entry-field.           *)
  303.                        Cattr : word) : VidString; (* Field-attribute.       *)
  304.   begin
  305.     EnterString := GetString(Estring, FieldWidth, Xaxis, Yaxis, Cattr)
  306.   end;
  307.  
  308.  
  309.                    (* Get a short sized number.                             *)
  310.   function EnterShort(Min, Max : shortint;      (* Min, Max shortint values.*)
  311.                       FieldWidth,               (* Width of entry-field.    *)
  312.                       Xaxis,                    (* Where to place this      *)
  313.                       Yaxis : byte;             (* entry-field.             *)
  314.                       Cattr : word) : shortint; (* Field-attribute.         *)
  315.   var
  316.     TempShort : longint;
  317.     Result    : integer;
  318.     Error     : boolean absolute Result;
  319.   begin
  320.                    (* Repeat until a valid number is entered.               *)
  321.     repeat
  322.       val(GetString(Eshortint, FieldWidth, Xaxis, Yaxis, Cattr),
  323.           TempShort, Result);
  324.                    (* If string is not a valid number, then...              *)
  325.       if Error then
  326.         ErrorMessage(1)
  327.       else
  328.                    (* If the number entered is too small, then...           *)
  329.         if (TempShort < Min) then
  330.           begin
  331.             Error := true;
  332.             ErrorMessage(2)
  333.           end
  334.         else
  335.                    (* If the number entered is too big, then...             *)
  336.          if (TempShort > Max) then
  337.             begin
  338.               Error := true;
  339.               ErrorMessage(3)
  340.             end
  341.     until (Error = false);
  342.     EnterShort := shortint(TempShort)
  343.   end;
  344.  
  345.  
  346.                    (* Get a byte sized number.                              *)
  347.   function EnterByte(Min, Max,                   (* Min, Max byte values.   *)
  348.                      FieldWidth,                 (* Width of entry-field.   *)
  349.                      Xaxis,                      (* Where to place this     *)
  350.                      Yaxis : byte;               (* entry-field.            *)
  351.                      Cattr : word) : byte;       (* Field Field-attribute.  *)
  352.   var
  353.     TempByte : longint;
  354.     Result   : integer;
  355.     Error    : boolean absolute Result;
  356.   begin
  357.                    (* Repeat until a valid number is entered.               *)
  358.     repeat
  359.       val(GetString(Ebyte, FieldWidth, Xaxis, Yaxis, Cattr),
  360.           TempByte, Result);
  361.                    (* If string is not a valid number, then...              *)
  362.       if Error then
  363.         ErrorMessage(1)
  364.       else
  365.                    (* If the number entered is too small, then...           *)
  366.         if (TempByte < Min) then
  367.           begin
  368.             Error := true;
  369.             ErrorMessage(2)
  370.           end
  371.         else
  372.                    (* If the number entered is too big, then...             *)
  373.           if (TempByte > Max) then
  374.             begin
  375.               Error := true;
  376.               ErrorMessage(3)
  377.             end
  378.     until (Error = false);
  379.     EnterByte := byte(TempByte)
  380.   end;
  381.  
  382.  
  383.                    (* Get a integer sized number.                           *)
  384.   function EnterInt(Min, Max : integer;       (* Min, Max integer values.   *)
  385.                     FieldWidth,               (* Width of entry-field.      *)
  386.                     Xaxis,                    (* Where to place this        *)
  387.                     Yaxis : byte;             (* entry-field.               *)
  388.                     Cattr : word) : integer;  (* Field-attribute.           *)
  389.   var
  390.     TempInt : longint;
  391.     Result  : integer;
  392.     Error   : boolean absolute Result;
  393.   begin
  394.                    (* Repeat until a valid number is entered.               *)
  395.     repeat
  396.       val(GetString(Einteger, FieldWidth, Xaxis, Yaxis, Cattr),
  397.           TempInt, Result);
  398.                    (* If string is not a valid number, then...              *)
  399.       if Error then
  400.         ErrorMessage(1)
  401.       else
  402.                    (* If the number entered is too small, then...           *)
  403.         if (TempInt < Min) then
  404.           begin
  405.             Error := true;
  406.             ErrorMessage(2)
  407.           end
  408.         else
  409.                    (* If the number entered is too big, then...             *)
  410.           if (TempInt > Max) then
  411.             begin
  412.               Error := true;
  413.               ErrorMessage(3)
  414.             end
  415.     until (Error = false);
  416.     EnterInt := integer(TempInt)
  417.   end;
  418.  
  419.  
  420.                    (* Get a word sized number.                              *)
  421.   function EnterWord(Min, Max : word;            (* Min, Max word values.   *)
  422.                      FieldWidth,                 (* Width of entry-field.   *)
  423.                      Xaxis,                      (* Where to place this     *)
  424.                      Yaxis : byte;               (* entry-field.            *)
  425.                      Cattr : word) : word;       (* Field Field-attribute.  *)
  426.   var
  427.     TempWord : longint;
  428.     Result   : integer;
  429.     Error    : boolean absolute Result;
  430.   begin
  431.                    (* Repeat until a valid number is entered.               *)
  432.     repeat
  433.       val(GetString(Eword, FieldWidth, Xaxis, Yaxis, Cattr),
  434.           TempWord, Result);
  435.                    (* If string is not a valid number, then...              *)
  436.       if Error then
  437.         ErrorMessage(1)
  438.       else
  439.                    (* If the number entered is too small, then...           *)
  440.         if (TempWord < Min) then
  441.           begin
  442.             Error := true;
  443.             ErrorMessage(2)
  444.           end
  445.         else
  446.                    (* If the number entered is too big, then...             *)
  447.           if (TempWord > Max) then
  448.             begin
  449.               Error := true;
  450.               ErrorMessage(3)
  451.             end
  452.     until (Error = false);
  453.     EnterWord := word(TempWord)
  454.   end;
  455.  
  456.  
  457.                    (* Get a long sized number.                              *)
  458.   function EnterLong(Min, Max : longint;       (* Min, Max longint values.  *)
  459.                      FieldWidth,               (* Width of entry-field.     *)
  460.                      Xaxis,                    (* Where to place this       *)
  461.                      Yaxis : byte;             (* entry-field.              *)
  462.                      Cattr : word) : longint;  (* Field-attribute.     *)
  463.   var
  464.     TempLong    : longint;
  465.     Result      : integer; Error : boolean absolute Result;
  466.   begin
  467.                    (* Repeat until a valid number is entered.               *)
  468.     repeat
  469.       val(GetString(Elongint, FieldWidth, Xaxis, Yaxis, Cattr),
  470.           TempLong, Result);
  471.                    (* If string is not a valid number, then...              *)
  472.       if Error then
  473.         ErrorMessage(1)
  474.       else
  475.                    (* If the number entered is too small, then...           *)
  476.         if (TempLong < Min) then
  477.           begin
  478.             Error := true;
  479.             ErrorMessage(2)
  480.           end
  481.         else
  482.                    (* If the number entered is too big, then...             *)
  483.           if (TempLong > Max) then
  484.             begin
  485.               Error := true;
  486.               ErrorMessage(3)
  487.             end
  488.     until (Error = false);
  489.     EnterLong := TempLong
  490.   end;
  491.  
  492.  
  493.                    (* Get a Real sized number.                              *)
  494.   function EnterReal(Min, Max : real;          (* Min, Max Real values.     *)
  495.                      DecNum,                   (* Format with N decimals.   *)
  496.                      FieldWidth,               (* Width of entry-field.     *)
  497.                      Xaxis,                    (* Where to place this       *)
  498.                      Yaxis : byte;             (* entry-field.              *)
  499.                      Cattr : word) : real;     (* Field-attribute.          *)
  500.   var
  501.     TempString  : VidString;
  502.     KeyChoice   : word; KeyChar : char absolute KeyChoice;
  503.     TempReal    : real;
  504.     DotPos      : byte; DotEntered : boolean absolute DotPos;
  505.     EntryIndex  : byte;
  506.     Result      : integer; Error : boolean absolute Result;
  507.   begin
  508.     fillchar(TempString, sizeof(TempString), 0);
  509.     if (FieldWidth > Columns) then
  510.       FieldWidth := Columns;
  511.     BlankString[0] := chr(FieldWidth);
  512.                    (* Repeat until a valid number is entered.               *)
  513.     repeat
  514.       EntryIndex := 1;
  515.       TempString := '';
  516.       DotPos := 0;
  517.       QWrite(BlankString, Xaxis, Yaxis, Cattr);
  518.       ClearKeyBuff;
  519.       repeat
  520.         KeyChoice := ReadKeyWord;
  521.         if (KeyChar in RealSet)
  522.         and (EntryIndex <= FieldWidth) then
  523.           begin
  524.             if DotEntered then
  525.               begin
  526.                 if (KeyChar <> #46)
  527.                 and (length(TempString) < (DotPos + DecNum)) then
  528.                   begin
  529.                     TempString := TempString + KeyChar;
  530.                     inc(EntryIndex, 1);
  531.                     QWrite(TempString, (Xaxis + FieldWidth - length(TempString)),
  532.                            Yaxis, Cattr)
  533.                   end
  534.               end
  535.             else
  536.               begin
  537.                 if (KeyChar = #46) then
  538.                   DotPos := EntryIndex;
  539.                 TempString := TempString + KeyChar;
  540.                 inc(EntryIndex, 1);
  541.                 QWrite(TempString, (Xaxis + FieldWidth - length(TempString)),
  542.                        Yaxis, Cattr)
  543.               end;
  544.           end
  545.         else
  546.           if (KeyChoice = BackSpaceKey)
  547.           or (KeyChoice = RightArrowKey)
  548.           or (KeyChoice = DeleteKey) then
  549.             begin
  550.               if (EntryIndex > 1) then
  551.                 begin
  552.                   dec(EntryIndex);
  553.                   if (TempString[EntryIndex] = #46) then
  554.                     DotPos := 0;
  555.                   delete(TempString, length(TempString), 1);
  556.                   QWrite((SpaceChar + TempString),
  557.                          (Xaxis + FieldWidth - (length(TempString) + 1)),
  558.                          Yaxis, Cattr)
  559.                 end
  560.             end;
  561.       if (DotEntered) and (length(TempString) = 1) then
  562.         KeyChoice := 0
  563.       until (KeyChoice = EnterKey);
  564.       while (pos(',', TempString) <> 0) do
  565.         delete(TempString, pos(',', TempString), 1);
  566.       val(TempString, TempReal, Result);
  567.                    (* If string is not a valid number, then...              *)
  568.       if Error then
  569.         ErrorMessage(1)
  570.       else
  571.                    (* If the number entered is too small, then...           *)
  572.         if (TempReal < Min) then
  573.           begin
  574.             Error := true;
  575.             ErrorMessage(2)
  576.           end
  577.         else
  578.                    (* If the number entered is too big, then...             *)
  579.           if (TempReal > Max) then
  580.             begin
  581.               Error := true;
  582.               ErrorMessage(3)
  583.             end
  584.     until (Error = false);
  585.     EnterReal := TempReal
  586.   end;
  587.  
  588. BEGIN
  589.                    (* Set error message defaults.                           *)
  590.   InitErrorMess(1, 1, RevAttr);
  591.  
  592.                    (* Clear the "BlankString" variable.                     *)
  593.   fillchar(BlankString, sizeof(VidString), SpaceChar)
  594. END.
  595.  
  596.  
  597.