home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tricks / scansend / scansend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-01  |  6.6 KB  |  217 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      SCANSEND.PAS                      *)
  3. (*   Residente Utility zur Bestimmung von Tastaturcodes   *)
  4. (*          (c) 1991 Martin Wölker & DMV-Verlag           *)
  5. (* ------------------------------------------------------ *)
  6. {$M 1024,0,0}
  7. PROGRAM Scansend;
  8.  
  9. {.$DEFINE Noise}
  10.  
  11. USES Crt, Tsr, Dos;
  12.  
  13. CONST
  14.   HotKey    : WORD        = $6700;
  15.   HotString : STRING [15] = '<Ctrl-F10>';
  16.   Mode      : BYTE        = 0;
  17.   OutMode   : BYTE        = 0;
  18.  
  19.   Hex       : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  20.  
  21. TYPE
  22.   OutRec    = RECORD
  23.     C    : WORD;               { Tastatur-Scancode         }
  24.     n    : STRING [15];        { Name der Taste            }
  25.     dBc  : STRING [ 4];        { dBase-Code für INKEY()    }
  26.     dBr  : STRING [ 4];        { dBase-Code für READKEY()  }
  27.   END;
  28.  
  29. CONST
  30.   MaxRes = 114;       { Anzahl der decodierten Tastencodes }
  31.  
  32. {$I Code.TAB}
  33.  
  34. TYPE
  35.   tLine   = ARRAY [1..80] OF WORD;
  36.   tScreen = ARRAY [1..25] OF tLine;
  37.  
  38. CONST
  39.   Status  : ARRAY [0..3] OF STRING [25] = (
  40.      ('    Taste --> Scancode     '),
  41.      ('    Taste --> Name         '),
  42.      ('    Taste --> dBase-Code   '),
  43.      ('    Taste --> dBase-Read   ')      );
  44.  
  45. VAR
  46.   ScreenSeg  : ^tScreen;
  47.   SavedLine  : tLine;
  48.   Regs       : Registers;
  49.   SysX, SysY : BYTE;
  50.   Res        : WORD;
  51.   i, Nr      : BYTE;
  52.   RetCode    : INTEGER;
  53.   StrCode    : STRING [3];
  54.  
  55.   FUNCTION GetKey : WORD;
  56.     (* Eine Taste auslesen *)
  57.   BEGIN
  58.     Regs.AH := Mode;  Intr($16, Regs);  GetKey := Regs.AX;
  59.   END;
  60.  
  61.   PROCEDURE KBD_Write(Key : CHAR);
  62.     (* Ein Zeichen in den Puffer schreiben *)
  63.   BEGIN
  64.     Regs.AH := 5;  Regs.CX := BYTE(Key);  Intr($16, Regs);
  65.   END;
  66.  
  67.   PROCEDURE SaveScreen;
  68.     (* Bildschirminhalt und Cursorposition retten *)
  69.   BEGIN
  70.     Move(ScreenSeg^, SavedLine, 160);
  71.     SysX := WhereX; SysY := WhereY;
  72.   END;
  73.  
  74.   PROCEDURE RestoreScreen;
  75.     (* Bildschirm, Cursorposition und Videomodus  *)
  76.     (* restaurieren                               *)
  77.   BEGIN
  78.     Move(SavedLine, ScreenSeg^, 160);
  79.     GotoXY(SysX, SysY); NormVideo;
  80.   END;
  81.  
  82.   PROCEDURE Beep;
  83.   BEGIN
  84.     Sound(1000);  Delay(10);  NoSound;
  85.   END;
  86.  
  87.   FUNCTION Which : BOOLEAN;
  88.     (* ermittelt die gewünschte Nr. aus der Tabelle *)
  89.   BEGIN
  90.     Nr := 1;
  91.     WHILE (Nr <= MaxRes) AND (Res <> CodeTab[Nr].C) DO
  92.       INC(Nr);
  93.  
  94.       { Fehler bei unbekanntem Code erzeugen }
  95.  
  96.     IF (OutMode = 3) AND (CodeTab[Nr].dBr = '?') THEN
  97.       Nr := SUCC(MaxRes);
  98.     Which := NOT (Nr > MaxRes);
  99.   END;
  100.  
  101. {$F+}
  102.   PROCEDURE SelectKey;
  103.   BEGIN
  104.     SaveScreen;
  105.     TextBackground(LightGray);  TextColor(Brown);
  106.     REPEAT
  107.       GotoXY(27, 1);
  108.       Write(Status[OutMode]);
  109.       GotoXY(SysX, SysY);
  110.       Res := GetKey;                    { wiederholtes Drücken }
  111.       IF Res = HotKey THEN              { des Hotkeys schaltet }
  112.                                         { die Ausgabeart um.   }
  113.         OutMode := (OutMode + 1) MOD 4; 
  114.     UNTIL Res <> HotKey;
  115.  
  116.     IF OutMode = 0 THEN BEGIN
  117.                 { Ausgabe der Taste als hexadezimaler Scancode }
  118.       KBD_Write('$');
  119.       KBD_Write(Hex[Hi(Res) AND $F0 SHR 4]);
  120.       KBD_Write(Hex[Hi(Res) AND $0F]);
  121.       KBD_Write(Hex[Lo(Res) AND $F0 SHR 4]);
  122.       KBD_Write(Hex[Lo(Res) AND $0F]);
  123.     END ELSE BEGIN
  124.       IF (Lo(Res) < 32) OR (Lo(Res) > 127) OR
  125.          (OutMode = 3) THEN
  126.                     { kein normales Textzeichen oder READKEY() }
  127.         IF Which THEN BEGIN
  128.           CASE OutMode OF
  129.             1 :                 { Ausgabe der Taste als String }
  130.               FOR i := 1 TO Length(CodeTab[Nr].n) DO
  131.                 KBD_Write(CodeTab[Nr].n[i]);
  132.             2 :                 { Ausgabe für dBase INKEY()    }
  133.               FOR i := 1 TO Length(CodeTab[Nr].dBc) DO
  134.                 KBD_Write(CodeTab[Nr].dBc[i]);
  135.             3 :                 { Ausgabe für dBase READKEY()  }
  136.               FOR i := 1 TO Length(CodeTab[Nr].dBr) DO
  137.                 KBD_Write(CodeTab[Nr].dBr[i]);
  138.           END;
  139.         END ELSE
  140.           {$IFDEF Noise} Beep; {$ENDIF}
  141.       ELSE IF (OutMode = 1) THEN BEGIN
  142.         KBD_Write(#39);
  143.         KBD_Write(CHR(Lo(Res)));
  144.         KBD_Write(#39);
  145.       END ELSE BEGIN
  146.         Str(Lo(Res), StrCode);
  147.         FOR i := 1 TO Length(StrCode) DO
  148.           KBD_Write(StrCode[i]);
  149.       END;
  150.     END;
  151.     RestoreScreen;
  152.   END;
  153. {$F-}
  154.  
  155. (* ------------------------------------------------------ *)
  156. (* Installationsteil                                      *)
  157. (*                        Adressen ermitteln              *)
  158. (*                        Interruptvektoren sichern       *)
  159. (*                        Resident beenden                *)
  160. (* ------------------------------------------------------ *)
  161.  
  162.   PROCEDURE GetScr_Segment;
  163.     (* ermittelt Basisadresse des Bildspeichers *)
  164.   BEGIN
  165.     IF Lo(LastMode) = 7 THEN
  166.       ScreenSeg := Ptr($B000, $0000)
  167.     ELSE
  168.       ScreenSeg := Ptr($B800, $0000);
  169.   END;
  170.  
  171.   PROCEDURE ParamCheck;
  172.     (* Aufrufparameter interpretieren  *)
  173.   VAR
  174.     s    : STRING [10];
  175.     i    : BYTE;
  176.     Code : WORD;
  177.   BEGIN
  178.     FOR i := 1 TO ParamCount DO BEGIN
  179.       s := ParamStr(i);
  180.       IF (Pos('?', s) = 1) OR (Pos('h', s) = 1) OR
  181.          (Pos('H', s) = 1) THEN BEGIN
  182.         WriteLn('     TSR Routine "Keyboard-Decoder"');
  183.         WriteLn(HotString, ' startet die Routine');
  184.         Halt(0);
  185.       END ELSE IF (Pos('s', s) = 1) THEN BEGIN
  186.         Move(s[3], s[1], Length(s) - 2);
  187.         s[0] := CHAR(Length(s) - 2);
  188.         HotString := s;
  189.       END ELSE IF (POS('k', s) = 1) THEN BEGIN
  190.         (* Move(s[3], s[1], Length(s) - 2);
  191.         s[0] := CHAR(Length(s) - 2);
  192.         VAL(s, Code, RetCode);
  193.         IF RetCode = 0 THEN HotKey := Code SHL 8; *)
  194.       END ELSE BEGIN
  195.         WriteLn('Syntax: lz [parameterliste]');
  196.         WriteLn('    Parameter in beliebiger Reihenfolge');
  197.         WriteLn;
  198.         WriteLn('Parameter= ═╦═ k="scancode" der Taste');
  199.         WriteLn('            ╠═ s="String"   Bezeichnung');
  200.         WriteLn('            ║');
  201.         WriteLn('            ╚═══ ?,h,H      Hilfe');
  202.         Halt(1);
  203.       END;
  204.     END;
  205.   END;
  206.  
  207. BEGIN
  208.   IF ParamCount <> 0 THEN ParamCheck;
  209.   WriteLn(' (c) 1991 Martin Wölker & DOS-Toolbox');
  210.   WriteLn('  ', HotString, ' startet die Routine');
  211.   GetScr_Segment;                      { Aktueller Zustand }
  212.   SwapVectors;                         { SYSTEM - Vektoren }
  213.   MakeResident(@Selectkey, HotKey);    { Resident beenden  }
  214. END.
  215. (* ------------------------------------------------------ *)
  216. (*              Ende von SCANSEND.PAS                     *)
  217.