Вот ещё
Код
unit mousen;
interface
uses dos;
type
tcursor=record
bitmask:array[1..64]of byte;
x,y:byte;
end;
tproc=procedure;
function getmousex:word;
function getmousey:word;
function initmouse:boolean;
function getmousevisible:boolean;
function getrightkeypress:boolean;
function getleftkeypress:boolean;
procedure movemouse(x,y:word);
procedure setgraphmousecursor(cursor:tcursor);
procedure setmovexrenge(minx,maxx:word);
procedure setmoveyrenge(miny,maxy:word);
procedure seteventprocedure(event:byte;proc:tproc);
procedure deleventprocedure(event:byte);
procedure mouseoff;
procedure mouseon;
Procedure DoneMouse;
implementation
var
leftkeypressproc,leftkeyunpressproc:procedure;
rightkeypressproc,rigthkeyunpressproc:procedure;
movemouseproc:procedure;
standartproc:procedure;
visible,rightkeypress,leftkeypress:boolean;
sx,sy:word;
mousestop,leftkey,rightkey:boolean;
keymouse:word;
{$F+}
procedure rkm;
begin
end;
procedure lkm;
begin
end;
procedure mm;
begin
end;
{$F-}
procedure eventmouse;interrupt;
var r:registers;
begin
inline ($9C);
standartproc;
if mousestop then exit;
if (getmousex<>sx)or(getmousey<>sy)then begin
movemouseproc;
sx:=getmousex;
sy:=getmousey;
end;
r.ax:=3;intr($33,r);
if r.bx<>keymouse then begin
keymouse:=r.bx;
if ((r.bx=3)or(r.bx=1)) and not(leftkey) then begin
leftkey:=true;
leftkeypressproc
end;
if ((r.bx=0)or(r.bx=2)) and leftkey then begin
leftkey:=false;
leftkeyunpressproc
end;
if ((r.bx=3)or(r.bx=2)) and not(rightkey) then begin
rightkey:=true;
rightkeypressproc
end;
end;
if ((r.bx=0)or(r.bx=1)) and rightkey then begin
rightkey:=false;
rigthkeyunpressproc
end;
end;
function getmousex:word;
var r:registers;
begin
r.ax:=3;
intr($33,r);
getmousex:=r.cx;
end;
function getmousey:word;
var r:registers;
begin
r.ax:=3;
intr($33,r);
getmousey:=r.dx;
end;
function initmouse:boolean;
var r:registers;
begin
r.ax:=0;intr($33,r);
if r.ax<>0 then begin
getintvec($c,@standartproc);
setintvec($c,@eventmouse);
initmouse:=true
end
else initmouse:=false;
end;
function getmousevisible:boolean;
begin
getmousevisible:=visible
end;
function getrightkeypress:boolean;
begin
getrightkeypress:=rightkeypress;
end;
function getleftkeypress:boolean;
begin
getleftkeypress:=leftkeypress;
end;
procedure movemouse(x,y:word);
var r:registers;
begin
r.ax:=4;
r.cx:=x;
r.dx:=y;
intr($33,r);
end;
procedure setgraphmousecursor(cursor:tcursor);
begin
end;
procedure setmovexrenge(minx,maxx:word);
var r:registers;
begin
r.ax:=7;
r.cx:=minx;
r.dx:=maxx;
intr($33,r)
end;
procedure setmoveyrenge(miny,maxy:word);
var r:registers;
begin
r.ax:=8;
r.cx:=miny;
r.dx:=maxy;
intr($33,r)
end;
procedure seteventprocedure(event:byte;proc:tproc);
begin
case event of
1:leftkeypressproc:=proc;
2:leftkeyunpressproc:=proc;
3:rightkeypressproc:=proc;
4:rigthkeyunpressproc:=proc;
5:movemouseproc:=proc;
end;
end;
procedure deleventprocedure(event:byte);
begin
end;
procedure mouseoff;
begin
mousestop:=true;
asm
mov ax,2
int 33h
end;
end;
procedure mouseon;
begin
mousestop:=false;
asm
mov ax,1
int 33h
end;
end;
Procedure DoneMouse;
begin
setintvec($C,@standartproc)
end;
begin
leftkey:=false;
rightkey:=false;
seteventprocedure(5,mm);
seteventprocedure(2,lkm);
seteventprocedure(1,rkm);
seteventprocedure(3,lkm);
seteventprocedure(4,rkm);
sx:=getmousex;
sy:=getmousey;
end.