home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / UNITS.ZIP / KEYBOARD.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-06-19  |  9.7 KB  |  257 lines
  1. unit KeyBoard;
  2. {$O+,F+}
  3. {┌──────────────────────────────────────────────────────────────────────────┐}
  4. {│                                                                          │}
  5. {│   File    : KEYBOARD.PAS                                                 │}
  6. {│   Author  : Harald Thunem                                                │}
  7. {│   Purpose : Keyboard routines                                            │}
  8. {│   Updated : February 16 1992                                             │}
  9. {│                                                                          │}
  10. {└──────────────────────────────────────────────────────────────────────────┘}
  11.  
  12. {──────────────────────────────────────────────────────────────────────}
  13. interface
  14. {──────────────────────────────────────────────────────────────────────}
  15.  
  16. uses Screen,Dos;
  17.  
  18. type KeyType = (NullKey,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,
  19.  
  20.                 ShiftF1,ShiftF2,ShiftF3,ShiftF4,ShiftF5,ShiftF6,
  21.                 ShiftF7,ShiftF8,ShiftF9,ShiftF10,ShiftF11,ShiftF12,
  22.  
  23.                 Alt0,Alt1,Alt2,Alt3,Alt4,
  24.                 Alt5,Alt6,Alt7,Alt8,Alt9,
  25.  
  26.                 AltF1,AltF2,AltF3,AltF4,AltF5,AltF6,
  27.                 AltF7,AltF8,AltF9,AltF10,AltF11,AltF12,
  28.  
  29.                 CtrlF1,CtrlF2,CtrlF3,CtrlF4,CtrlF5,CtrlF6,
  30.                 CtrlF7,CtrlF8,CtrlF9,CtrlF10,CtrlF11,CtrlF12,
  31.  
  32.                 AltA,AltB,AltC,AltD,AltE,AltF,AltG,AltH,AltI,
  33.                 AltJ,AltK,AltL,AltM,AltN,AltO,AltP,AltQ,AltR,
  34.                 AltS,AltT,AltU,AltV,AltW,AltX,AltY,AltZ,
  35.  
  36.                 CtrlA,CtrlB,CtrlC,CtrlD,CtrlE,CtrlF,CtrlG,CtrlH,CtrlI,
  37.                 CtrlJ,CtrlK,CtrlL,CtrlM,CtrlN,CtrlO,CtrlP,CtrlQ,CtrlR,
  38.                 CtrlS,CtrlT,CtrlU,CtrlV,CtrlW,CtrlX,CtrlY,CtrlZ,
  39.  
  40.                 Return,TabKey,BackSpace,UpArrow,
  41.                 DownArrow,RightArrow,LeftArrow,DelKey,
  42.                 InsKey,HomeKey,EndKey,TextKey,NumberKey,
  43.                 Space,PgUp,PgDn,Escape,
  44.  
  45.                 AltReturn,AltTabKey,AltBackSpace,AltUpArrow,
  46.                 AltDownArrow,AltRightArrow,AltLeftArrow,
  47.                 AltHomeKey,AltEndKey,AltSpace,AltPgUp,AltPgDn,AltEscape,
  48.  
  49.                 CtrlReturn,CtrlTabKey,CtrlBackSpace,CtrlUpArrow,
  50.                 CtrlDownArrow,CtrlRightArrow,CtrlLeftArrow,CtrlDelKey,
  51.                 CtrlHomeKey,CtrlEndKey,CtrlPgUp,CtrlPgDn,CtrlInsKey);
  52.  
  53.      KeySetType = SET OF KeyType;
  54.  
  55. var  Key      : KeyType;
  56.      Ch       : char;
  57.      InsertOn : boolean;
  58.  
  59. procedure ReadAscii(var CharCode,ScanCode: byte);
  60. procedure InKey(var Ch:char; var Key:KeyType);
  61. procedure InputString(var S:string; R,C,L:byte; Attr:integer; KeySet:KeySetType);
  62.  
  63. {──────────────────────────────────────────────────────────────────────}
  64. implementation
  65. {──────────────────────────────────────────────────────────────────────}
  66.  
  67. var  Regs     : registers;
  68.  
  69. procedure ReadAscii(var CharCode,ScanCode: byte);
  70. begin
  71.   CharCode := $00;
  72.   ScanCode := $00;
  73.   FillChar(Regs,SizeOf(Regs),0);
  74.   Regs.AH := $10;
  75.   Intr($16,Regs);
  76.   CharCode := Regs.al;
  77.   ScanCode := Regs.ah;
  78. end;
  79.  
  80.  
  81. procedure InKey(var Ch:char; var Key:KeyType);
  82. var CC,SC: byte;
  83.     Ascii: word;
  84. begin
  85.   Key := NullKey;
  86.   ReadAscii(CC,SC);
  87.   Ascii := 256*CC+SC;
  88.   Ch    := Chr(CC);
  89.   case Ascii of
  90.     $1B01: Key:=Escape;        $0D1C: Key:=Return;
  91.     $0DE0: Key:=Return;
  92.     $E048: Key:=UpArrow;       $E050: Key:=DownArrow;
  93.     $0048: Key:=UpArrow;       $0050: Key:=DownArrow;
  94.     $E04B: Key:=LeftArrow;     $E04D: Key:=RightArrow;
  95.     $004B: Key:=LeftArrow;     $004D: Key:=RightArrow;
  96.     $E049: Key:=PgUp;          $E051: Key:=PgDn;
  97.     $0049: Key:=PgUp;          $0051: Key:=PgDn;
  98.     $E047: Key:=HomeKey;       $E04F: Key:=EndKey;
  99.     $0047: Key:=HomeKey;       $004F: Key:=EndKey;
  100.     $090F: Key:=TabKey;        $E052: Key:=InsKey;
  101.     $0052: Key:=InsKey;        $080E: Key:=BackSpace;
  102.     $E053: Key:=DelKey;        $0053: Key:=DelKey;
  103.     $2039: Key:=Space;
  104.  
  105.     $0001: Key:=AltEscape;
  106.     $001C: Key:=AltReturn;        $00A6: Key:=AltReturn;
  107.     $0098: Key:=AltUpArrow;       $00A0: Key:=AltDownArrow;
  108.     $0800: Key:=AltUpArrow;       $0200: Key:=AltDownArrow;
  109.     $009B: Key:=AltLeftArrow;     $009D: Key:=AltRightArrow;
  110.     $0400: Key:=AltLeftArrow;     $0600: Key:=AltRightArrow;
  111.     $0099: Key:=AltPgUp;          $00A1: Key:=AltPgDn;
  112.     $0300: Key:=AltPgUp;          $0900: Key:=AltPgDn;
  113.     $0097: Key:=AltHomeKey;       $009F: Key:=AltEndKey;
  114.     $0700: Key:=AltHomeKey;       $0100: Key:=AltEndKey;
  115.     $00A5: Key:=AltTabKey;        $0002: Key:=AltSpace;
  116.  
  117.     $0A1C: Key:=CtrlReturn;        $0AE0: Key:=CtrlReturn;
  118.     $E08D: Key:=CtrlUpArrow;       $E091: Key:=CtrlDownArrow;
  119.     $008D: Key:=CtrlUpArrow;       $0091: Key:=CtrlDownArrow;
  120.     $E073: Key:=CtrlLeftArrow;     $E074: Key:=CtrlRightArrow;
  121.     $0073: Key:=CtrlLeftArrow;     $0074: Key:=CtrlRightArrow;
  122.     $E084: Key:=CtrlPgUp;          $E076: Key:=CtrlPgDn;
  123.     $0084: Key:=CtrlPgUp;          $0076: Key:=CtrlPgDn;
  124.     $E077: Key:=CtrlHomeKey;       $E075: Key:=CtrlEndKey;
  125.     $0077: Key:=CtrlHomeKey;       $0075: Key:=CtrlEndKey;
  126.     $0094: Key:=CtrlTabKey;        $E092: Key:=CtrlInsKey;
  127.     $E093: Key:=CtrlDelKey;
  128.  
  129.     $003B: Key:=F1;         $003C: Key:=F2;         $003D: Key:=F3;
  130.     $003E: Key:=F4;         $003F: Key:=F5;         $0040: Key:=F6;
  131.     $0041: Key:=F7;         $0042: Key:=F8;         $0043: Key:=F9;
  132.     $0044: Key:=F10;        $0045: Key:=F11;        $0046: Key:=F12;
  133.  
  134.     $0054: Key:=ShiftF1;    $0055: Key:=ShiftF2;    $0056: Key:=ShiftF3;
  135.     $0057: Key:=ShiftF4;    $0058: Key:=ShiftF5;    $0059: Key:=ShiftF6;
  136.     $005A: Key:=ShiftF7;    $005B: Key:=ShiftF8;    $005C: Key:=ShiftF9;
  137.     $005D: Key:=ShiftF10;   $005E: Key:=ShiftF11;   $005F: Key:=ShiftF12;
  138.  
  139.     $0068: Key:=AltF1;      $0069: Key:=AltF2;      $006A: Key:=AltF3;
  140.     $006B: Key:=AltF4;      $006C: Key:=AltF5;      $006D: Key:=AltF6;
  141.     $006E: Key:=AltF7;      $006F: Key:=AltF8;      $0070: Key:=AltF9;
  142.     $0071: Key:=AltF10;     $0072: Key:=AltF11;     $0073: Key:=AltF12;
  143.  
  144.     $005E: Key:=CtrlF1;     $005F: Key:=CtrlF2;     $0060: Key:=CtrlF3;
  145.     $0061: Key:=CtrlF4;     $0062: Key:=CtrlF5;     $0063: Key:=CtrlF6;
  146.     $0064: Key:=CtrlF7;     $0065: Key:=CtrlF8;     $0066: Key:=CtrlF9;
  147.     $0067: Key:=CtrlF10;    $0068: Key:=CtrlF11;    $0069: Key:=CtrlF12;
  148.  
  149.     $0081: Key:=Alt0;     $0078: Key:=Alt1;     $0079: Key:=Alt2;
  150.     $007A: Key:=Alt3;     $007B: Key:=Alt4;     $007C: Key:=Alt5;
  151.     $007D: Key:=Alt6;     $007E: Key:=Alt7;     $007F: Key:=Alt8;
  152.     $0080: Key:=Alt9;
  153.  
  154.     $001E: Key:=AltA;     $0030: Key:=AltB;     $002E: Key:=AltC;
  155.     $0020: Key:=AltD;     $0012: Key:=AltE;     $0021: Key:=AltF;
  156.     $0022: Key:=AltG;     $0023: Key:=AltH;     $0017: Key:=AltI;
  157.     $0024: Key:=AltJ;     $0025: Key:=AltK;     $0026: Key:=AltL;
  158.     $0032: Key:=AltM;     $0031: Key:=AltN;     $0018: Key:=AltO;
  159.     $0019: Key:=AltP;     $0010: Key:=AltQ;     $0013: Key:=AltR;
  160.     $001F: Key:=AltS;     $0014: Key:=AltT;     $0016: Key:=AltU;
  161.     $002F: Key:=AltV;     $0011: Key:=AltW;     $002D: Key:=AltX;
  162.     $0015: Key:=AltY;     $002C: Key:=AltZ;
  163.  
  164.     $011E: Key:=CtrlA;     $0130: Key:=CtrlB;     $012E: Key:=CtrlC;
  165.     $0120: Key:=CtrlD;     $0112: Key:=CtrlE;     $0121: Key:=CtrlF;
  166.     $0122: Key:=CtrlG;     $0123: Key:=CtrlH;     $0117: Key:=CtrlI;
  167.     $0124: Key:=CtrlJ;     $0125: Key:=CtrlK;     $0126: Key:=CtrlL;
  168.     $0132: Key:=CtrlM;     $0131: Key:=CtrlN;     $0118: Key:=CtrlO;
  169.     $0119: Key:=CtrlP;     $0110: Key:=CtrlQ;     $0113: Key:=CtrlR;
  170.     $011F: Key:=CtrlS;     $0114: Key:=CtrlT;     $0116: Key:=CtrlU;
  171.     $012F: Key:=CtrlV;     $0111: Key:=CtrlW;     $012D: Key:=CtrlX;
  172.     $0115: Key:=CtrlY;     $012C: Key:=CtrlZ;
  173.   end;
  174.   if (CC in [$21..$A5]) then Key:=TextKey;
  175.   if (CC in [$30..$39]) then Key:=NumberKey;
  176. end;
  177.  
  178.  
  179. procedure InputString(var S:string; R,C,L:byte; Attr:integer; KeySet:KeySetType);
  180. const Fill: char = #0;
  181. var   P   : byte;
  182.       I,J : word;
  183. begin
  184.   InsertOn := false;
  185.   I:=Length(S)+1;
  186.   if I>L then
  187.     S:=Copy(S,1,L)
  188.   else begin
  189.     for J:=I to L do
  190.       S[J]:=Fill;
  191.     S[0]:=Chr(L);
  192.   end;
  193.   P:=1;
  194.   repeat
  195.     WriteStr(R,C,Attr,S);
  196.     GoToRC(R,C+P-1);
  197.     if InsertOn then
  198.       SetCursor(CursorBlock)
  199.     else SetCursor(CursorUnderline);
  200.     InKey(Ch,Key);
  201.     SetCursor(CursorOff);
  202.     case Key of
  203.       TextKey,
  204.       NumberKey,
  205.       Space    : begin
  206.                    if InsertOn then
  207.                    begin
  208.                      Insert(Ch,S,P);
  209.                      S[0]:=Chr(L);
  210.                      if P<L then
  211.                      Inc(P);
  212.                    end
  213.                    else begin
  214.                      S[P]:=Ch;
  215.                      if P<L then
  216.                      Inc(P);
  217.                    end;
  218.                  end;
  219.       InsKey   : begin
  220.                    InsertOn:= not InsertOn;
  221.                  end;
  222.       DelKey   : begin
  223.                    Delete(S,P,1);
  224.                    S:=S+Fill;
  225.                  end;
  226.       LeftArrow: begin
  227.                    if P>1 then
  228.                    Dec(P);
  229.                  end;
  230.       RightArrow:begin
  231.                    if (Pos(Fill,S)>0) then
  232.                    begin
  233.                      if (P<Pos(Fill,S)) then
  234.                      Inc(P);
  235.                    end
  236.                    else if (P<L) then
  237.                      Inc(P);
  238.                  end;
  239.     HomeKey     :P := 1;
  240.     EndKey      :P := Pos(Fill,S);
  241.     BackSpace   :begin
  242.                    if P>1 then
  243.                    begin
  244.                      Dec(P);
  245.                      Delete(S,P,1);
  246.                      S:=S+Fill;
  247.                    end;
  248.                  end;
  249.     end;
  250.   until Key in KeySet;
  251.   I:=Pos(Fill,S);
  252.   if I>0 then
  253.     S:=Copy(S,1,I-1);
  254. end;
  255.  
  256. end.
  257.