Модуль для мыши Опции

[Анна]

Модуль:

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.

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