 Отзывы присылать на склад нитроманита nitromanit@mail.ru

Unit keydrv;

interface

 Uses dos;

type bit3=(up,down);

const
      ctEsc=1;
      ctENTER=28;
      ctUP=72;
      ctDOWN=80;
      ctLEFT=75;
      ctRIGHT=77;
      ctspace=57;
      ctLSHIFT=42;
      ctCTRL=29;
      ctF1=59;
      ctF2=60;
      ctF3=61;
      ctF4=62;
      ctF5=63;
      ctF6=64;
      ctF7=65;
      ctF8=66;
      ctF9=67;
      ctF10=68;
      ct1=2;
      ct2=3;
      ct3=4;
      ct4=5;
      ct5=6;
      ct6=7;
      ct7=8;
      ct8=9;
      ct9=10;
      ct0=11;
      ctMINES=12;
      ctPLUS=13;
      ctQ=16;
      ctW=17;
      ctE=18;
      ctR=19;
      ctT=20;
      ctY=21;
      ctU=22;
      ctI=23;
      ctO=24;
      ctP=25;
      ctLscob=26;
      ctRscob=27;
      ctA=30;
      ctS=31;
      ctD=32;
      ctF=33;
      ctG=34;
      ctH=35;
      ctJ=36;
      ctK=37;
      ctL=38;
      ctPiontpoint=39;
      ctApostraf=40;
      ctZ=44;
      ctX=45;
      ctC=46;
      ctV=47;
      ctB=48;
      ctN=49;
      ctM=50;
      ctRusB=51;
      ctRusU=52;
      ctRusE=53;
      { 0 - для запуска своего обработчика(при долгом держании клавиш
            не издает звуков спикера и вообще удобная вещь, но на этапе
            отладки лучше использовать мою утилиту keyboard.tpu чтобы
            небыло зависаний при нажатии Ctrl+Break под отладчиком, 
            а потом можно просто перед каждым именем клавиши проставить
            'ct' и все будет GOOD проверено в моих игрушках)}
      { 1 - для запуска обработчика с вызовом стандартного обработчика}
      intmodeself=0;
      intmodehelp=1;

procedure InitKeyDrv(a:byte);
procedure InitCodeTab;
procedure KeyDrvDone;
procedure ClearCod;
function GetCod:byte;
function KeyPress(a:byte):bit3;

implementation

var int9_old,int33h_old:pointer;
    code,oldcod:byte;
    aseg,aoff:word;
    codetab:array [1..160] of byte;

procedure getaddr;assembler;
asm
    jmp @d1
@d2:dw 0
@d3:dw 0
@d1:push es
    push di
    les di,int9_old
    mov ax,es
    mov aseg,ax
    mov aoff,di
    pop di
    pop es
end;
{$F+}
Procedure Int9_newhelp;interrupt;
Begin
  asm
     in al,60h
     mov code,al
  end;
codetab[code and $7f]:=code;
  asm
     jmp @int
 @l1:dw 0
 @l2:dw 0
@int:mov ax,aoff
     mov word ptr @l1,ax
     mov ax,aseg
     mov word ptr @l2,ax
     pop bp
     pop es
     pop ds
     pop di
     pop si
     pop dx
     pop cx
     pop bx
     pop ax
     jmp dword ptr CS:[@l1]
  end;
End;

Procedure Int9_newself;interrupt;
Begin
  asm
     in al,60h
     mov code,al
  end;
codetab[code and $7f]:=code;
  asm
     jmp @int
 @l1:dw 0
 @l2:dw 0
@int:mov ax,aoff
     mov word ptr @l1,ax
     mov ax,aseg
     mov word ptr @l2,ax
     IN     AL,61h
     MOV    AH,AL
     OR     AL,80h
     OUT    61h,AL
     XCHG   AH,AL
     OUT    61h,AL
     MOV    AL,20h
     OUT    20h,AL
  end;
End;

procedure Int33h_new;assembler;
asm
    push ds
    mov ax,seg @data
    mov ds,ax
    mov al,code
    pop ds
    iret
end;
{$F-}

procedure InitCodeTab;
var i:word;
begin
for i:=1 to 128 do codetab[i]:=i+128;
end;

procedure InitKeyDrv(a:byte);
begin
oldcod:=1;
Initcodetab;
GetIntVec(9,int9_old);
GetIntVec($33,int33h_old);
getaddr;
SetIntVec($33,@Int33h_new);
if a=intmodeself then SetIntVec(9,@Int9_newself)
   else SetIntVec(9,@Int9_newhelp);
end;
    
procedure KeyDrvDone;
begin
SetIntVec(9,int9_old);
SetIntVec($33,int33h_old);
end;

procedure ClearCod;
begin
oldcod:=code;
end;

function GetCod:byte;assembler;
asm
    push ds
    int 33h
    pop ds
    cmp al,oldcod
    je @n1
    mov oldcod,al
    jmp @nd
@n1:mov al,0
@nd:
end;

function KeyPress(a:byte):bit3;
begin
if codetab[a]<128 then begin KeyPress:=down;exit;end;
KeyPress:=up;
end;

end.

