IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Модуль для мыши
сообщение
Сообщение #1


Бывалая
***

Группа: Пользователи
Сообщений: 290
Пол: Женский
Реальное имя: Анютка

Репутация: -  7  +


Модуль:

unit mouse2;

interface


procedure reset_mouse (var mouse_OK: boolean; var button: byte);
procedure show_cursor;
procedure hide_cursor;
procedure get_mouse_status (var button: byte; var x,y: word);
procedure get_mouse_button_press (var button: byte; var count,x,y: word);
function double_click (timeout: word): boolean;



implementation

uses dos, crt;

var

regs: Registers;


procedure reset_mouse (var mouse_OK: boolean; var button: byte);
begin
regs.AX := $00;
Intr ($33, regs);
mouse_OK := Odd(regs.AX);
button := regs.BX;
end;


procedure show_cursor;
begin
regs.AX := $01;
Intr ($33, regs);
end;


procedure hide_cursor;
begin
regs.AX := $02;
Intr ($33, regs);
end;


procedure get_mouse_status (var button: byte; var x,y: word);
begin
regs.AX := $03;
Intr($33, regs);
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;


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 (1);
inc (K);
get_mouse_status (button,x,y);
until (button = 1) or (k = timeout);

if k = timeout then Exit;

repeat
delay (1);
inc(K);
get_mouse_status (button,x,y);
until (button = 0) or (k = timeout);

double_click := (k < timeout);
end;


end.


Программа:
uses crt, dos, mouse2;

var

mouse_OK : boolean;
count,x,y : word;
button : byte;


begin
clrscr;
textattr:= green;
writeln ('Mouse in text-mode');
reset_mouse (mouse_OK, button);
if not mouse_OK then halt;

show_cursor;

Writeln ('Press left key mouse');

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

clrscr;

textattr:= red;
Writeln ('<< Move mouse >>');;
writeln ('Press right key mouse');
gotoXY (1,10);
textcolor (yellow);
textbackground (brown);

for x := 1 to 80*16 do
write (chr (x mod 224 + 31));

textcolor (lightgray);
textbackground (black);

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

show_cursor;
gotoXY (1,3);

Writeln ('Press left key for hide cursor smile.gif ');


repeat
button := 0;
get_mouse_button_press (button, count, x, y);
until button = 1;
hide_cursor;

Writeln ('Press right key for show cursor smile.gif ');


repeat
button := 1;
get_mouse_button_press (button, count, x, y);
until button = 2;
show_cursor;




Writeln ('Press two keys');

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

window (1,1,80,60);
clrscr;
reset_mouse (mouse_OK, button);
show_cursor;
gotoXY (1,1);

textattr:=Yellow;
writeln ('Double click to continue');
Double_click(9999);
clrscr;

writeln ('For Exit -- press right key mouse');
repeat
button := 0;
get_mouse_button_press (button,count,x,y);
until button = 2;

reset_mouse (mouse_OK, button);
show_cursor;
clrscr;
end.


Собствено вот .. хотелось бы ещё узнать, как можно отследить нажатие центральной кнопки (колёсика) ...


Прикрепленные файлы
Прикрепленный файл  mouse.rar ( 10.17 килобайт ) Кол-во скачиваний: 200
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Отсюда
Цитата(FAQ: Мышь)

Функция $03, как уже было сказанно, возвращает состояние копок мыши.


Function ButtonPressed:byte;
var
rbl:byte;
begin
asm
mov ax,$03
int $33
mov rbl,bl
end
ButtonPressed:=rbl
end;


Функция возвращает следующие значения:

* 1 - если нажата левая кнопка.
* 2 - если нажата правая кнопка.
* 3 - если нажаты левая и правая кнопки
* 4 - если нажата средняя кнопка (колесико)
* 5 - если нажаты левая кнопка и колесико
* 6 - если нажаты правая кнопка и колесико.
* 7 - если нажаты все кнопки (2 кнопки и колесико).


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 5.10.2024 11:25
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name