unit keyboard; {драйвер клавиатуры}
interface
var
key : array[0..127]of boolean;
{признаки клавиш - нажата/отпущена}
procedure SetStandardInt;
{установка стандартного обработчика}
procedure SetMyInt;{установка собственного обработчика}
const {некоторые часто используемые клавиши}
KeyUp = 72;
KeyDown = 80;
KeyLeft = 75;
KeyRight = 77;
KeyEsc = 1;
KeyAltL = 56;
KeyAltR = 86;
KeyCtrlL = 29;
KeyCtrlR = 85;
KeyShiftL = 42;
KeyShiftR = 54;
KeySpace = 57;
implementation
uses dos;
var
ExitSave:Pointer;
{адрес старой программы выхода в DOS}
p9old:pointer; {адрес прерывания 9}
i : integer;
E0pressed : boolean; {признак управляющего кода}
MyIntEnable : boolean;
{признак того, что включен собственный обработчик}
{$F+}
procedure NewInt; interrupt;
{новое аппаратное прерывание клавиатуры}
var
Button,b : byte;
begin
inline ($fa); {cli - запрещение прерываний}
Button := Port[$60];
b := Port[$61];
Port[$61] := b or $80;
Port[$61] := b and $7f;
if Button = $e0 then
E0pressed := TRUE {управляющий код}
else begin
if E0pressed then begin {для “правых“ Alt и Ctrl}
if (Button and $7f) = KeyCtrlL then
Button := Button + (KeyCtrlR - KeyCtrlL);
if (Button and $7f) = KeyAltL then
Button := Button + (KeyAltR - KeyAltL);
end;
E0pressed := FALSE;
if Button < 128 then key[Button] := TRUE
else key[Button-128] := FALSE;
end;
inline ($fb); {sti - разрешение прерываний}
Port[$20] := $20; {конец обработки прерывания}
end;
procedure MyExit;
{дополнительная процедура при выходе в DOS}
begin
ExitProc:=ExitSave;
SetStandardInt;
end;
{$F-}
procedure SetStandardInt;
{установка стандартного обработчика}
begin
if MyIntEnable then begin
SetIntVec(9,p9old);
MyIntEnable := FALSE;
mem[Seg0040:$17] := mem[Seg0040:$17] and $f0;
mem[Seg0040:$18] := 0; {сброс Alt, Ctrl, Shift}
end;
end;
procedure SetMyInt;{установка собственного обработчика}
begin
if not MyIntEnable then begin
GetIntVec(9,p9old);
SetIntVec(9,@NewInt);
{переопределение прерывания клавиатуры}
MyIntEnable := TRUE;
for i := 0 to 127 do key[i] := FALSE;
E0pressed := FALSE;
end;
end;
begin
ExitSave:=ExitProc;
{переопределение процедуры выхода}
ExitProc:=@MyExit;
MyIntEnable := FALSE;
SetMyInt;
end.