home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / tricks / scansend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-10  |  4.4 KB  |  151 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   SCANSEND.PAS                         *)
  3. (*    Residente Routine zum Ermitteln der Scancodes.      *)
  4. (*          (c) 1991 Martin Wölker & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM ScanSend;
  7. {$F-,R-,S-,I-,V-,B-,N-}
  8. {$M 4096, 0, 100}
  9.  
  10. USES Crt, TSR, Dos;
  11.  
  12. CONST
  13.   Ver   = 'ScanSend 1.2';
  14.  
  15.   Softkey       : WORD   = $6F00;
  16.   tasten_string : STRING = '<ALT-F8>';
  17.   mode          : BYTE   = 0;
  18.  
  19.   tab           : ARRAY [0..15] OF CHAR =
  20.      ('0', '1', '2', '3', '4', '5', '6', '7',
  21.       '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
  22.  
  23. TYPE
  24.   TScreen = ARRAY [1..25, 1..80] OF WORD;
  25.  
  26. CONST
  27.   z1='╔══════════════════════════════════════════════════╗';
  28.   z2='║        ScanSend -- Ausgabe der Scancodes         ║';
  29.   z3='╠══════════════════════════════════════════════════╣';
  30.   z4='║       Betätigen Sie die gewünschte Taste.        ║';
  31.   z5='╚══════════════════════════════════════════════════╝';
  32.  
  33. VAR
  34.   SCR_Segment : ^TScreen;
  35.   scr_save    : TScreen;
  36.   Regs        : Registers;
  37.   sysx, sysy  : BYTE;
  38.   res         : WORD;
  39.   retcode     : INTEGER;
  40.  
  41.   FUNCTION GetKey : WORD;   { Eine Taste auslesen }
  42.   BEGIN
  43.     Regs.AH := mode;
  44.     Intr($16, Regs);
  45.     GetKey := Regs.AX;
  46.   END;
  47.  
  48.   PROCEDURE Stuff_Kbd(key : CHAR);
  49.     { Ein Zeichen in den Puffer schreiben }
  50.   BEGIN
  51.     Regs.AH := 5;
  52.     Regs.CX := BYTE(key);
  53.     Intr($16, Regs);
  54.   END;
  55.  
  56.   PROCEDURE Save_Sys_Screen;
  57.     { Bildschirminhalt und Cursorposition retten }
  58.   BEGIN
  59.     Move(SCR_Segment^, Scr_Save, 4000);
  60.     SysX := WhereX;
  61.     SysY := WhereY;
  62.   END;
  63.  
  64.   PROCEDURE Restore_Sys_Screen;
  65.   BEGIN
  66.     Move(Scr_Save, SCR_Segment^, 4000);
  67.     GotoXY(SysX, SysY);
  68.     NormVideo;
  69.   END;
  70.  
  71. {$F+}
  72.   PROCEDURE SelectKey;
  73.   BEGIN
  74.     Save_Sys_Screen;
  75.     TextBackground(LightGray);
  76.     TextColor(Blue);
  77.     Window(14, 10, 65, 25);
  78.     Write(z1, z2, z3, z4, z5);
  79.     Window(1, 1, 80, 25);
  80.     res := GetKey;
  81.     Stuff_Kbd('$');
  82.     Stuff_Kbd(tab[Hi(res) AND $F0 SHR 4]);
  83.     Stuff_Kbd(tab[Hi(res) AND $0F      ]);
  84.     Stuff_Kbd(tab[Lo(res) AND $F0 SHR 4]);
  85.     Stuff_Kbd(tab[Lo(res) AND $0F      ]);
  86.     Restore_Sys_Screen;
  87.   END;
  88. {$F-}
  89.  
  90. (* ------------------------------------------------------ *)
  91. (* Installationsteil                                      *)
  92. (*                        Adressen ermitteln              *)
  93. (*                        Interruptvektoren sichern       *)
  94. (*                        resident beenden                *)
  95. (* ------------------------------------------------------ *)
  96.  
  97.   PROCEDURE GetScr_Segment;
  98.    { ermittelt Basisadresse des Bildspeichers im Textmodus }
  99.   BEGIN
  100.     IF Lo(LastMode) = 7 THEN
  101.       SCR_Segment := Ptr($B000,$0000)
  102.     ELSE
  103.       SCR_Segment := Ptr($B800,$0000);
  104.   END;
  105.  
  106.   PROCEDURE ParamCheck;
  107.     { Aufrufparameter interpretieren }
  108.   VAR
  109.     s    : STRING [10];
  110.     i    : BYTE;
  111.     code : WORD;
  112.   BEGIN
  113.     FOR i := 1 TO ParamCount DO BEGIN
  114.       s := ParamStr(i);
  115.       IF (Pos('?', s) = 1) OR (Pos('h', s) = 1)  OR
  116.          (Pos('H', s) = 1) THEN BEGIN
  117.         WriteLn(Ver);
  118.         WriteLn(tasten_string, ' aktiviert die Routine');
  119.         Halt(0);
  120.       END ELSE IF (Pos('s', s) = 1) THEN BEGIN
  121.         Move(s[3], s[1], Length(s)-2);
  122.         s[0] := CHAR(Length(s)-2);
  123.         tasten_string := s;
  124.       END ELSE IF (Pos('k',s) = 1) THEN BEGIN
  125.         Move(s[3], s[1], Length(s)-2);
  126.         s[0] := CHAR(Length(s)-2);
  127.         Val(s, code, retcode);
  128.         IF retcode = 0 THEN softkey := code SHL 8;
  129.       END ELSE BEGIN
  130.         WriteLn('Syntax: lz [parameterliste]');
  131.         WriteLn('    Parameter in beliebiger Reihenfolge');
  132.         WriteLn;
  133.         WriteLn('Parameter= ═╦═ k="scancode" der Taste');
  134.         WriteLn('            ╠═ s="String"   Bezeichnung');
  135.         WriteLn('            ║');
  136.         WriteLn('            ╚═══ ?,h,H      Hilfe');
  137.         Halt(1);
  138.       END;
  139.     END;
  140.   END;
  141.  
  142. BEGIN
  143.   IF ParamCount <> 0 THEN ParamCheck;
  144.   WriteLn(Ver, ' (c) 1991 Martin Wölker & TOOLBOX');
  145.   WriteLn('     ', tasten_string, ' aktiviert die Routine');
  146.   GetScr_Segment;                      { Aktueller Zustand }
  147.   MakeResident(@selectkey, softkey);   { Resident beenden  }
  148. END.
  149. (* ------------------------------------------------------ *)
  150. (*                Ende von KEYBOARD.PAS                   *)
  151.