Pers.narod.ru. Алгоритмы. Модуль мыши на Паскале и пример на работу с ним для графики |
Из переписки: "Когда щелкаешь мышью по цифре, потом при перемещении курсора эта цифра остается на месте, а кода шелкаешь не по самой цифре, а по кнопке(в любом месте синего квадратика), все перемещается как надо! Это какой-то "косяк" в модуле Graph или Mouse? и как это исправить?"
Ответ: думаю, что в обоих модулях всё нормально, а проблема может состоять в том, что программа рисует в том же месте экрана, где находится мышь. Перед каждым блоком отрисовки делаем mousehide;, после отрисовки - mouseshow;
Вот модуль мыши, о котором шла речь, он работает как в текстовом (консольном) режиме, так и в графике:
unit Mouse;
interface
var MousePresent:boolean;
function MouseInit(var nb:integer):boolean;
{ Инициализация мыши - вызывать первой.
Вернет true, если мышь обнаружена }
procedure Mouseshow; {Показать курсор мыши}
procedure MouseHide; {Скрыть курсор мыши}
procedure Mouseread(var x,y,bMask:integer);
{Прочитать позицию мыши.
Вернет через x,y координаты курсора
(для текстового режима см. пример),
через bmask - состояние кнопок
(0-отпущены,1-нажата левая,2-нажата правая,
3-нажаты обе) }
procedure MousesetPos(x,y:word);
{Поставить курсор в указанную позицию}
procedure Mouseminxmaxx(minx,maxx:integer);
{Установить границы перемещения по x}
procedure Mouseminymaxy(miny,maxy:integer);
{Установить границы перемещения по y}
procedure setVideoPage(Page:integer);
{Установить нужную видеостраницу}
procedure GetVideoPage(var Page:integer);
{Получить номер видеостраницы}
function MouseGetb(bMask:word; var count,
Lastx, Lasty:word):word;
procedure MousekeyPreset
(var key,sost,x,y:integer);
implementation
uses Dos;
var r: registers;
Mi:pointer;
function MouseInit(var nb:integer):boolean;
begin
if MousePresent then begin
r.Ax:=0; Intr($33,r);
if r.Ax=0 then begin
nb:=0; MouseInit:=false
end
else begin
nb:=r.Ax; MouseInit:=true
end
end
else begin
nb:=0; MouseInit:=false
end
end;
procedure Mouseshow;
begin
r.Ax:=1; Intr($33,r)
end;
procedure MouseHide;
begin
r.Ax:=2; Intr($33,r)
end;
procedure Mouseread(var x,y,bMask:integer);
begin
r.Ax:=3; Intr($33,r);
x:=r.cx; y:=r.dx; bMask:=r.Bx
end;
procedure MousesetPos(x,y:word);
begin
r.Ax:=4; r.cx:=x; r.dx:=y;
Intr($33,r)
end;
function MouseGetb(bMask:word;
var count,Lastx,Lasty:word):word;
begin
r.Ax:=5; r.Bx:=bMask;Intr($33,r);
count:=r.Bx; Lastx:=r.cx;
Lasty:=r.dx; MouseGetb:=r.Ax
end;
procedure Mouseminxmaxx(minx,maxx:integer);
begin
r.Ax:=7; r.cx:=minx;
r.dx:=maxx; Intr($33,r)
end;
procedure Mouseminymaxy(miny,maxy:integer);
begin
r.Ax:=8; r.cx:=miny;
r.dx:=maxy; Intr($33,r)
end;
procedure setVideoPage(Page:integer);
begin
r.Ax:=$1D; r.Bx:=Page; Intr($33,r)
end;
procedure GetVideoPage(var Page:integer);
begin
r.Ax:=$1E; Intr($33,r); Page:=r.Bx;
end;
procedure MousekeyPreset
(var key,sost,x,y:integer);
begin
r.Ax:=$6; r.Bx:=key; Intr($33,r);
key:=r.Ax; sost:=r.Bx;
x:=r.cx; y:=r.dx;
end;
begin
GetIntVec($33,Mi);
if Mi=nil then
MousePresent:=false
else if byte(Mi^)=$cE then
MousePresent:=false
else MousePresent:=true
end.
Вот "правильный" пример для графического режима VGA 640x480 пикселов:
uses graph,Mouse,crt;
var grDriver : integer; grMode : integer;
Errcode : integer;
procedure init;
begin
grDriver:=VGA;grMode:=VGAHi;
initgraph(grDriver, grMode, '');
Errcode:=graphresult;
if Errcode <> grOk then begin
writeln('Graphics error: ',
grapherrormsg(Errcode)); halt;
end;
end;
function max(x,y:integer):integer;
begin
if x<y then max:=y else max:=x;
end;
function min(x,y:integer):integer;
begin
if x<y then min:=x else min:=y;
end;
var n,x,y,x0,y0,b:integer; s1,s2,s3:string;
begin
init;
mouseinit(n);
{Просто картинка для фона}
setcolor (WHITE);
bar (100,100,200,200);
setfillstyle (solidfill,YELLOW);
bar (200,200,300,300);
settextJustify(centertext, centertext);
x0:=-1; y0:=-1;
mouseshow;
repeat
mouseread (x,y,b);
{Рисуем красный квадратик в месте любого щелчка мышью}
if b<>0 then begin
mousehide;
setfillstyle (solidfill,RED);
bar (max(x-4,0),max(y-4,0),min(x+4,639),min(y+4,479));
setfillstyle (solidfill,BLACK);
mouseshow;
end;
if (x<>x0) or (y<>y0) then begin
{Выводим координаты мыши в постоянно отрисовываемом блоке внизу}
str (x,s1); str (y,s2); str (b, s3);
setfillstyle (solidfill,BLACK);
bar (getmaxx div 2-50, getmaxy-15,getmaxx div 2+50,getmaxy-5);
outtextxy (getmaxx div 2, getmaxy-10,s1+' '+s2+' '+s3);
x0:=x; y0:=y;
end;
until keypressed;
mousehide;
closegraph;
end.
Обратите внимание, что после mouseinit мышь "спрятана" и включить её надо 1 раз перед основным циклом программы.
Для текстовой консоли есть в листинге 11.3
|
|