16.5.34. Пример использования подпрограмм модуля Dos
В качестве примера использования ресурсов модуля Dos рассмотрим модуль, содержащий подпрограммы работы с "мышью" и программу, использующую подпрограммы этого модуля и позволяющую рисовать на экране траекторию перемещения курсора "мыши".
Пример.
{ Модуль с подпрограммами мыши }
unit Mouse;
interface
var MousePresent: Boolean; {Признак наличия мыши}
function MouseInit(var nb: Integer): Boolean;
{Инициализация мыши}
{nb - количество клавиш мыши;
значение функции:
True - инициализация прошла успешно,
False - в противном случае }
procedure MouseShow; {Показать курсор мыши}
procedure MouseHide; {Спрятать курсор мыши}
procedure MouseRead(var X, Y, bMask: Word);
{Определить текущие координаты курсора и состояние клавиш мыши}
{X,Y - координаты курсора мыши;
bMask - маска клавиш:
0-й байт - левая клавиша (1 - если нажата),
1-й байт - правая клавиша (1 - если нажата),
2-й байт - центральная клавиша, если она
присутствует (1 - если нажата) }
procedure MouseSetPos(X, Y: Word);
{Установить координаты мыши}
{X,Y - задаваемые координаты мыши }
function MouseGetb(bMask: Word;
var Count,LastX,LastY: Word): Word;
{Определить состояние клавиши}
{bMask - маска клавиш - то же, что и в процедуре
MouseRead, здесь необходимо записать единицу
в байт, соответствующий проверяемой клавише;
Count - количество нажатий клавиши;
LastX,LastY - координаты последнего нажатия клавиши;
значение функции:
бит 0 равен 1, если нажата левая клавиша,
бит 1 равен 1, если нажата правая клавиша }
implementation
uses Dos;
var R: Registers; {Стандартный тип модуля Dos}
Mi: Pointer;
function MouseInit(var nb: Word): Boolean;
begin
if MousePresent then
begin {Мышь присутствует}
R.AX := 0;
Intr($33, R)
if R.AX = 0 then
begin {Инициализация не удалась}
nb := 0;
MouseInit := False
end
else
begin {Инициализация удалась}
nb := R.BX; {Число клавиш}
Mouselnit := True
end
end
else
begin {Мышь отсутствует}
nb := 0;
Mouselnit := False
end
end;
procedure MouseShow;
begin
R.AX := 1;
Intr($33, R)
end;
procedure MouseHide;
begin
R.AX := 2;
Intr($33, R)
end;
procedure MouseRead(var X, Y, bMask: Word);
begin
R.AX := 3;
Intr($33, R);
X := R.CX;
Y := R.DX;
bMask := R.BX
end;
procedure MouseSetPos(X, Y: Word);
begin
R.AX := 4;
R.CX :- X;
R.DX := Y;
Intr($33, R)
end;
function MouseGetb(bMask: Word;
var Count, LastX, LastY: Word): Word;
begin
R.AX := 5;
R.BX := bMask;
Intr($33, R);
Count := R.BX;
LastX .= R.CX;
LastY := R.DX;
MouseGetb := R.AX
end;
{ Секция инициализации }
begin
GetIntVec($33, Mi);
if Mi = nil then
MousePresent := False {Нет адреса программы обработки
прерываний}
else
if Byte(Mi^) = $CE then
MousePresent := False {Фиктивный адрес программы
обработки прерываний}
else
MousePresent := True {Присутствует программа
обработки прерываний}
end.
{ Основная программа }
program EXAMPLE30;
uses Crt, Mouse;
var X, Y, BN, NB: Word;
begin
TextBackGround(Blue);
ClrScr;
TextColor(Red);
if Mouselnit(NB) then
begin
MouseShow;
repeat
MouseRead(X, Y, BN);
if BM and 1 <> 0 then
begin {Нажата левая клавиша}
X := X div В + 1;
Y := Y div В + 1;
GotoXY(X, Y);
Write(' * ')
end
until BM and 2 <> 0 {Выход при нажатой правой клавише}
end
end.
В этом примере в модуле Mouse приведены некоторые подпрограммы, которые не используются в основной программе (MouseHide, MouseSetPos, MouseGetb), но они могут быть полезны в других приложениях. Здесь используется ряд стандартных подпрограмм модуля Dos (GetlntVec, Intr), а также стандартный тип модуля Registers.
"Мышь" работает с номером прерывания $33. Во всех случаях обращения к подпрограмме выполнения прерывания Intr параметры передаются в подпрограмму и обратно в вызывающую программу через соответствующие регистры. В приведенном модуле используется секция инициализации, в которой проверяется наличие программы обработки прерываний от "мыши".
|
