home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / entry.swg / 0011_Key Input Routine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  9.1 KB  |  245 lines
  1. > Does anyone know how to make the input line a certain number of lines
  2. > only!...sya the user only gets to us 3 characters....
  3.  
  4. Here is the input routine that I use for all of my programs.  You may
  5. not need it so precise, so you can cut out anything you don't feel is
  6. necessary but here goes:
  7. }
  8.  
  9. UNIT KeyInput;
  10.  
  11. INTERFACE
  12.  
  13. USES CRT,CURSOR;
  14.  
  15. PROCEDURE GetInput(VAR InStr;                    {String Passed}
  16.                        WhatWas: String;          {Old value to Remember}
  17.                        Len: Byte;                {Length of String Max=255}
  18.                        XPosition,                {X Cursor Position}
  19.                        YPosition,                {Y Cursor Position}
  20.                        BackGroundColor,          {Background Color}
  21.                        ForeGroundColor: Integer; {Foreground Color}
  22.                        BackGroundChar: Char;     {Echoed Character on BkSp}
  23.                        Caps: Boolean);           {CAPS?}
  24. IMPLEMENTATION
  25.  
  26. PROCEDURE GetInput(VAR InStr;
  27.                        WhatWas: String;
  28.                        Len: Byte;
  29.                        XPosition,
  30.                        YPosition,
  31.                        BackGroundColor,
  32.                        ForeGroundColor: Integer;
  33.                        BackGroundChar: Char;
  34.                        Caps: Boolean);
  35.  
  36. CONST
  37.    BkSp: Char = Chr($08);
  38.  
  39. VAR
  40.    InsertKey: Byte Absolute $0040:$0017;
  41.    Temp: String;
  42.    Ch2,
  43.    C: Char;
  44.    A,
  45.    U,
  46.    B: Byte;
  47.    FirstChar,
  48.    InsertOn,
  49.    NoAdd: Boolean;
  50.    NewString: String Absolute InStr;
  51.  
  52. BEGIN
  53.    InsertKey := InsertKey OR $80; {changes to insert mode}
  54.    IF (InsertKey AND $80 > 0) THEN
  55.     BEGIN
  56.        InsertOn := TRUE;
  57.        ShowCursor;
  58.     END
  59.    ELSE
  60.     BEGIN
  61.        InsertOn := FALSE;
  62.        BigCursor;
  63.     END;
  64.    FirstChar := TRUE;
  65.    NewString := '';
  66.    Temp := '';
  67.    GotoXY(XPosition,YPosition);
  68.    TextBackGround(BackGroundColor);
  69.    TextColor(ForeGroundColor);
  70.    FOR U := 1 TO Len DO
  71.     BEGIN
  72.        Write(BackGroundChar); {shows how many characters are available}
  73.     END;
  74.    GotoXY(XPosition,YPosition);
  75.    C := Chr($00); {null character input}
  76.    TextBackGround(ForeGroundColor);
  77.    TextColor(BackGroundColor);
  78.    NewString := WhatWas; {starts with previous value in memory}
  79.    Write(NewString); {writes previous value to screen for editing}
  80.    B := Length(WhatWas);
  81.    A := B;
  82.    TextBackGround(BackGroundColor);
  83.    TextColor(ForeGroundColor);
  84.    WHILE (C <> Chr($0D)) AND (C <> Chr($1B)) DO {not CR or ESC}
  85.     BEGIN
  86.        NoAdd := FALSE;
  87.        IF Caps THEN C := UpCase(ReadKey) {if Caps read uppercase else...}
  88.        ELSE C := ReadKey;
  89.        CASE C OF
  90.           Chr($08): IF B >= 1 THEN {backspace}
  91.                      BEGIN
  92.                         IF FirstChar THEN
  93.                          BEGIN
  94.                             FirstChar := FALSE;
  95.                             GotoXY(XPosition,YPosition);
  96.                             Write(NewString);
  97.                          END;
  98.                         Delete(NewString,B,1);
  99.                         Write(BkSp,BackGroundChar,BkSp);
  100.                         Dec(B);
  101.                         GotoXY(XPosition+B,WhereY);
  102.                         FOR U := B TO Length(NewString) DO
  103.                          BEGIN
  104.                             IF B <> U THEN Temp := Temp + NewString[U]
  105.                             ELSE Temp := '';
  106.                          END;
  107.                         Write(Temp);
  108.                         FOR U := Length(NewString)+1 TO Len DO
  109.                          BEGIN
  110.                             Write(BackGroundChar);
  111.                          END;
  112.                         GotoXY(XPosition+B,WhereY);
  113.                         NoAdd := TRUE;
  114.                         Dec(A);
  115.                      END;
  116.           Chr($1B): BEGIN {Escape}
  117.                        NoAdd := TRUE;
  118.                        NewString := WhatWas;
  119.                     END;
  120.           Chr($19): BEGIN {^Y = clear the editing line}
  121.                        NoAdd := TRUE;
  122.                        NewString := '';
  123.                        GotoXY(XPosition,YPosition);
  124.                        FOR U := 1 TO Len DO
  125.                         BEGIN
  126.                            Write(BackGroundChar);
  127.                         END;
  128.                        FirstChar := FALSE;
  129.                        GotoXY(XPosition,YPosition);
  130.                        B := 0;
  131.                        A := 0;
  132.                     END;
  133.           Chr($0D): NoAdd := TRUE; {enter <CR>}
  134.           Chr($00): BEGIN {extended keys always start with null character}
  135.                        NoAdd := TRUE;
  136.                        IF FirstChar THEN
  137.                         BEGIN
  138.                            FirstChar := FALSE;
  139.                            GotoXY(XPosition,YPosition);
  140.                            Write(NewString);
  141.                         END;
  142.                        C := UpCase(ReadKey);
  143.                        CASE C OF
  144.                           Chr(77): BEGIN {right arrow}
  145.                                     IF B <= Length(NewString)-1 THEN
  146.                                      BEGIN
  147.                                         GotoXY(XPosition+B+1,WhereY);
  148.                                         Inc(B);
  149.                                      END;
  150.                                  END;
  151.                           Chr(75): BEGIN {left arrow}
  152.                                       IF B >= 1 THEN
  153.                                        BEGIN
  154.                                           GotoXY(XPosition+B-1,WhereY);
  155.                                           Dec(B);
  156.                                        END;
  157.                                    END;
  158.                           Chr(71): BEGIN {home}
  159.                                       GotoXY(XPosition,YPosition);
  160.                                       B := 0;
  161.                                    END;
  162.                           Chr(79): BEGIN {end}
  163.                                       GotoXY(XPosition+Length(NewString),YPosition);
  164.                                       B := Length(NewString);
  165.                                    END;
  166.                           Chr(82): BEGIN {insert}
  167.                                       IF InsertOn THEN
  168.                                        BEGIN
  169.                                           InsertOn := FALSE;
  170.                                           BigCursor;
  171.                                        END
  172.                                       ELSE
  173.                                        BEGIN
  174.                                           InsertOn := TRUE;
  175.                                           ShowCursor;
  176.                                        END;
  177.                                    END;
  178.                           Chr(83): BEGIN {del}
  179.                                       IF (B < Length(NewString)) AND (B >= 0) THEN
  180.                                        BEGIN
  181.                                           Delete(NewString,B+1,1);
  182.                                           FOR U := B TO Length(NewString) DO
  183.                                            BEGIN
  184.                                               IF U <> B THEN Temp := Temp + NewString[U]
  185.                                               ELSE Temp := '';
  186.                                            END;
  187.                                           GotoXY(XPosition+B,WhereY);
  188.                                           Write(Temp);
  189.                                           Write(BackGroundChar);
  190.                                           GotoXY(XPosition+B,WhereY);
  191.                                           Dec(A);
  192.                                        END;
  193.                                    END;
  194.                        END;
  195.                        WHILE Keypressed DO C := ReadKey;
  196.                     END;
  197.        END;
  198.        IF ((A < Len) AND (NoAdd = FALSE) AND (C <> Chr($08))) OR ((FirstChar) AND
  199.           (NOT(NoAdd)) AND (C <> Chr($08))) THEN
  200.         BEGIN
  201.            IF FirstChar THEN {if first character typed is a real character,then
  202.                              string is removed to start new one else...}
  203.             BEGIN
  204.                Delete(NewString,1,Length(NewString));
  205.                GotoXY(XPosition,YPosition);
  206.                B := 0;
  207.                A := 0;
  208.                FOR U := 1 TO Len DO
  209.                 BEGIN
  210.                    Write(BackGroundChar);
  211.                 END;
  212.                GotoXY(XPosition,YPosition);
  213.                FirstChar := FALSE;
  214.             END;
  215.            Inc(B);
  216.            Inc(A);
  217.            IF InsertOn THEN
  218.             BEGIN
  219.                Insert(C,NewString,B);
  220.                FOR U := B TO Length(NewString) DO
  221.                 BEGIN
  222.                    IF B <> U THEN Temp := Temp + NewString[U]
  223.                    ELSE Temp := '';
  224.                 END;
  225.                GotoXY(XPosition+B-1,WhereY);
  226.                Write(C);
  227.                Write(Temp);
  228.                GotoXY(XPosition+B,WhereY);
  229.             END
  230.            ELSE
  231.             BEGIN
  232.                Insert(C,NewString,B);
  233.                Delete(NewString,B+1,1);
  234.                Write(C)
  235.             END;
  236.         END;
  237.     END;
  238.     TextBackGround(0);
  239. END;
  240.  
  241.  
  242. BEGIN
  243. END.
  244.  
  245.