[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]

    (* This keyboard input unit will compile on ALL versions of TP & BP from
       Version 5.0 to Ver 7.0 - you can easily recode the interrupts in BASM
       for users of TP & BP versions that support BASM *)

    (* This unit provided by Pedt Scragg 101322,2153. Part of a forthcoming
       Pascal Toolbox for Real and Protected Mode programmers for Turbo &
       Borland Pascal Programmers - versions 5.0 to 8.0 *)

    unit ExtKey;

    interface

    uses dos, crt;

    (* No keyboard code*)

    Const   KbNoKey         = chr(0);

    (* Keyboard Timeout *)

            KbTimeOut       = chr(255);

    (* Normal Keycodes returned in FirstCode *)

            KbCtrlA         = chr(1);
            KbCtrlB         = chr(2);
            KbCtrlC         = chr(3);
            KbCtrlD         = chr(4);
            KbCtrlE         = chr(5);
            KbCtrlF         = chr(6);
            KbCtrlG         = chr(7);
            KbCtrlH         = chr(8);
            KbCtrlI         = chr(9);
            KbTab           = chr(9);
            KbCtrlJ         = chr(10);
            KbCtrlK         = chr(11);
            KbCtrlL         = chr(12);
            KbCtrlM         = chr(13);
            KbEnter         = chr(13);
            KbCtrlN         = chr(14);
            KbCtrlO         = chr(15);
            KbCtrlP         = chr(16);
            KbCtrlQ         = chr(17);
            KbCtrlR         = chr(18);
            KbCtrlS         = chr(19);
            KbCtrlT         = chr(20);
            KbCtrlU         = chr(21);
            KbCtrlV         = chr(22);
            KbCtrlW         = chr(23);
            KbCtrlX         = chr(24);
            KbCtrlY         = chr(25);
            KbCtrlZ         = chr(26);
            KbEsc           = chr(27);
            KbLeftBracket   = chr(27);
            KbRightBracket  = chr(29);
            KbCtrl6         = chr(30);
            KbCtrlMinus     = chr(31);
            KbSpace         = chr(32);

    (* Extended Keycodes from all keyboards *)

            KbCtrl2         = chr(3);
            KbShiftTab      = chr(15);
            KbAltQ          = chr(16);
            KbAltW          = chr(17);
            KbAltE          = chr(18);
            KbAltR          = chr(19);
            KbAltT          = chr(20);
            KbAltY          = chr(21);
            KbAltU          = chr(22);
            KbAltI          = chr(23);
            KbAltO          = chr(24);
            KbAltP          = chr(25);
            KbAltA          = chr(30);
            KbAltS          = chr(31);
            KbAltD          = chr(32);
            KbAltF          = chr(33);
            KbAltG          = chr(34);
            KbAltH          = chr(35);
            KbAltJ          = chr(36);
            KbAltK          = chr(37);
            KbAltL          = chr(38);
            KbAltZ          = chr(44);
            KbAltX          = chr(45);
            KbAltC          = chr(46);
            KbAltV          = chr(47);
            KbAltB          = chr(48);
            KbAltN          = chr(49);
            KbAltM          = chr(50);
            KbF1            = chr(59);
            KbF2            = chr(60);
            KbF3            = chr(61);
            KbF4            = chr(62);
            KbF5            = chr(63);
            KbF6            = chr(64);
            KbF7            = chr(65);
            KbF8            = chr(66);
            KbF9            = chr(67);
            KbF10           = chr(68);
            KbHome          = chr(71);
            KbUpArrow       = chr(72);
            KbPageUp        = chr(73);
            KbLeftArrow     = chr(75);
            KbRightArrow    = chr(77);
            KbEnd           = chr(79);
            KbDownArrow     = chr(80);
            KbPageDown      = chr(81);
            KbInsert        = chr(82);
            KbDelete        = chr(83);
            KbShiftF1       = chr(84);
            KbShiftF2       = chr(85);
            KbShiftF3       = chr(86);
            KbShiftF4       = chr(87);
            KbShiftF5       = chr(88);
            KbShiftF6       = chr(89);
            KbShiftF7       = chr(90);
            KbShiftF8       = chr(91);
            KbShiftF9       = chr(92);
            KbShiftF10      = chr(93);
            KbCtrlF1        = chr(94);
            KbCtrlF2        = chr(95);
            KbCtrlF3        = chr(96);
            KbCtrlF4        = chr(97);
            KbCtrlF5        = chr(98);
            KbCtrlF6        = chr(99);
            KbCtrlF7        = chr(100);
            KbCtrlF8        = chr(101);
            KbCtrlF9        = chr(102);
            KbCtrlF10       = chr(103);
            KbAltF1         = chr(104);
            KbAltF2         = chr(105);
            KbAltF3         = chr(106);
            KbAltF4         = chr(107);
            KbAltF5         = chr(108);
            KbAltF6         = chr(109);
            KbAltF7         = chr(110);
            KbAltF8         = chr(111);
            KbAltF9         = chr(112);
            KbAltF10        = chr(113);
            KbCtrlPrint     = chr(114);
            KbCtrlLeftArrow = chr(115);
            KbCtrlRightArrow= chr(116);
            KbCtrlEnd       = chr(117);
            KbCtrlPageDown  = chr(118);
            KbCtrlHome      = chr(119);
            KbAlt1          = chr(120);
            KbAlt2          = chr(121);
            KbAlt3          = chr(122);
            KbAlt4          = chr(123);
            KbAlt5          = chr(124);
            KbAlt6          = chr(125);
            KbAlt7          = chr(126);
            KbAlt8          = chr(127);
            KbAlt9          = chr(128);
            KbAlt0          = chr(129);
            KbAltMinus      = chr(130);
            KbAltEquals     = chr(131);
            KbCtrlPageUp    = chr(132);

    (* Extended Keycodes from Enhanced Keyboards *)

            KbAltBackSpace  = chr(14);
            KbAltLeftBracket= chr(26);
            KbAltRightBracket=chr(27);
            KbAltEnter      = chr(28);
            KbAltSemiColon  = chr(39);
            KbAltPound      = chr(43);
            KbAltComma      = chr(51);
            KbAltFullStop   = chr(53);
            KbAltKeyPadStar = chr(55);
            KbAltKeyPadMinus= chr(74);
            KbAltKeyPadPlus = chr(78);
            KbF11           = chr(133);
            KbF12           = chr(134);
            KbShiftF11      = chr(135);
            KbShiftF12      = chr(136);
            KbCtrlF11       = chr(137);
            KbCtrlF12       = chr(138);
            KbAltF11        = chr(139);
            KbAltF12        = chr(140);
            KbCtrlUpArrow   = chr(141);
            KbCtrlKeyPadMinus=chr(142);
            KbCtrlKeyPad5   = chr(143);
            KbCtrlKeyPadPlus= chr(144);
            KbCtrlDownArrow = chr(145);
            KbCtrlInsert    = chr(146);
            KbCtrlDelete    = chr(147);
            KbCtrlTab       = chr(148);
            KbCtrlKeyPadSlash=chr(149);
            KbCtrlKeyPadStar= chr(150);
            KbAltHome       = chr(151);
            KbAltUpArrow    = chr(152);
            KbAltPageUp     = chr(153);
            KbAltLeftArrow  = chr(155);
            KbAltRightArrow = chr(157);
            KbAltEnd        = chr(159);
            KbAltDownArrow  = chr(160);
            KbAltPageDown   = chr(161);
            KbAltInsert     = chr(162);
            KbAltDelete     = chr(163);
            KbAltKeyPadSlash= chr(164);
            KbAltTab        = chr(165);
            KbAltKeyPadEnter= chr(166);

    (* End of Enhanced Keycodes *)

            keyb_head : ^integer = ptr($40,$1A);
            keyb_tail : ^Integer = ptr($40,$1C);
            keyb_buff : ^char    = ptr($40,$0);
            keyb_start: ^integer = ptr($40,$80);
            keyb_end  : ^integer = ptr($40,$82);

    var     IsEnhanced : boolean;

    Procedure NextKey(var FirstCode,ExtendedCode:char);
    Procedure KeyCode(var FirstCode,ExtendedCode:char);
    Procedure Keywait;
    Procedure FlushKeys;
    Procedure WaitKey(Time:word);
    Procedure DelayKey(Time:word;var Firstcode,ExtendedCode:Char);

    implementation

    VAR
        ShiftState : Byte ABSOLUTE $40:$17;

    (* EnhancedKeyboard returns TRUE is an enhanced keyboard is present
       and FALSE if not present. Note this will return FALSE is an enhanced
       keyboard is present but the BIOS cannot handle it. The function result
       is available outside the unit in the IsEnhanced boolean variable *)

    FUNCTION EnhancedKeyboard : Boolean;
    VAR StateFrom16 : Byte;
    var regs : registers;
    BEGIN
      EnhancedKeyboard := FALSE;
      regs.ah := $12;
      intr($16,regs);
      statefrom16 := regs.al;
      IF StateFrom16 <> ShiftState THEN Exit;
      ShiftState := ShiftState XOR $20;
      regs.ah := $12;
      intr($16,regs);
      statefrom16 := regs.al;
      EnhancedKeyboard := StateFrom16 = ShiftState;
      ShiftState := ShiftState XOR $20;
    END;

    (* KeyWait will wait for a keypress then discard it *)

    Procedure KeyWait;
    begin
    if IsEnhanced then Inline($B4/$11/$CD/$16/$74/$06/$B4/$10/$CD/$16/$EB/$F4/$B4/$10/$CD/$16) else
                       Inline($B4/$01/$CD/$16/$74/$06/$B4/$00/$CD/$16/$EB/$F4/$B4/$00/$CD/$16)
    end;

    (* Keypress works like the crt unit keypressed function and, if an enhanced
       keyboard is not available, will call the crt unit. This was programmed
       in case there is an enhanced keyboard but the BIOS cannot handle it. The
       buffer *may* contain the extended keycode but the BIOS would never
       recognise it when the ReadKey or this unit's KeyCode procedure was called *)

    function KeyPress : boolean;
    var fpkeyhead, fpkeytail : pointer;
    begin
         if IsEnhanced then
         begin
              fpkeyhead := keyb_head;
              fpkeytail := keyb_tail;
              KeyPress := (integer(fpkeytail^) <> integer(fpkeyhead^));
         end
         else
             KeyPress := CRT.KeyPressed;
    end;

    (* Quickest way to flush the keyboard buffer is to set the pointers
       to the keyboard to read the same value *)

    procedure FlushKeys;
    var fpkeyhead, fpkeytail : pointer;
    begin
          inline($FA);
          fpkeyhead := keyb_head;
          fpkeytail := keyb_tail;
          integer(fpkeyhead^) := integer(fpkeytail^);
          inline($FB);
    end;

    (* KeyCode reads the keyboard for the next key pressed and returns the values
       in FirstCode and ExtendedCode. If the key is a normal key, then ExtendedCode
       is set to #0 and FirstCode contains the character from the keyboard.

       If FirstCode is #0 then an Extended Code has been input and the Scan Code
       will be found in the ExtendedCode variable

       If there is no key waiting, KeyCode will wait for the next key pressed.

       Note that this procedure returns both normal codes and extended codes
       within one procedure and you do not need to call the procedure twice to
       get extended codes like when using the CRT ReadKey function. *)

    procedure KeyCode(var FirstCode,ExtendedCode : char);
    var regs:registers;
    begin
         if IsEnhanced then regs.ah := $10 else regs.ah := $00;
         Intr($16,regs);
         if regs.al = 224 then regs.al := $00;
         if regs.al > $00 then regs.ah := $00;
         if regs.ax = 0 then regs.al := 224;
         FirstCode := chr(regs.al);
         ExtendedCode := chr(regs.ah);
    end;

    (* NextKey will read the next key pressed as with the KeyCode procedure
       above. However, if there is no key waiting in the buffer, both
       FirstCode and ExtendedCode will be set to #255 *)

    Procedure NextKey(var FirstCode,ExtendedCode:char);
    var regs:registers;
    begin
         if IsEnhanced then regs.ah := $11 else regs.ah := $01;
         Intr($16,regs);
         if (regs.flags and fzero <> 0) then regs.ax := $FFFF;
         if regs.al = 224 then regs.al := $00;
         if regs.al > $00 then regs.ah := $00;
         if regs.ax = 0 then regs.al := 224;
         FirstCode := chr(regs.al);
         ExtendedCode := chr(regs.ah);
    end;

    (* DelayKey waits for specified time in milliseconds. If a key is pressed
       within the time specified then the FirstCode and ExtendedCode will
       have the Key pressed (see KeyCode above). If no key was pressed within the
       time, both FirstCode and ExtendedCode will have the #255 (KbTimeOut) code *)

    Procedure DelayKey(Time:word;var Firstcode,ExtendedCode:Char);
    var count : word;
    begin
         FlushKeys;
         Time := Time div 10;
         count := 1;
         Firstcode := #255; ExtendedCode := #255;
         While count < Time do
         begin
             Delay(10);
             inc(count);
             If KeyPress then
             begin
                 count := Time;
                 KeyCode(FirstCode,ExtendedCode);
             end;
         end;
    end;

    (* WaitKey waits for the specified time or when a key is pressed if the
       key is pressed earlier than the specified time in milliseconds. The
       keystroke is thrown away *)

    Procedure WaitKey(Time:word);
    var count : word;
    begin
         Flushkeys;
         time := time div 10;
         count := 1;
         While count < time do
         begin
              delay(10);
              inc(count);
              If KeyPress then count := time;
              FlushKeys;
         end;
    end;

    begin
         IsEnhanced := EnhancedKeyboard;
    end.

    { ----------------------- DEMO --------------- CUT HERE ---------- }
    program KeyTest;

    uses ExtKey;

    var Key1, Key2 : char;

    begin
         Write('Extended Keyboard is ');
         If not IsEnhanced then Write('not ');
         Writeln('available');

         Key1 := #0;
         Key2 := #0;

         Writeln;
         Writeln('Press the ESC to end or press any key combination to get '+
                 'Key pressed');

         While Key1 <> KbEsc do
         begin
              KeyCode(Key1,Key2);
              if Key1 = KbNoKey then
                   Writeln('Extended Key, value = ',ord(Key2))
              else
              if Key1 < KbSpace then
                   Writeln('Normal Key - Control Key, ESC or Bracket')
              else
                   Writeln('Normal Key - key is "',Key1,'"');
         end;
    end.

[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]