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 ');
repeat
button := 0;
get_mouse_button_press (button, count, x, y);
until button = 1;
hide_cursor;
Writeln ('Press right key for show cursor ');
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.
Собствено вот .. хотелось бы ещё узнать, как можно отследить нажатие центральной кнопки (колёсика) ...