home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 02 / keys_etc / statkeys.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-09-02  |  3.9 KB  |  153 lines
  1. {STATKEYS.PAS}
  2. PROGRAM StatusKeys;
  3. {
  4. Description:  Program to demonstrate the use of user-provided keyboard
  5.               routines to detect and display the status of NumLock,
  6.               ScrollLock, CapsLock and Insert/Overwrite toggles on
  7.               the IBM PC.
  8.  
  9. Author:       Don Taylor
  10. Date:         7/16/87
  11. Last revised: 12/03/1987  17:42:20
  12. Application:  IBM PC or compatible with DOS 2.0 or greater
  13. }
  14.  
  15. USES DOS, Crt;
  16.  
  17. TYPE
  18.  Str80     = STRING[80];
  19.  
  20. VAR
  21.  ch          : CHAR;
  22.  s           : Str80;
  23.  ExtendedKey : BOOLEAN;
  24.  StatusByte  : BYTE ABSOLUTE $0000:$0417;
  25.  TheStatus   : BYTE;
  26.  
  27. {--------------------}
  28.  
  29. PROCEDURE UpdateStatusDisplay;
  30.  
  31. CONST
  32.  StatusLine   =  24;
  33.  
  34. VAR
  35.  XPosn         : INTEGER;
  36.  YPosn         : INTEGER;
  37.  InsertOn      : BOOLEAN;
  38.  CapsLock      : BOOLEAN;
  39.  NumLock       : BOOLEAN;
  40.  ScrollLock    : BOOLEAN;
  41.  StatusMessage : Str80;
  42.  
  43. BEGIN
  44.  XPosn      := WhereX;                      { Remember cursor position  }
  45.  YPosn      := WhereY;
  46.  InsertOn   := (TheStatus AND $08) <> 0;    { Detect status of switches }
  47.  CapsLock   := (TheStatus AND $04) <> 0;
  48.  NumLock    := (TheStatus AND $02) <> 0;
  49.  ScrollLock := (TheStatus AND $01) <> 0;
  50.  NormVideo;
  51.  IF InsertOn
  52.   THEN StatusMessage := 'Insert   '
  53.   ELSE StatusMessage := 'Overwrite';
  54.  GOTOXY(20,StatusLine); WRITE(StatusMessage);
  55.  IF CapsLock
  56.   THEN StatusMessage := 'Caps Lock'
  57.   ELSE StatusMessage := '         ';
  58.  GOTOXY(35,StatusLine); WRITE(StatusMessage);
  59.  IF NumLock
  60.   THEN StatusMessage := 'Num Lock'
  61.   ELSE StatusMessage := '        ';
  62.  GOTOXY(50,StatusLine); WRITE(StatusMessage);
  63.  IF ScrollLock
  64.   THEN StatusMessage := 'Scroll Lock'
  65.   ELSE StatusMessage := '           ';
  66.  GOTOXY(65,StatusLine); WRITE(StatusMessage);
  67.  GOTOXY(XPosn,YPosn)                        { Restore cursor            }
  68. END;  {UpdateStatusDisplay}
  69.  
  70. {--------------------}
  71.  
  72. FUNCTION ScanKey : CHAR;
  73.  
  74. CONST
  75.  KeyboardIntr = $16;
  76.  
  77. VAR
  78.  n           : INTEGER;
  79.  GotKey      : BOOLEAN;
  80.  KeyboardRec : Registers;
  81.  
  82. BEGIN
  83.  REPEAT
  84.   IF TheStatus <> StatusByte SHR 4          { See if status changed     }
  85.    THEN BEGIN                               { If so, update screen      }
  86.          TheStatus := StatusByte SHR 4;
  87.          UpdateStatusDisplay
  88.         END;
  89.  UNTIL KeyPressed;
  90.  KeyboardRec.AX := 0;                       { Read keyboard when key is }
  91.  INTR(KeyboardIntr, KeyboardRec);           { finally pressed           }
  92.  n := LO(KeyboardRec.AX);
  93.  ExtendedKey := (n = 0);                    { Mark extended keycodes    }
  94.  IF ExtendedKey THEN n := HI(KeyboardRec.AX);
  95.  ScanKey := CHR(n)
  96. END;  {ScanKey}
  97.  
  98. {--------------------}
  99.  
  100. FUNCTION ReadLine : Str80;
  101.  
  102. CONST
  103.  BS = ^H;     { ASCII Backspace       }
  104.  CR = ^M;     { ASCII Carriage Return }
  105.  
  106. VAR
  107.  RLch : CHAR;
  108.  Lin  : Str80;
  109.  
  110. BEGIN
  111.  Lin       := '';
  112.  TheStatus := 0;             { Assume all status clear, but display }
  113.  UpdateStatusDisplay;        { status anyway                        }
  114.  REPEAT
  115.   REPEAT
  116.     RLch := ScanKey
  117.   UNTIL NOT ExtendedKey;
  118.   IF (RLch = BS) AND (LENGTH(Lin) >= 1)
  119.    THEN BEGIN                { Handle backspace key }
  120.          IF LENGTH(Lin) > 0
  121.           THEN WRITE(BS,' ',BS)
  122.           ELSE WRITE(' ',BS);
  123.          DELETE(Lin,LENGTH(Lin),1)
  124.         END;
  125.   IF (RLch IN [' '..'~'])    { Handle printable characters }
  126.    THEN BEGIN
  127.          WRITE(RLch);
  128.          Lin := CONCAT(Lin,RLch)
  129.         END;
  130.  UNTIL RLch = CR;
  131.  ReadLine := Lin
  132. END;  {ReadLine}
  133.  
  134. {====================}
  135.  
  136. BEGIN {StatusKeys}
  137.  ClrScr;
  138.  WRITELN('Special Key Demo ----------');
  139.  LowVideo;
  140.  GOTOXY(1,10);  WRITE('Enter a string: ');
  141.  s := ReadLine;
  142.  LowVideo;
  143.  GOTOXY(1,10); ClrEOL;
  144.  GOTOXY(1,5); WRITE('String entered: "', s,'"');
  145.  NormVideo;
  146.  GOTOXY(24,12); WRITE('(Press "X" to exit...)');
  147.  REPEAT
  148.   GOTOXY(78,24);
  149.   ch := ScanKey;
  150.  UNTIL ch IN ['X','x'];
  151.  GOTOXY(1,12); ClrEOL
  152. END.  {StatusKeys}
  153.