Помощь - Поиск - Пользователи - Календарь
Полная версия: Мышка+Графика
Форум «Всё о Паскале» > 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 этим кодом аналогично работает.

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