1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
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
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
Понятно .. Просто я первый раз встречаю тип pointtype
Как я поняла, (X:250; Y:244) {1 положение}, (X:280; Y:244), {2 положение} и т.п., а далее уже идёт выбор из этой записи, какое положение займет "глаз" ?
Именно так... Кроме этого "старое" изображение глаза затирается цветом фона (обычным Circle с маленьким радиусом это делается очень быстро), и отпадает необходимость пользоваться очень медленной операцией ClearDevice
Господа, глюк: Если водить мышью по зрачкам то.... А всё дело в устройстве курсора крысы... Она своим "телом" прикрывает зрачок от черного круга... Так уж устроена... Глупо, но баллы могут снизить ... Единственный способ лечения:
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;