home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST0912.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-20  |  6.7 KB  |  208 lines
  1. Unit EditTool;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   Crt;
  7.  
  8. Type
  9.   FilterType = Set of Char;
  10.  
  11. Var
  12.   filter : FilterType;
  13.  
  14. Function ReadString ( x, y, max : Byte ) : String;
  15.  
  16. Procedure BlankXY ( x, y, max : Byte );
  17.  
  18. Procedure ResetFilter;
  19.  
  20. Implementation
  21.  
  22. Const
  23.   Blank : String = '                                                                               ';
  24.   BackSpace = #08; { Backspace key }
  25.   Enter     = #13; { Return/Enter key }
  26.   CTRL_Y    = #25; { Control - Y }
  27.   Ins       = #82; { Insert (INS) key }
  28.   Del       = #83; { Delete (DEL) key }
  29.   LeftArr   = #75; { Left arrow }
  30.   RightArr  = #77; { Right arrow }
  31.   HomePos   = #71; { Home key }
  32.   EndPos    = #79; { End key }
  33.  
  34. Var
  35.   inpSt    : String; { Input string variable }
  36.   ch       : Char;   { Dummy character variable }
  37.   cp       : Byte;   { Current pointer inside input field }
  38.   xPos,              { Global X position of input field }
  39.   yPos,              { Global Y position of input field }
  40.   maxChars : Byte;   { Maximum characters to be input }
  41.  
  42. Procedure BlankLine;
  43. { This procedure will write a blank line to the screen at the input }
  44. { field location, for maxChars.                                     }
  45. Begin
  46.   blank [ 0 ] := Chr ( maxChars );
  47.   GotoXY ( xPos, yPos );
  48.   Write ( blank );
  49.   GotoXY ( xPos, yPos );
  50. End;
  51.  
  52. Procedure BlankXY;
  53. Var
  54.   storeAttr : Word;
  55. Begin
  56.   storeAttr := TextAttr;
  57.   TextColor ( Black );
  58.   TextBackground ( LightGray );
  59.   xPos := x;
  60.   yPos := y;
  61.   maxChars := max;
  62.   BlankLine;
  63.   TextAttr := storeAttr;
  64. End;
  65.  
  66. Procedure DisplayString;
  67. { This procedure will write the input string to the screen at the }
  68. { field location, and preserve the cursor position.               }
  69. Var
  70.   xTmp,
  71.   yTmp : Byte;
  72. Begin
  73.   xTmp := WhereX;
  74.   yTmp := WhereY;
  75.   BlankLine;
  76.   Write ( inpSt );
  77.   GotoXY ( cp + xPos - 1, yTmp );
  78. End;
  79.  
  80. Procedure ResetFilter;
  81. Begin
  82.   filter := [#32..#255];
  83. End;
  84.  
  85. Function ProcessChar ( funcKey : Boolean; ch : Char ): Boolean;
  86. { This function will process the character passed in through CH and }
  87. { take appropriate actions. If the character determines the end of  }
  88. { input for that line, the function will return TRUE.               }
  89. Var
  90.   endInput : Boolean;
  91. Begin
  92.   endInput := FALSE;
  93.   Case ch of
  94.     BackSpace : Begin                         { Destructive backspace }
  95.                   Delete ( inpSt, cp-1, 1 );  { -delete char before CP }
  96.                   Dec ( cp );                 { -decrement the CP }
  97.                   If ( cp < 1 ) Then
  98.                     cp := 1;
  99.                   DisplayString;              { -display the new string }
  100.                 End;
  101.     Enter     : Begin                         { End of line input }
  102.                   endInput := TRUE;
  103.                 End;
  104.     CTRL_Y    : Begin                         { Delete entire line }
  105.                   BlankLine;                  { -draw blank line }
  106.                   cp := 1;                    { -reset the CP }
  107.                   inpSt := '';                { -reset the input string }
  108.                 End;
  109.     Ins       : If funcKey Then               { Insert a blank space }
  110.                 Begin
  111.                   Insert ( ' ', inpSt, cp );  { -insert the space char }
  112.                   If ( Length ( inpSt ) > maxChars ) Then { dont insert past }
  113.                     inpSt [ 0 ] := Chr ( maxChars );      { maxChars! }
  114.                   DisplayString;              { -display the new string }
  115.                 End;
  116.     Del       : If funcKey Then               { Delete character at CP }
  117.                 Begin
  118.                   Delete ( inpSt, cp, 1 );    { -delete char at CP }
  119.                   DisplayString;              { -display the new string }
  120.                 End;
  121.     HomePos   : If funcKey Then               { Move to start of string }
  122.                 Begin
  123.                   cp := 1;                    { -reset the CP }
  124.                   GotoXY ( cp + xPos -1, yPos ); { -reset the cursor }
  125.                 End;
  126.     EndPos    : If funcKey Then               { Move to the end of the string }
  127.                 Begin
  128.                    cp := Ord ( inpSt [ 0 ] ); { -set the CP to string length }
  129.                    GotoXY ( cp + xPos, yPos ); { -move the cursor }
  130.                 End;
  131.     LeftArr   : If funcKey Then               { Move cursor left one char }
  132.                 Begin
  133.                   Dec ( cp );                 { -decrement the CP }
  134.                   If cp < 1 Then              { -if at start of line, }
  135.                     cp := 1;                  {  stay there           }
  136.                   GotoXY ( cp + xPos - 1, yPos ); { -move the cursor }
  137.                 End;
  138.     RightArr  : If funcKey Then               { Move cursor right one char }
  139.                 Begin
  140.                   Inc ( cp );                 { -increase the CP }
  141.                   If cp > Ord ( inpSt [ 0 ] ) Then { -if at end of string, }
  142.                     cp := Ord ( inpSt [ 0 ] ) + 1; {  stay there           }
  143.                   GotoXY ( cp + xPos - 1, yPos );  { -move the cursor }
  144.                 End;
  145.   End;
  146.   ProcessChar := EndInput;
  147. End;
  148.  
  149. Procedure GetLine;
  150. Var
  151.   func,
  152.   terminator : Boolean;   { loop control variable }
  153. Begin
  154.   cp := 1;                { initialize the CP }
  155.   terminator := FALSE;    { initialize the loop control variable }
  156.   Repeat
  157.     ch := Readkey;        { get keypress from user }
  158.     func := FALSE;        { initialize function key variable }
  159.     If ( ch = #0 ) Then   { check for an extended key press...}
  160.     Begin
  161.       ch := ReadKey;
  162.       func := TRUE        { An extended key was pressed }
  163.     End
  164.     Else
  165.     If ( ch in filter ) Then   { is it a valid character? }
  166.     Begin
  167.       inpSt [ cp ] := ch;             { insert character at CP }
  168.       If ( cp > Ord ( inpSt [ 0 ] ) ) Then   { appending to end of string? }
  169.         inpSt [ 0 ] := Chr ( Ord ( inpSt [ 0 ] ) + 1 ); { yes,increase length }
  170.       Inc ( cp );                     { increase the CP }
  171.       Write ( ch );                   { display the character }
  172.       If ( cp > maxChars ) Then       { have we past the maximum # of chars? }
  173.       Begin
  174.         Dec ( cp );                   { Yes, decrease the CP }
  175.         GotoXY ( cp + xPos - 1, yPos ); { move the cursor }
  176.       End;
  177.     End;
  178.     terminator := ProcessChar ( func, ch ); { process the key press }
  179.   Until terminator;
  180. End;
  181.  
  182. Procedure EditLine;
  183. { This procedure sets up the input field and attributes }
  184. Var
  185.   storeAttr : Word;
  186. Begin
  187.   inpSt := '';
  188.   storeAttr := TextAttr;
  189.   TextColor ( Black );
  190.   TextBackground ( White );
  191.   BlankLine;
  192.   GetLine;
  193.   TextAttr := storeAttr;
  194. End;
  195.  
  196. Function ReadString;
  197. Begin
  198.   xPos := x;
  199.   yPos := y;
  200.   maxChars := max;
  201.   EditLine;
  202.   ReadString := inpSt;
  203. End;
  204.  
  205. Begin
  206.   ResetFilter;
  207. End.
  208.