home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_inpt / sti_inpt.pas
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  10.7 KB  |  418 lines
  1. Unit STI_INPT;
  2. {$I-}
  3. interface
  4.  
  5. Uses STI_STRN,STI_SCRF, Crt;
  6.  
  7. function STI_GetStringXY(X,Y,Length,Color,Attr : byte; Legal : string) : string;
  8. function STI_GetByteXY1(X,Y,Min,Max,Color,Attr : byte) : byte;
  9. function STI_GetByteXY2(X,Y,Min,Max,Color,Attr : byte) : byte;
  10. function STI_GetWordXY1(X,Y : byte; Min,Max : word; Color,Attr : byte) : word;
  11. function STI_GetWordXY2(X,Y : byte; Min,Max : word; Color,Attr : byte) : word;
  12. function STI_GetIntXY1(X,Y : byte;  Min,Max : integer; Color,Attr : byte) : integer;
  13. function STI_GetIntXY2(X,Y : byte;  Min,Max : integer; Color,Attr : byte) : integer;
  14. function STI_GetLongIntXY1(X,Y : byte;  Min,Max : LongInt; Color,Attr : byte) : LongInt;
  15. function STI_GetLongIntXY2(X,Y : byte;  Min,Max : LongInt; Color,Attr : byte) : LongInt;
  16. function STI_GetShortIntXY1(X,Y : byte;  Min,Max : ShortInt; Color,Attr : byte) : ShortInt;
  17. function STI_GetShortIntXY2(X,Y : byte;  Min,Max : ShortInt; Color,Attr : byte) : ShortInt;
  18. function STI_GetRealXY(X,Y,Width : byte; Min,Max : Real; Color,Attr : byte) : Real;
  19.  
  20.  
  21.  
  22. implementation
  23.  
  24. {---------------------------------------------------------------------------}
  25.  
  26. function STI_GetStringXY(X,Y,Length,Color,Attr : byte; Legal : string) : string;
  27.  
  28. var
  29.   temp : string;
  30.   loop : byte;
  31.   inch : char;
  32.   dumm : byte;
  33.   OldAttr : byte;
  34.  
  35. begin
  36.   OldAttr := TextAttr;
  37.   TextColor(Color+Attr);
  38.   TextColor(Color+Attr);
  39.   GotoXY(X,Y);
  40.   if (X+Length) > 79 then Length := (79-X);
  41.   temp := MakeStr(Length,32);
  42.   Write(temp);
  43.   loop := 1;
  44.   inch := ' ';
  45.   while inch <> #13 do
  46.     begin
  47.       repeat until keypressed;
  48.       inch := readkey;
  49.       if (pos(inch,legal) > 0) or (inch < #31) then
  50.         begin
  51.           case inch of
  52.               #8   : begin
  53.                        dec(loop);
  54.                        if loop < 1 then loop := 1;
  55.                        for dumm := loop to Length-1 do
  56.                          begin
  57.                            temp[dumm] := temp[dumm+1];
  58.                          end;
  59.                        temp[Length] := ' ';
  60.                        GotoXY(X,Y);
  61.                        Write(temp);
  62.                        GotoXY(X+Loop-1,Y);
  63.               end;
  64.               #10  : begin
  65.                        inc(loop);
  66.                        if loop > Length then Loop := Length;
  67.                        for dumm := loop to Length-1 do
  68.                          begin
  69.                            temp[dumm+1] := temp[dumm];
  70.                          end;
  71.                        GotoXY(X,Y);
  72.                        Write(temp);
  73.                        GotoXY(X+Loop-1,Y);
  74.                      end
  75.             else if inch > #31 then
  76.               begin
  77.                 temp[loop] := Inch;
  78.                 GotoXY(X,Y);
  79.                 Write(temp);
  80.                 Inc(Loop);
  81.                 if Loop > Length then Loop := Length;
  82.                 GotoXY(X+Loop-1,Y);
  83.               end;
  84.             end;
  85.         end
  86.         else
  87.           Write(#7);
  88.     end;
  89.   STI_GetStringXY := copy(temp,1,loop);
  90.   TextAttr := OldAttr;
  91. end;
  92.  
  93. {---------------------------------------------------------------------------}
  94.  
  95. function STI_GetByteXY1(X,Y,Min,Max,Color,Attr : byte) : byte;
  96.  
  97. Var
  98.   Inch   : char;
  99.   Value  : byte;
  100.   OldAttr : byte;
  101.  
  102. begin
  103.   OldAttr := TextAttr;
  104.   TextColor(Color+Attr);
  105.   Inch   := #0;
  106.   Value  := Min;
  107.   while Inch <> #13 do
  108.     begin
  109.       GotoXY(X,Y); write(' ',value,' ');
  110.       repeat until keypressed;
  111.       Inch := readkey;
  112.       case Inch of
  113.         #8  : begin
  114.                 if Value > Min then Dec(Value);
  115.               end;
  116.         #12 : begin
  117.                 if Value < Max then Inc(Value);
  118.               end;
  119.       end;{case}
  120.     end;
  121.   STI_GetByteXY1 := Value;
  122.   TextAttr := OldAttr;
  123. end;
  124.  
  125. {---------------------------------------------------------------------------}
  126.  
  127. function STI_GetByteXY2(X,Y,Min,Max,Color,Attr : byte) : byte;
  128.  
  129. Var
  130.   Dummy   : string;
  131.   Value   : word;
  132.   OldAttr : byte;
  133.   Test    : integer;
  134.  
  135. begin
  136.   OldAttr := TextAttr;
  137.   TextColor(Color+Attr);
  138.   repeat
  139.     begin
  140.       Dummy := STI_GetStringXY(X,Y,3,Color,Attr,'0123456789');
  141.       RightTrimStr(Dummy);
  142.       val(Dummy,Value,Test);
  143.       if not((Value >= Min) and (Value <= Max)) then
  144.         Write(#7);
  145.     end;
  146.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  147.   GotoXY(X,Y);
  148.   Write(Value);
  149.   STI_GetByteXY2 := Value;
  150.   TextAttr := OldAttr;
  151. end;
  152.  
  153. {---------------------------------------------------------------------------}
  154.  
  155. function STI_GetWordXY1(X,Y : byte; Min,Max : word; Color,Attr : byte) : word;
  156.  
  157. Var
  158.   Inch    : char;
  159.   Value   : word;
  160.   OldAttr : byte;
  161.  
  162. begin
  163.   OldAttr := TextAttr;
  164.   TextColor(Color+Attr);
  165.   Inch   := #0;
  166.   Value  := Min;
  167.   while Inch <> #13 do
  168.     begin
  169.       GotoXY(X,Y); write(' ',value,' ');
  170.       repeat until keypressed;
  171.       Inch := readkey;
  172.       case Inch of
  173.         #8  : begin
  174.                 if Value > Min then Dec(Value);
  175.               end;
  176.         #12 : begin
  177.                 if Value < Max then Inc(Value);
  178.               end;
  179.       end;{case}
  180.     end;
  181.   STI_GetWordXY1 := Value;
  182.   TextAttr := OldAttr;
  183. end;
  184.  
  185. {---------------------------------------------------------------------------}
  186.  
  187. function STI_GetWordXY2(X,Y : byte; Min,Max : word; Color,Attr : byte) : word;
  188.  
  189. Var
  190.   Dummy   : string;
  191.   Value   : word;
  192.   OldAttr : byte;
  193.   Test    : integer;
  194.  
  195. begin
  196.   OldAttr := TextAttr;
  197.   TextColor(Color+Attr);
  198.   repeat
  199.     begin
  200.       Dummy := STI_GetStringXY(X,Y,5,Color,Attr,'0123456789');
  201.       RightTrimStr(Dummy);
  202.       val(Dummy,Value,Test);
  203.       if not((Value >= Min) and (Value <= Max)) then
  204.         Write(#7);
  205.     end;
  206.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  207.   STI_GetWordXY2 := Value;
  208.   TextAttr := OldAttr;
  209. end;
  210.  
  211. {---------------------------------------------------------------------------}
  212.  
  213. function STI_GetIntXY1(X,Y : byte; Min,Max : integer; Color,Attr : byte) : integer;
  214.  
  215. Var
  216.   Inch    : char;
  217.   Value   : integer;
  218.   OldAttr : byte;
  219.  
  220. begin
  221.   OldAttr := TextAttr;
  222.   TextColor(Color+Attr);
  223.   Inch   := #0;
  224.   Value  := Min;
  225.   while Inch <> #13 do
  226.     begin
  227.       GotoXY(X,Y); write(' ',value,' ');
  228.       repeat until keypressed;
  229.       Inch := readkey;
  230.       case Inch of
  231.         #8  : begin
  232.                 if Value > Min then Dec(Value);
  233.               end;
  234.         #12 : begin
  235.                 if Value < Max then Inc(Value);
  236.               end;
  237.       end;{case}
  238.     end;
  239.   STI_GetIntXY1 := Value;
  240.   TextAttr := OldAttr;
  241. end;
  242.  
  243. {---------------------------------------------------------------------------}
  244.  
  245. function STI_GetIntXY2(X,Y : byte; Min,Max : integer; Color,Attr : byte) : integer;
  246.  
  247. Var
  248.   Dummy   : string;
  249.   Value   : integer;
  250.   OldAttr : byte;
  251.   Test    : integer;
  252.  
  253. begin
  254.   OldAttr := TextAttr;
  255.   TextColor(Color+Attr);
  256.   repeat
  257.     begin
  258.       Dummy := STI_GetStringXY(X,Y,5,Color,Attr,'-0123456789');
  259.       RightTrimStr(Dummy);
  260.       val(Dummy,Value,Test);
  261.       if not((Value >= Min) and (Value <= Max)) then
  262.         Write(#7);
  263.     end;
  264.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  265.   STI_GetIntXY2 := Value;
  266.   TextAttr := OldAttr;
  267. end;
  268.  
  269. {---------------------------------------------------------------------------}
  270.  
  271. function STI_GetLongIntXY1(X,Y : byte; Min,Max : LongInt; Color,Attr : byte) : LongInt;
  272.  
  273. Var
  274.   Inch    : char;
  275.   Value   : LongInt;
  276.   OldAttr : byte;
  277.  
  278. begin
  279.   OldAttr := TextAttr;
  280.   TextColor(Color+Attr);
  281.   Inch   := #0;
  282.   Value  := Min;
  283.   while Inch <> #13 do
  284.     begin
  285.       GotoXY(X,Y); write(' ',value,' ');
  286.       repeat until keypressed;
  287.       Inch := readkey;
  288.       case Inch of
  289.         #8  : begin
  290.                 if Value > Min then Dec(Value);
  291.               end;
  292.         #12 : begin
  293.                 if Value < Max then Inc(Value);
  294.               end;
  295.       end;{case}
  296.     end;
  297.   STI_GetLongIntXY1 := Value;
  298.   TextAttr := OldAttr;
  299. end;
  300.  
  301. {---------------------------------------------------------------------------}
  302.  
  303. function STI_GetLongIntXY2(X,Y : byte; Min,Max : LongInt; Color,Attr : byte) : LongInt;
  304.  
  305. Var
  306.   Dummy   : string;
  307.   Value   : LongInt;
  308.   OldAttr : byte;
  309.   Test    : integer;
  310.  
  311. begin
  312.   OldAttr := TextAttr;
  313.   TextColor(Color+Attr);
  314.   repeat
  315.     begin
  316.       Dummy := STI_GetStringXY(X,Y,11,Color,Attr,'-0123456789');
  317.       RightTrimStr(Dummy);
  318.       val(Dummy,Value,Test);
  319.       if not((Value >= Min) and (Value <= Max)) then
  320.         Write(#7);
  321.     end;
  322.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  323.   STI_GetlongIntXY2 := Value;
  324.   TextAttr := OldAttr;
  325. end;
  326.  
  327. {---------------------------------------------------------------------------}
  328.  
  329. function STI_GetShortIntXY1(X,Y : byte; Min,Max : ShortInt; Color,Attr : byte) : ShortInt;
  330.  
  331. Var
  332.   Inch    : char;
  333.   Value   : ShortInt;
  334.   OldAttr : byte;
  335.  
  336. begin
  337.   OldAttr := TextAttr;
  338.   TextColor(Color+Attr);
  339.   Inch   := #0;
  340.   Value  := Min;
  341.   while Inch <> #13 do
  342.     begin
  343.       GotoXY(X,Y); write(' ',value,' ');
  344.       repeat until keypressed;
  345.       Inch := readkey;
  346.       case Inch of
  347.         #8  : begin
  348.                 if Value > Min then Dec(Value);
  349.               end;
  350.         #12 : begin
  351.                 if Value < Max then Inc(Value);
  352.               end;
  353.       end;{case}
  354.     end;
  355.   STI_GetShortIntXY1 := Value;
  356.   TextAttr := OldAttr;
  357. end;
  358.  
  359. {---------------------------------------------------------------------------}
  360.  
  361. function STI_GetShortIntXY2(X,Y : byte; Min,Max : ShortInt; Color,Attr : byte) : ShortInt;
  362.  
  363. Var
  364.   Dummy   : string;
  365.   Value   : ShortInt;
  366.   OldAttr : byte;
  367.   Test    : integer;
  368.  
  369. begin
  370.   OldAttr := TextAttr;
  371.   TextColor(Color+Attr);
  372.   repeat
  373.     begin
  374.       Dummy := STI_GetStringXY(X,Y,4,Color,Attr,'-0123456789');
  375.       RightTrimStr(Dummy);
  376.       val(Dummy,Value,Test);
  377.       if not((Value >= Min) and (Value <= Max)) then
  378.         Write(#7);
  379.     end;
  380.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  381.   STI_GetShortintXY2 := Value;
  382.   TextAttr := OldAttr;
  383. end;
  384.  
  385. {---------------------------------------------------------------------------}
  386.  
  387. function STI_GetRealXY(X,Y,Width : byte; Min,Max : Real; Color,Attr : byte) : Real;
  388.  
  389. Var
  390.   Dummy   : string;
  391.   Value   : Real;
  392.   OldAttr : byte;
  393.   Test    : integer;
  394.  
  395. begin
  396.   OldAttr := TextAttr;
  397.   TextColor(Color+Attr);
  398.   repeat
  399.     begin
  400.       Dummy := STI_GetStringXY(X,Y,Width,Color,Attr,'-0123456789.Ee');
  401.       RightTrimStr(Dummy);
  402.       val(Dummy,Value,Test);
  403.       if not((Value >= Min) and (Value <= Max)) then
  404.         Write(#7);
  405.     end;
  406.   until ((Value >= Min) and (Value <= Max)) and (Test = 0);
  407.   STI_GetRealXY := Value;
  408.   TextAttr := OldAttr;
  409. end;
  410.  
  411. {---------------------------------------------------------------------------}
  412.  
  413. begin
  414. end.
  415.  
  416.  
  417.  
  418.