home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / turbo55 / install / tcalc.arc / TCINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-02  |  10KB  |  334 lines
  1.  
  2. { Copyright (c) 1989 by Borland International, Inc. }
  3.  
  4. unit TCInput;
  5. { Turbo Pascal 5.5 object-oriented example input routines.
  6.   This unit is used by TCALC.PAS.
  7.   See TCALC.DOC for an more information about this example.
  8. }
  9.  
  10. {$S-}
  11.  
  12. interface
  13.  
  14. uses Crt, TCUtil, TCScreen, TCLStr;
  15.  
  16. const
  17.   LeftInputArrow = #17;
  18.   RightInputArrow = #16;
  19.   YesNo = 'Y/N';
  20.   LegalYesNo = ['Y', 'N'];
  21.   AllUpper = True;
  22.   NotUpper = False;
  23.   ErrNumberError1 = 'You must enter a number from ';
  24.   ErrNumberError2 = ' to ';
  25.   ErrColumnError1 = 'You must enter a column from ';
  26.   ErrColumnError2 = ' to ';
  27.   ErrCellError = 'You must enter a legal cell';
  28.  
  29. type
  30.   InputField = object
  31.     StartCol : ScreenColRange;
  32.     StopCol : Integer;
  33.     InputRow : Integer;
  34.     MaxInputLen : Word;
  35.     Quit : Boolean;
  36.     InputData : LStringPtr;
  37.     UCase : Boolean;
  38.     InputArea : ScreenArea;
  39.     constructor Init(C1 : ScreenColRange; C2 : Integer; R : Integer;
  40.                      InitMaxInputLen : Word; InitUCase : Boolean);
  41.     destructor Done;
  42.     function GetQuit : Boolean;
  43.     procedure Edit(StartCursor : Word);
  44.     procedure ClearInput;
  45.   end;
  46.  
  47. function ReadString(Prompt : String; Len : Word;
  48.                     var ESCPressed : Boolean) : String;
  49.  
  50. function GetLegalChar(Prompt : String; Legal : CharSet;
  51.                       var ESCPressed : Boolean) : Char;
  52.  
  53. function GetYesNo(Prompt : String; var ESCPressed : Boolean) : Boolean;
  54.  
  55. function GetNumber(Prompt : String; Low, High : Longint;
  56.                    var Result : Boolean) : Longint;
  57.  
  58. implementation
  59.  
  60. constructor InputField.Init(C1 : ScreenColRange; C2 : Integer; R : Integer;
  61.                             InitMaxInputLen : Word; InitUCase : Boolean);
  62. { Sets up an input field }
  63. begin
  64.   InputData := New(LStringPtr, Init);
  65.   if InputData = nil then
  66.     Fail;
  67.   StartCol := C1;
  68.   StopCol := C2;
  69.   InputRow := R;
  70.   if InitMaxInputLen = 0 then
  71.     MaxInputLen := 65521      { Maximum area that a pointer can allocate }
  72.   else
  73.     MaxInputLen := InitMaxInputLen;
  74.   UCase := InitUCase;
  75.   Quit := False;
  76. end; { InputField.Init }
  77.  
  78. destructor InputField.Done;
  79. { Remove memory used by an input field }
  80. begin
  81.   Dispose(InputData, Done);
  82. end; { InputField.Done }
  83.  
  84. function InputField.GetQuit : Boolean;
  85. { Check to see if an input field has been exited with ESC }
  86. begin
  87.   GetQuit := Quit;
  88. end; { InputField.GetQuit }
  89.  
  90. procedure InputField.Edit(StartCursor : Word);
  91. { Edits the input field }
  92. var
  93.   CursorPos, Start, Cursor : Word;
  94.   Ch : Word;
  95.   Good, InsMode, Finished : Boolean;
  96.   R : ScreenRowRange;
  97.   SCol, ECol, EndCol : ScreenColRange;
  98. begin
  99.   with InputData^ do
  100.   begin
  101.     Quit := False;
  102.     SCol := StartCol;         { Figure out where the field starts and stops }
  103.     if StopCol <= 0 then
  104.       EndCol := Scr.CurrCols + StopCol
  105.     else
  106.       EndCol := StopCol;
  107.     if InputRow <= 0 then
  108.       R := Scr.CurrRows + InputRow
  109.     else
  110.       R := InputRow;
  111.     if (R = Scr.CurrRows) and (ECol = Scr.CurrCols) then
  112.       Dec(EndCol);
  113.     ECol := EndCol;
  114.     InputArea.Init(SCol, R, ECol, R, Colors.InputColor);
  115.     InputArea.Clear;
  116.     if StartCursor = 0 then
  117.       CursorPos := Succ(Length)
  118.     else
  119.       CursorPos := StartCursor;
  120.     Finished := False;
  121.     InsMode := True;
  122.     Cursor := Scr.InsCursor;
  123.     Start := Max(Longint(CursorPos) - ECol - SCol + 2, 1);
  124.     repeat
  125.       if CursorPos > Length then
  126.         ECol := EndCol;
  127.       if (CursorPos < Start) or (CursorPos > Start + ECol - SCol) then
  128.         Start := Max(Longint(CursorPos) - ECol + SCol, 1);
  129.       if (Start = 2) and (SCol <> StartCol) then
  130.       begin
  131.         SCol := StartCol;
  132.         Start := 1;
  133.       end;
  134.       if Start > 1 then
  135.       begin
  136.         if SCol = StartCol then
  137.         begin
  138.           Inc(Start);
  139.           SCol := Succ(StartCol);    { Text is off left side of line }
  140.         end;
  141.       end
  142.       else
  143.         SCol := StartCol;
  144.       if Length > Start + ECol - SCol then
  145.       begin
  146.         if ECol = EndCol then
  147.         begin
  148.           if SCol <> StartCol then
  149.             Inc(Start);
  150.           ECol := Pred(EndCol);       { Text is off right side of line }
  151.         end;
  152.       end
  153.       else
  154.         ECol := EndCol;
  155.       GotoXY(StartCol, R);
  156.       if SCol <> StartCol then        { Text is off left side of line }
  157.         WriteColor(LeftInputArrow, Colors.InputArrowColor);
  158.       WriteColor(LeftJustStr(InputData^.Copy(Start, Succ(ECol - SCol)),
  159.                  Succ(ECol - SCol)), Colors.InputColor);
  160.       if ECol <> EndCol then          { Text is off right side of line }
  161.         WriteColor(RightInputArrow, Colors.InputArrowColor);
  162.       GotoXY(CursorPos - Start + SCol, R);
  163.       SetCursor(Cursor);
  164.       Ch := GetKey;
  165.       SetCursor(NoCursor);
  166.       case Ch of
  167.         Ord(' ')..Ord('~') : begin
  168.           if not (InsMode and (Length = MaxInputLen)) then
  169.           begin
  170.             if UCase then
  171.               Ch := Ord(UpCase(Chr(Ch)));
  172.             if InsMode or (CursorPos > Length) then
  173.               Good := Insert(Chr(Ch), CursorPos)
  174.             else begin
  175.               Good := True;
  176.               Change(Chr(Ch), CursorPos);
  177.             end;
  178.             if Good then
  179.               Inc(CursorPos);
  180.           end;
  181.         end;
  182.         HomeKey : CursorPos := 1;
  183.         EndKey : CursorPos := Succ(Length);
  184.         BS : begin
  185.           if CursorPos > 1 then
  186.           begin
  187.             Delete(Pred(CursorPos), 1);
  188.             Dec(CursorPos);
  189.           end;
  190.         end;
  191.         DelKey : begin
  192.           if CursorPos <= Length then
  193.             Delete(CursorPos, 1);
  194.         end;
  195.         LeftKey : begin
  196.           if CursorPos > 1 then
  197.             Dec(CursorPos);
  198.         end;
  199.         RightKey : begin
  200.           if CursorPos <= Length then
  201.             Inc(CursorPos);
  202.         end;
  203.         InsKey : begin
  204.           InsMode := not InsMode;
  205.           if InsMode then
  206.             Cursor := Scr.InsCursor
  207.           else
  208.             Cursor := Scr.OldCursor;
  209.         end;
  210.         CtrlLeftKey : begin    { Move back one word }
  211.           if (CursorPos > 1) and (Data^[CursorPos] <> ' ') then
  212.             Dec(CursorPos);
  213.           while (CursorPos > 1) and (Data^[CursorPos] = ' ') do
  214.             Dec(CursorPos);
  215.           while (CursorPos > 1) and (Data^[Pred(CursorPos)] <> ' ') do
  216.             Dec(CursorPos);
  217.         end;
  218.         CtrlRightKey : begin   { Move forward one word }
  219.           while (CursorPos <= Length) and (Data^[CursorPos] <> ' ') do
  220.             Inc(CursorPos);
  221.           while (CursorPos <= Length) and (Data^[CursorPos] = ' ') do
  222.             Inc(CursorPos);
  223.         end;
  224.         ESC : begin
  225.           ClearInput;
  226.           Quit := True;
  227.           Finished := True;
  228.         end;
  229.         CR : Finished := True;
  230.       end; { case }
  231.     until Finished;
  232.   end; { with }
  233. end; { InputField.Edit }
  234.  
  235. procedure InputField.ClearInput;
  236. { Makes the input field data a null long string }
  237. var
  238.   Good : Boolean;
  239. begin
  240.   Good := InputData^.FromString('');
  241. end; { InputField.ClearInput }
  242.  
  243. function ReadString(Prompt : String; Len : Word;
  244.                     var ESCPressed : Boolean) : String;
  245. { Read a string from the input area }
  246. var
  247.   I : InputField;
  248. begin
  249.   with I do
  250.   begin
  251.     if not Init(Length(Prompt) + 3, 0, -1, Len, NotUpper) then
  252.     begin
  253.       ESCPressed := True;
  254.       ReadString := '';
  255.     end;
  256.     WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
  257.     Edit(0);
  258.     ReadString := InputData^.ToString;
  259.     ESCPressed := GetQuit;
  260.     Done;
  261.   end; { with }
  262.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  263. end; { ReadString }
  264.  
  265. function GetLegalChar(Prompt : String; Legal : CharSet;
  266.                       var ESCPressed : Boolean) : Char;
  267. { Read a chanracter from the input area, only reading certain ones }
  268. var
  269.   Ch : Char;
  270. begin
  271.   WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
  272.   Ch := GetKeyChar(Legal);
  273.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  274.   GetLegalChar := Ch;
  275. end; { GetLegalChar }
  276.  
  277. function GetYesNo(Prompt : String; var ESCPressed : Boolean) : Boolean;
  278. { Prints a "Yes/No" prompt, allowing the user to type Y or N to answer the
  279.   question }
  280. var
  281.   Ch : Char;
  282. begin
  283.   WriteXY(Prompt + ' (' + YesNo + ')?', 1, Pred(Scr.CurrRows),
  284.               Colors.PromptColor);
  285.   Ch := GetKeyChar(LegalYesNo);
  286.   ESCPressed := Ch = Chr(ESC);
  287.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  288.   GetYesNo := Ch = 'Y';
  289. end; { GetYesNo }
  290.  
  291. function GetNumber(Prompt : String; Low, High : Longint;
  292.                    var Result : Boolean) : Longint;
  293. { Prompts for a numeric value within a certain range }
  294. var
  295.   I : InputField;
  296.   S : String;
  297.   Error : Integer;
  298.   L : Longint;
  299. begin
  300.   with I do
  301.   begin
  302.     if not Init(Length(Prompt) + 3, 0, -1,
  303.                 Max(Length(NumToString(Low)),
  304.                     Length(NumToString(High))), NotUpper) then
  305.     begin
  306.       Result := False;
  307.       GetNumber := 0;
  308.       Exit;
  309.     end;
  310.     WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
  311.     repeat
  312.       Edit(0);
  313.       S := InputData^.ToString;
  314.       if (not GetQuit) and (S <> '') then
  315.       begin
  316.         Val(S, L, Error);
  317.         Result := (Error = 0) and (L >= Low) and (L <= High);
  318.         if not Result then
  319.           Scr.PrintError(ErrNumberError1 + NumToString(Low) +
  320.                          ErrNumberError2 + NumToString(High));
  321.       end
  322.       else begin
  323.         Result := False;
  324.         L := 0;
  325.       end;
  326.     until Result or (S = '');
  327.     Done;
  328.   end; { with }
  329.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  330.   GetNumber := L;
  331. end; { GetNumber }
  332.  
  333. end.
  334.