home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 08 / tricks / hotkey.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-24  |  4.0 KB  |  136 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    HOTKEY.PAS                          *)
  3. (* Turbo-Fünfnull-Unit zur Verwaltung von "heißen Tasten" *)
  4. (*           (c) 1989 Jan Hargens & TOOLBOX               *)
  5. (* ------------------------------------------------------ *)
  6. UNIT HotKey;
  7.  
  8. INTERFACE
  9.  
  10. USES Dos;          { IMPORT FROM Dos: GetIntVec, SetIntVec }
  11.  
  12. CONST
  13.   MaxHotkey = 16;                                                                          { im Grunde reichen wohl auch 8 }
  14. TYPE
  15.   HotkeyProc  = PROCEDURE;
  16.   HotkeyArray = ARRAY[1..MaxHotkey] OF
  17.                 RECORD
  18.                   HotkeyCode : WORD;
  19.                   Proc       : HotkeyProc;
  20.                 END;
  21.  
  22.   PROCEDURE AddHotkey     (KeyCode      : WORD;
  23.                            ProcToCall   : HotkeyProc);
  24.   PROCEDURE DeleteHotkey  (KeyCode      : WORD);
  25.   PROCEDURE GetHotkeyList (VAR List     : HotkeyArray;
  26.                            VAR Size     : BYTE);
  27.  
  28. IMPLEMENTATION
  29.  
  30. TYPE { Registersatz für Interrupt-Prozeduren }
  31.   IntrReg = RECORD CASE BOOLEAN OF
  32.               true : (bp, es, ds, di, si, dx, cx, bx, ax,
  33.                       ip, cs, flags : WORD);
  34.               false: (xx : ARRAY [1..10] OF BYTE;
  35.                      dl, dh, cl, ch, bl, bh, al, ah : BYTE);
  36.             END;
  37. VAR Hotkeys         : HotkeyArray;
  38.     NumberOfHotkeys : 0..MaxHotkey;
  39.     SaveInt16,
  40.     SaveExit        : POINTER;
  41.  
  42. (* -------------- Interrupt-Serviceroutinen ------------- *)
  43.   PROCEDURE ChainInt(Regs : IntrReg; Address : POINTER);
  44.   INLINE ($5b/$58/$5e/$1f/$87/$5c/$0e/$87/$44/$10/$8b/
  45.           $54/$16/$52/$9d/$8c/$da/$fa/$8e/$d2/$89/$f4/
  46.           $fb/$5d/$07/$1f/$5f/$5e/$5a/$59/$cb);
  47.  
  48.   FUNCTION KeyFromOldInt16 : Word;
  49.   INLINE ($31/$C0/$9C/$FF/$1E/SaveInt16);
  50.  
  51.   FUNCTION HotkeyPos(Code : WORD) : BYTE;
  52.   VAR
  53.     Count : BYTE;
  54.   BEGIN
  55.     Count := NumberOfHotkeys;
  56.     WHILE (Count>0) AND (Hotkeys[Count].HotkeyCode<>Code) DO
  57.       Dec(Count);
  58.     HotkeyPos := Count;
  59.   END;
  60.  
  61.   PROCEDURE AddHotkey(KeyCode : WORD;
  62.                       ProcToCall : HotkeyProc);
  63.   BEGIN
  64.     IF (NumberOfHotkeys < MaxHotkey) AND
  65.        (HotkeyPos(KeyCode) = 0) THEN BEGIN
  66.       Inc(NumberOfHotkeys);
  67.       WITH Hotkeys[NumberOfHotkeys] DO BEGIN
  68.         HotkeyCode := KeyCode;
  69.         Proc := ProcToCall;
  70.       END;
  71.     END;
  72.   END;
  73.  
  74.   PROCEDURE DeleteHotkey(KeyCode : WORD);
  75.   VAR
  76.     Position : BYTE;
  77.   BEGIN
  78.     Position := HotkeyPos(KeyCode);
  79.     IF Position <> 0 THEN BEGIN
  80.       Hotkeys[Position] := Hotkeys[NumberOfHotkeys];
  81.       FillChar(Hotkeys[NumberOfHotkeys],
  82.                SizeOf(Hotkeys[1]), 0);
  83.       Dec(NumberOfHotkeys);
  84.     END;
  85.   END;
  86.  
  87.   PROCEDURE GetHotkeyList(VAR List : HotkeyArray;
  88.                           VAR Size : BYTE);
  89.   BEGIN
  90.     List := Hotkeys;
  91.     Size := NumberOfHotkeys;
  92.   END;
  93.  
  94.   PROCEDURE CheckHotkey(bp : WORD); INTERRUPT {16h};
  95.   VAR
  96.     r       : IntrReg ABSOLUTE bp;
  97.     HotkPtr : 0..MaxHotkey;
  98.   BEGIN          { wird vor BIOS-Interrupt $16 «geklemmt». }
  99.     IF r.ah = 0 THEN REPEAT
  100.       r.ax    := KeyFromOldInt16;
  101.       HotkPtr := HotkeyPos(r.ax);
  102.       IF HotkPtr <> 0 THEN BEGIN
  103.         SetIntVec($16, SaveInt16);
  104.                                { nicht rekursiv (tödlich!) }
  105.         Hotkeys[HotkPtr].Proc;
  106.                      { Prozeduraufruf (!!), erst ab TP 5.0 }
  107.         SetIntVec($16, @CheckHotkey);    { wieder einhaken }
  108.       END;
  109.     UNTIL HotkPtr = 0 ELSE
  110.       ChainInt(r, SaveInt16);
  111.   END;
  112.  
  113. {$F+}      { Exit-Prozedur; MUSS als FAR compiliert werden }
  114.   PROCEDURE DeInstall;
  115.   BEGIN
  116.     SetIntVec($16, SaveInt16);
  117.     ExitProc := SaveExit;
  118.   END;
  119. {$F-}
  120.  
  121.   PROCEDURE Install;
  122.   BEGIN
  123.     GetIntVec($16, SaveInt16);
  124.     SaveExit := ExitProc;
  125.     ExitProc := @DeInstall;
  126.     SetIntVec($16, @CheckHotkey);
  127.   END;
  128.  
  129. BEGIN
  130.   NumberOfHotkeys := 0;
  131.   FillChar(Hotkeys, Sizeof(Hotkeys), 0);
  132.   Install;
  133. END.
  134. (* ------------------------------------------------------ *)
  135. (*                 Ende von HOTKEY.PAS                    *)
  136.