home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / htscreen / keyboard.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-13  |  5.2 KB  |  171 lines
  1. UNIT KeyBoard;
  2. (*****************************************************************************)
  3. (*                                                                           *)
  4. (*   KeyBoard inneholder to rutiner som gj¢r input fra tastaturet enklere.   *)
  5. (*                                                                           *)
  6. (*****************************************************************************)
  7.  
  8. {-----------------------------------------------------------------------------}
  9. INTERFACE
  10. {-----------------------------------------------------------------------------}
  11.  
  12. USES HtScreen;
  13.  
  14. TYPE  KeyType = (NullKey,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,
  15.                  Return,TabKey,BackSpaceKey,UpArrow,
  16.                  DownArrow,RightArrow,LeftArrow,DelKey,
  17.                  InsertKey,HomeKey,EndKey,TextKey,NumberKey,
  18.                  SpaceKey,PgUp,PgDn,Escape);
  19.    KeySetType = SET OF KeyType;
  20.  
  21. VAR   Key  : KeyType;
  22.       Ch   : CHAR;
  23.       Fk   : BOOLEAN;
  24.       InsertOn : BOOLEAN;
  25.  
  26. PROCEDURE InKey(VAR Ch:CHAR; VAR Fk:BOOLEAN; VAR Key:KeyType);
  27. PROCEDURE InputString(VAR S:STRING; R,C,L:BYTE; Attr:INTEGER; KeySet:KeySetType);
  28.  
  29. {-----------------------------------------------------------------------------}
  30. IMPLEMENTATION
  31. {-----------------------------------------------------------------------------}
  32.  
  33. PROCEDURE InKey(VAR Ch:CHAR; VAR Fk:BOOLEAN; VAR Key:KeyType);
  34. (*****************************************************************************)
  35. (*                                                                           *)
  36. (*   Får en tast fra bruker og returnerer karakt eren. Setter Fk=TRUE hvis   *)
  37. (*   funksjons-tast.  Returnerer også taste-typen.                           *)
  38. (*                                                                           *)
  39. (*****************************************************************************)
  40. BEGIN
  41.   Ch:=HtReadKey(Fk);
  42.   IF Fk THEN
  43.   CASE Ch OF
  44.     #72 : Key:=UpArrow;
  45.     #80 : Key:=DownArrow;
  46.     #82 : Key:=InsertKey;
  47.     #75 : Key:=LeftArrow;
  48.     #77 : Key:=RightArrow;
  49.     #73 : Key:=PgUp;
  50.     #81 : Key:=PgDn;
  51.     #71 : Key:=HomeKey;
  52.     #79 : Key:=EndKey;
  53.     #83 : Key:=DelKey;
  54.     #82 : Key:=InsertKey;
  55.     #59 : Key:=F1;
  56.     #60 : Key:=F2;
  57.     #61 : Key:=F3;
  58.     #62 : Key:=F4;
  59.     #63 : Key:=F5;
  60.     #64 : Key:=F6;
  61.     #65 : Key:=F7;
  62.     #66 : Key:=F8;
  63.     #67 : Key:=F9;
  64.     #68 : Key:=F10;
  65.   END
  66.   ELSE
  67.   CASE Ch OF
  68.      #8 : Key:=BackSpaceKey;
  69.      #9 : Key:=TabKey;
  70.     #13 : Key:=Return;
  71.     #27 : Key:=Escape;
  72.     #32 : Key:=SpaceKey;
  73.     #33..#47,
  74.     #58..#255 : Key:=TextKey;
  75.     #48..#57 : Key:=NumberKey;
  76.   END;
  77. END;
  78.  
  79.  
  80. PROCEDURE InputString(VAR S:STRING; R,C,L:BYTE; Attr:INTEGER; KeySet:KeySetType);
  81. (*****************************************************************************)
  82. (*                                                                           *)
  83. (*   Tillater brukeren å lese inn en streng S ved koordinater X:Y med max    *)
  84. (*   lengde L. Strengen vises i attributtene Attr.                           *)
  85. (*   KeySet er et sett av taster som bestemmer når innlesningen skal stoppes.*)
  86. (*                                                                           *)
  87. (*****************************************************************************)
  88. CONST Fill : CHAR = #0;
  89. VAR   P : BYTE;
  90.       I,J : WORD;
  91.       Ch : CHAR;
  92.       Fk : BOOLEAN;
  93. BEGIN
  94.   InsertOn := FALSE;
  95.   I:=Length(S)+1;
  96.   IF I>L THEN
  97.     S:=Copy(S,1,L)
  98.   ELSE BEGIN
  99.     FOR J:=I TO L DO
  100.       S[J]:=Fill;
  101.     S[0]:=Chr(L);
  102.   END;
  103.   P:=1;
  104.   REPEAT
  105.     HtWrite(R,C,Attr,S);
  106.     GoToRC(R,C+P-1);
  107.     IF InsertOn THEN
  108.       SetCursor(CursorBlock)
  109.     ELSE SetCursor(CursorUnderline);
  110.     InKey(Ch,Fk,Key);
  111.     SetCursor(CursorOff);
  112.     CASE Key OF
  113.       TextKey,
  114.       NumberKey,
  115.       SpaceKey : BEGIN
  116.                    IF InsertOn THEN
  117.                    BEGIN
  118.                      Insert(Ch,S,P);
  119.                      S[0]:=Chr(L);
  120.                      IF P<L THEN
  121.                      Inc(P);
  122.                    END
  123.                    ELSE BEGIN
  124.                      S[P]:=Ch;
  125.                      IF P<L THEN
  126.                      Inc(P);
  127.                    END;
  128.                  END;
  129.       InsertKey: BEGIN
  130.                    InsertOn:= NOT InsertOn;
  131.                  END;
  132.       DelKey   : BEGIN
  133.                    Delete(S,P,1);
  134.                    S:=S+Fill;
  135.                  END;
  136.       LeftArrow: BEGIN
  137.                    IF P>1 THEN
  138.                    Dec(P);
  139.                  END;
  140.       RightArrow:BEGIN
  141.                    IF (Pos(Fill,S)>0) THEN
  142.                    BEGIN
  143.                      IF (P<Pos(Fill,S)) THEN
  144.                      Inc(P);
  145.                    END
  146.                    ELSE IF (P<L) THEN
  147.                      Inc(P);
  148.                  END;
  149.     HomeKey     :P := 1;
  150.     EndKey      :P := Pos(Fill,S);
  151.     BackSpaceKey:BEGIN
  152.                    IF P>1 THEN
  153.                    BEGIN
  154.                      Dec(P);
  155.                      Delete(S,P,1);
  156.                      S:=S+Fill;
  157.                    END;
  158.                  END;
  159.     END;
  160.   UNTIL Key IN KeySet;
  161.   I:=Pos(Fill,S);
  162.   IF I>0 THEN
  163.     S:=Copy(S,1,I-1);
  164. END;
  165.  
  166.  
  167. BEGIN
  168.   InsertOn:=FALSE;
  169.   Key:=NullKey;
  170. END.
  171.