Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
62
Добавлен:
10.12.2013
Размер:
211.46 Кб
Скачать

Модуль управления клавиатурой

unit ArcUnitK;

Interface

const

kbEsc = 1;

kbUp = 17;

kbRight = 32;

kbLeft = 30;

kbDown = 31;

kbEnter = 80;

kbEnter1 = 72;

kbIns = 82;

kbDel = 83;

kbHome = 71;

procedure KBD; interrupt;

function GetKey(n: Byte): Boolean;

procedure InitKBD;

procedure DoneKBD;

Implementation

uses DOS,CRT;

var

Keys: array[1..128] of Boolean;

Old: procedure;

procedure KBD;

var tt: Boolean;

Проверка на нажатие клавиши, и считывание её

b: Byte;

begin

b:=Port[$60];

if b>=128 then begin tt:=False; b:=b-128 end else tt:=True;

Keys[b]:=tt;

Port[$20]:=$20;

if KeyPressed then ReadKey;

Old;

end;

function GetKey(n: Byte): Boolean;

Возвращает true если клавиша нажата

begin

GetKey:=Keys[n];

end;

Передача управления клавиатурой процедуре KBD;

procedure InitKBD;

begin

GetIntVec($9,@Old);

SetIntVec($9,@KBD);

end;

procedure DoneKBD;

begin

Передача управления клавиатурой операционной системе

SetIntVec($9,@Old);

end;

end.

Модуль управления мышью

unit ArcUnitM;

Interface

procedure Init(var ButtonCount,ErrorCode:byte);

procedure GetMouseXY(var x,y:integer;var LeftButton,RightButton,ThirdButton:boolean);

procedure SetMouseXY(x,y:word);

Implementation

uses DOS,CRT;

var

ErrCode,ButtonCount,Count:byte;

LeftButton,RightButton,ThirdButton:boolean;

regs:registers;

procedure Init(var ButtonCount,ErrorCode:byte);

begin

Проверка наличия мыши

ClrScr;

with regs do begin

ax:=$0000;

intr($33,regs);

if ax = $FFFF then ErrorCode:=0 else ErrorCode:=1;

ButtonCount:=bx;

end;

end;

procedure GetMouseXY(var x,y:integer; var LeftButton,RightButton,ThirdButton:boolean);

var ButtonCode:byte;

begin

with regs do begin

ax:=$0003;

Считывание текущих координат мыши

intr($33,regs);

X:=CX;

Y:=DX;

ButtonCode:=bx;

end;

LeftButton:=(ButtonCode and 1) = 1;

RightButton:=(ButtonCode and 2) = 2;

ThirdButton:=(ButtonCode and 4) = 4;

end;

procedure SetMouseXY(x,y:word);

begin

with regs do begin

ax:=$0004;

Установка текущих координат мыши

cx:=x;

dx:=y;

intr($33,regs);

end;

end;

end.

Модуль звуков

unit ArcSound;

Interface

procedure Beep;

procedure Beep1;

procedure Beep2;

procedure Beep3;

Implementation

uses CRT;

procedure Beep;

begin

Sound(1000); Delay(200); NoSound;

end;

procedure Beep1;

begin

Sound(50); Delay(500); NoSound;

end;

procedure Beep2;

begin

Sound(100); Delay(50); NoSound;

end;

procedure Beep3;

begin

Sound(300);Delay(2000);

Sound(400);Delay(500);

Sound(200);Delay(1000);

Sound(1000);Delay(2000);

Sound(400);Delay(2000);

NoSound;

end;

end.