1800

WriteLn('Мыши нет'); Halt;

end;

Исчезновение и появление курсора procedure Show_cursor; procedure Hide_cursor;

Пояснения не требуются.

Считывание информации о мыши procedure Get_mouse_info(var ver : String[6]; var port, IRQ : Byte);

Процедура позволяет определить номер версии драйвера мыши, порт, к которому она подключена и IRQ – номер запроса прерывания, назначенный мыши.

Пример использования:

Get_mouse_info(ver,port,IRQ); {Считываем информацию о мыши}

WriteLn('Mouse:'); case port of

1 : Write('bus');

2 : Write('serial');

3 : Write('mouse');

4 : Write('PS/2');

5 : Write('HP'); end;

WriteLn(' port, IRQ ',IRQ,', ',button,' knopok');

Определение состояния мыши

procedure Get_mouse_status(var button : Byte; var x,y : Word);

Определяет состояние кнопок мыши и ее координаты. В переменной button после работы содержится информация о нажатых кнопках:

1 – нажата левая кнопка,

90

2 – нажата правая кнопка,

3 – нажаты левая и правая кнопки,

4 – нажата центральная кнопка,

5 – нажаты центральная и левая кнопки,

6 – нажата центральная и правая кнопки,

7 – нажаты все три кнопки.

В переменных х и у содержатся координаты мыши.

Определение состояния мыши с учетом истории нажа-

тия кнопок. Предварительно можно поместить в переменную button номер кнопки, состояние которой хотим проверить. procedure Get_mouse_button_press(var button

: Byte; var count,x,y : Word);

Действие процедуры аналогично предыдущей, за исключением того, что она учитывает количество нажатий кнопки со времени последнего к ней обращения. В параметре count возвращается количество нажатий заданной кнопки со времени последнего вызова.

Пример использования:

{Ждем нажатия левой кнопки} repeat

button:=0; get_mouse_button_press(button,count,x,y);

until button=1;

{Выводим координаты нажатия} WriteLn('Koordinaty ',x,' ',y);

{Ждем нажатия правой кнопки} WriteLn('Press Right button'); repeat

button:=1; get_mouse_button_press(button,count,x,y);

until button=2;

{Выводим координаты нажатия} WriteLn('Koordinaty ',x,' ',y);

91

Перемещение указателя мыши в заданные координаты пояснений не требует.

procedure Mouse_gotoXY(x,y : Word);

Определение состояния мыши с учетом истории отжа-

тия кнопок. Предварительно можно поместить в переменную button номер кнопки, состояние которой хотим проверить. procedure Get_mouse_button_release(var but-

ton : Byte; var count,x,y : Word);

Действие процедуры аналогично Get_mouse_button_press, но она сохраняет историю отжатия кнопок.

Проверка двойного щелчка

function double_click(timeout : word) : boolean;

Функция возвращает значение true, если в течение timeout миллисекунд имело место двойное нажатие левой кнопки. Пример использования:

{Ждем двойного щелчка} WriteLn('Press double click');

if double_click(100) then Writeln('Yes double click!!!');

Ограничение области перемещения курсора procedure Set_cursor_x_lim(min_x,

max_x : Word); procedure Set_cursor_y_lim(min_y,

max_y : Word);

Эти процедуры используются для того, чтобы ограничить области перемещения курсора мыши на экране указанными координатами.

Определение относительного перемещения мыши procedure get_relative_move(var x,

92

y : Integer);

Процедура помещает в переменные х и у относительные перемещения мыши.

Задание области исчезновения курсора мыши procedure set_hide_cursor_window(x0,y0, x1,y1 : Word);

Аргументы этой процедуры задают прямоугольную область, в пределах которой мышь перемещается, но ее курсор не виден.

Ниже приведен полный текст модуля mouse.

unit mouse; interface

type str6 = string[6];

procedure Reset_mouse(var mouseOK : Boolean; var button : Byte);

procedure Show_cursor; procedure Hide_cursor;

procedure Get_mouse_info(var ver : Str6; var port, IRQ : Byte);

procedure Get_mouse_status(var button : Byte; var x,y : Word);

procedure Get_mouse_button_press(var button : Byte; var count,x,y : Word);

procedure Mouse_gotoXY(x,y : Word);

procedure Get_mouse_button_release(var button : Byte; var count,x,y : Word);

function double_click(timeout : word) : boolean; procedure Set_cursor_x_lim(min_x,max_x : Word); procedure Set_cursor_y_lim(min_y,max_y : Word); procedure set_text_cursor(screen_mask,

cursor_mask : Word);

procedure get_relative_move(var x,y : Integer); procedure set_hide_cursor_window(x0,y0,x1,y1 : Word);

implementation uses dos, crt;

var regs : Registers;

93

with regs do begin button:=BL; x:=CX; y:=DX; end;

end;

procedure Get_mouse_button_press(var button : Byte; var count,x,y : Word);

begin regs.AX:=$05; regs.BL:=button; intr($33,regs); with regs do

begin button:=AL; count:=BX; x:=CX; y:=DX; end;

end;

procedure Mouse_gotoXY(x,y : Word); begin

with regs do begin AX:=$04; CX:=x; DX:=y; end;

intr($33,regs); end;

procedure Get_mouse_button_release(var button : Byte; var count,x,y : Word);

begin regs.AX:=$06; regs.BL:=button; intr($33,regs); with regs do

begin button:=AL;

95

count:=BX;

x:=CX;

y:=DX;

end;

end;

function double_click(timeout : word) : boolean; var k,x,y : Word;

button : Byte; begin double_click:=false; repeat

get_mouse_status(button,x,y); until button=0;

repeat get_mouse_status(button,x,y);

until button=1; repeat

get_mouse_status(button,x,y); until button=0;

k:=0; repeat

Delay(10);

k:=k+1; get_mouse_status(button,x,y);

until (button=1) or (k=timeout); if k=timeout then Exit;

repeat Delay(10); k:=k+1;

get_mouse_status(button,x,y); until (button=0) or (k=timeout); double_click:=( k<timeout); end;

procedure Set_cursor_x_lim(min_x,max_x : Word); begin

With regs do begin AX:=$07; CX:=min_x; DX:=max_x; end;

96

intr($33,regs); end;

procedure Set_cursor_y_lim(min_y,max_y : Word); begin

With regs do begin AX:=$08; CX:=min_y; DX:=max_y; end;

intr($33,regs); end;

procedure set_text_cursor(screen_mask, cursor_mask : Word);

begin

with regs do begin AX:=$0A; BX:=$00;

CX:=screen_mask;

DX:=cursor_mask; end;

intr($33,regs); end;

procedure get_relative_move(var x,y : Integer); begin

regs.AX:=$0B; intr($33,regs); x:=Integer(regs.CX); y:=Integer(regs.DX); end;

procedure set_hide_cursor_window(x0,y0,x1,y1 : Word); begin

with regs do begin AX:=$10; CX:=x0; DX:=y0; SI:=x1;

97

DI:=y1;

end; intr($33,regs); end;

end.

В качестве примера рассмотрим программу, которая тестирует работу этого модуля и является примером его использования.

program testmouse;

uses dos, crt, mouse,graph;

type Tmas = array [0..31] of Word; var mouseOK : boolean;

begin

{Использование мыши в текстовом режиме} clrscr; {Очищаем экран}

{Инициализируем мышь} reset_mouse(mouseOK,button); if not mouseOK then

begin

WriteLn('Мыши нет'); Halt;

end;

{Считываем информацию о мыши} Get_mouse_info(ver,port,IRQ); WriteLn('Mouse:');

98

case port of

WriteLn(' port, IRQ ',IRQ,', ',button,' knopok');

WriteLn('Test Mouse Text Mode');

WriteLn(' Press Left button');

{Показываем курсор мыши} Show_cursor;

{Ждем нажатия левой кнопки} repeat

button:=0; get_mouse_button_press(button,count,x,y);

until button=1;

{Выводим координаты нажатия} WriteLn('Koordinaty ',x,' ',y);

{Ждем нажатия правой кнопки} WriteLn('Press Right button'); repeat

button:=1; get_mouse_button_press(button,count,x,y);

until button=2;

{Выводим координаты нажатия} WriteLn('Koordinaty ',x,' ',y);

{Ждем двойного щелчка} WriteLn('Press double click');

if double_click(100) then Writeln('Yes double click!!!');

{Ограничиваем область перемещения курсора} Writeln('Dvishenie cursora ogranicheno.'); Set_cursor_x_lim(50,300); Set_cursor_y_lim(50,100);

99