Помощь - Поиск - Пользователи - Календарь
Полная версия: Мышка+Графика
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Анна
Собственно задача: "Глаза" должны следить за курсором мыши smile.gif. Вроде бы все ок, следят smile.gif, но происходит мигание .. как это можно устранить?

uses Graph, Crt;

var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;

button,x,y,z, mouse_keys: word;
mouse_X, mouse_Y:word;


function mouse_init: boolean;
var
m:boolean;
begin asm
mov ax,0
int 33h
mov @Result, al
end;
end;

procedure mouse_on;
begin asm
mov ax,1
int 33h
end;
end;

procedure mouse_off;
begin asm
mov ax,2
int 33h
end;
end;

procedure mouse_get(var m_k:word; var m_x:word; var m_y:word);
begin asm
mov ax,3
int 33h

les di, m_k
mov es:[di], bx
les di, m_x
mov es:[di], cx
les di, m_y
mov es:[di], dx
end;
end;

procedure first;
begin
setcolor (green);
circle (265,225,35);
setcolor (red);
if (x<265) and (y>225) then begin cleardevice ; circle (250,244,8); {lev. niz} end;
if (x>265) and (y>225) then begin cleardevice ; circle (280,244,8); {prav. niz} end;
if (x<265) and (y<225) then begin cleardevice ;circle (250,204,8); {lev. verh} end;
if (x>265) and (y<225) then begin cleardevice ;circle (280,204,8); {prav. verh} end;

end;

procedure second;
begin
setcolor (green);
circle (335,225,35);
setcolor (red);
if (x<335) and (y>225) then begin cleardevice ; circle (320,244,8); end;
if (x>335) and (y>225) then begin cleardevice ;circle (350,244,8); end;
if (x<335) and (y<225) then begin cleardevice ;circle (320,204,8)end;
if (x>335) and (y<225) then begin cleardevice ;circle (350,204,8); end;

end;


begin
grDriver := VGA;
grMode := VGAhi;
InitGraph(grDriver, grMode,' ');
ErrCode := GraphResult;
if ErrCode = grOk then


begin

setcolor(green);
SetLineStyle(10, 10 ,10);

mouse_on;
setcolor(red);
SetLineStyle(10, 10 ,10);



repeat

mouse_on;
mouse_get(button, x,y);
first;
second;

until Keypressed;
CloseGraph;
end
else
Writeln('Error:', GraphErrorMsg(ErrCode));
end.
volvo
blink.gif
Ну, так у тебя же там постоянно ClearDevice вызывается... Вот оно и моргает - перерисовывается...
Можно, кстати, сделать вообще без моргания:
uses Graph, Crt;

var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;

button,x,y,z, mouse_keys: word;
mouse_X, mouse_Y:word;


function mouse_init: boolean;
var
m:boolean;
begin asm
mov ax,0
int 33h
mov @Result, al
end
end;

procedure mouse_on;
begin asm
mov ax,1
int 33h
end
end;

procedure mouse_off;
begin asm
mov ax,2
int 33h
end
end;

procedure mouse_get(var m_k:word; var m_x:word; var m_y:word);
begin asm
mov ax,3
int 33h

les di, m_k
mov es:[di], bx
les di, m_x
mov es:[di], cx
les di, m_y
mov es:[di], dx
end
end;

var
f, s: byte;

procedure first;
const
arr: array[1 .. 4] of pointtype = (
(X:250; Y:244), (X:280; Y:244),
(X:250; Y:204), (X:280; Y:204)
);
begin
setcolor(green); circle(265,225,35);
setcolor(black); circle(arr[f].X, arr[f].Y, 8);
if y > 225 then
if x < 265 then f := 1 else f := 2
else
if x < 265 then f := 3 else f := 4;
setcolor(red); circle(arr[f].X, arr[f].Y, 8);
end;

procedure second;
const
arr: array[1 .. 4] of pointtype = (
(X:320; Y:244), (X:350; Y:244),
(X:320; Y:204), (X:350; Y:204)
);
begin
setcolor(green); circle(335,225,35);
setcolor(black); circle(arr[s].X, arr[s].Y, 8);
if y > 225 then
if x < 335 then s := 1 else s := 2
else
if x < 335 then s := 3 else s := 4;
setcolor(red); circle(arr[s].X, arr[s].Y, 8);

end;


begin
grDriver := VGA;
grMode := VGAhi;
InitGraph(grDriver, grMode,' ');
ErrCode := GraphResult;
if ErrCode = grOk then begin

setcolor(green);
SetLineStyle(10, 10 ,10);

mouse_on;
setcolor(red);
SetLineStyle(10, 10 ,10);

f := 1; s := 1;

repeat

mouse_on;
mouse_get(button, x,y);
first;
second;

until Keypressed;
CloseGraph;
end
else
Writeln('Error:', GraphErrorMsg(ErrCode));
end.
Анна
smile.gif Понятно ..
Просто я первый раз встречаю тип pointtype

Как я поняла, (X:250; Y:244) {1 положение},
(X:280; Y:244), {2 положение} и т.п., а далее уже идёт выбор из этой записи, какое положение займет "глаз" ?
volvo
yes2.gif Именно так... Кроме этого "старое" изображение глаза затирается цветом фона (обычным Circle с маленьким радиусом это делается очень быстро), и отпадает необходимость пользоваться очень медленной операцией ClearDevice
Zxzc
Господа, глюк: Если водить мышью по зрачкам то.... А всё дело в устройстве курсора крысы... Она своим "телом" прикрывает зрачок от черного круга... Так уж устроена... Глупо, но баллы могут снизить dry.gif ...
Единственный способ лечения:
repeat
mouse_get(button, x,y);
If (xs<>x) or (ys<>y) then
begin
mouse_off;
first;
second;
mouse_on;
xs:=x;
ys:=y;
end;
until Keypressed;

Чуть заметно моргает мышь, ну и что?
Анна
А зачем такой длинный код?
repeat

mouse_get(button, x,y);

begin

mouse_off;

first;

second;

mouse_on;

end;

until Keypressed;


C этим кодом аналогично работает.

И ещё вопрос, как можно сделать, чтобы "глаза" плавно следили за курсором (не так резко)?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.