home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / KB_V02.ZIP / KB_V02.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-10-18  |  5.4 KB  |  148 lines
  1.   {========================================================================}
  2.   {                                                                        }
  3.   { If you find these procedures/functions useful, please help support the }
  4.   { SHAREWARE system by sending a small donation ( up to $5 ) to help with }
  5.   { my college education. Reguardless of a donation, use these routines in }
  6.   { good health (and with a clear concious), I hope you find them useful.  }
  7.   {                                                                        }
  8.   {                                                                        }
  9.   { Send Any Replies To:  EUROPA Software                                  }
  10.   {                       314 Pleasant Meadows Dr.                         }
  11.   {                       Gaffney, SC 29340                                }
  12.   {                                                                        }
  13.   { Program: KB_v02                                Last Revised: 11/21/89  }
  14.   {                                                                        }
  15.   { Author: J.E. Clary                                                     }
  16.   {                                                                        }
  17.   { Using ALL of these routines increases the .EXE by only 336 bytes.      }
  18.   {                                                                        }
  19.   { Implementation: Turbo Pascal v.4.0 & v.5.0                             }
  20.   {                                                                        }
  21.   { Purpose:                                                               }
  22.   {                                                                        }
  23.   { This UNIT is to provide direct access to the Keyboard status byte.     }
  24.   { It is intended to use while running under MS-DOS. The unit will not    }
  25.   { function properly, if at all, when running under OS/2. This is because }
  26.   { low-memory access is denied under OS/2 to protect the Operating System.}
  27.   { If you need these functions under OS/2 they are easily accesible by    }
  28.   { calling OS Interrupt 9, which returns status bytes 40:17h and 40:18h   }
  29.   { 'leagally'. The UNIT is written to carry as little excess baggage as   }
  30.   { possible ( only 16 bytes in constants and work variables ) and execute }
  31.   { as fast as possible. This is achieved by directly addressing the key-  }
  32.   { board status byte instead of calling the Operating System.             }
  33.   {                                                                        }
  34.   {=========================   DISCALIMER   ===============================}
  35.   {                                                                        }
  36.   {                                                                        }
  37.   {   These routines are provided AS IS. EUROPA Software, nor any of its   }
  38.   {   employees shall be held liable for any incidental or consequential   }
  39.   {   damage attributed to the use, or inability to use this product.      }
  40.   {                                                                        }
  41.   {                                                                        }
  42.   {========================================================================}
  43.  
  44. unit KB_v02;
  45.  
  46.    INTERFACE
  47.  
  48.    const   Right_Shift     = 0;    { Key_To_Check Constants  }
  49.            Left_Shift      = 1;
  50.            Control_Key     = 2;
  51.            Alt_key         = 3;
  52.  
  53.            Scroll_Lock_Key = 4;    { Key_To_Set Constants    }
  54.            Number_Lock_Key = 5;
  55.            Caps_Lock_Key   = 6;
  56.  
  57.            State_Off       = 0;    {  Action Constants       }
  58.            State_On        = 1;
  59.            State_Toggle    = 2;
  60.  
  61.  
  62.    function Is_Key_Pressed( Key_To_Check  :  byte )  :  boolean;
  63.  
  64.    procedure Set_Keyboard_State( Key_To_Set, Action  :  byte );
  65.    procedure Save_Keyboard_Status;
  66.    procedure Restore_Keyboard_Status;
  67.    procedure Clear_Type_Ahead_Buffer;
  68.  
  69.  
  70.  
  71.    IMPLEMENTATION
  72.  
  73.  
  74.    var Hold_Keyboard_Status, Or_Mask, And_Mask  :  byte;
  75.  
  76.        kb_stat   :  byte absolute $0:$417;  { Keyboard Status Byte }
  77.        tail_buf  :  byte absolute $0:$41C;  { Tail of Circular KB Buffer }
  78.        head_buf  :  byte absolute $0:$41A;  { Head of Circular KB Buffer }
  79.  
  80.  
  81.    procedure Clear_Type_Ahead_Buffer;
  82.  
  83.       begin
  84.  
  85.          tail_buf := head_buf;
  86.  
  87.       end;
  88.  
  89.  
  90.  
  91.    procedure Save_Keyboard_Status;
  92.  
  93.       begin
  94.  
  95.          Hold_Keyboard_Status := kb_stat;
  96.  
  97.       end;
  98.  
  99.  
  100.  
  101.    procedure Restore_Keyboard_Status;
  102.  
  103.       begin
  104.  
  105.          kb_stat := Hold_Keyboard_Status;
  106.  
  107.       end;
  108.  
  109.  
  110.  
  111.    function Is_Key_Pressed( Key_To_Check  :  byte )  :  boolean;
  112.  
  113.       begin
  114.  
  115.          Or_Mask := (1 SHL Key_To_Check);
  116.          Is_Key_Pressed := ((kb_stat AND Or_Mask) = Or_Mask);
  117.  
  118.       end;
  119.  
  120.  
  121.  
  122.    procedure Set_Keyboard_State(  Key_to_Set, Action  :  byte );
  123.  
  124.       begin
  125.  
  126.          Or_Mask  := 1 SHL Key_To_Set;
  127.          And_Mask := (NOT Or_Mask);
  128.  
  129.          case Action of
  130.  
  131.               0: kb_stat := kb_stat AND And_Mask;          {  Off   }
  132.               1: kb_stat := kb_stat OR   Or_Mask;          {  On    }
  133.  
  134.               2: if ( kb_stat AND Or_Mask) = Or_Mask then  { Toggle }
  135.                       kb_stat := (kb_stat AND And_Mask)
  136.                  else kb_stat := (kb_stat  OR  Or_Mask);
  137.  
  138.              end;
  139.  
  140.       end;
  141.  
  142.  
  143.  
  144.    begin  { UNIT Initialization Code }
  145.  
  146.       Hold_Keyboard_Status := 0;
  147.  
  148.    end.