Program TrigonDemo;
{$G+,N+,E-,D-}
Uses Graph, CRT;
type
Real = Extended;
const
OldInt1Ch : Pointer = NIL;
flag : Word = 0;
Sx : Real = 20.0;
Sy : Real = 20.0;
var
D, R, e : Integer;
x, y : array [0..3] of Real;
x_, y_ : array [0..3] of Integer;
xp, yp : array [0..3] of Integer;
i : Integer;
yy : Real;
{Самые важные процедуры и функции - для определения положения точки}
{относительно треугольника}
{По двум точкам составлено уравнение прямой. Возвращает значение}
{функции в точке, положение которой относительно прямой нужно определить}
{=0, если точка лежит на прямой, <0 - выше, >0 - ниже}
Function FLine(indx1, indx2, dot : Integer) : Real;
begin
FLine := (x[dot]-x[indx1])*(y[indx2]-y[indx1])-(y[dot]-y[indx1])*(x[indx2]-x[indx1]);
end;
Function WhereDot : Byte;
var
tmp : Byte;
t : Real;
S : String;
begin
if ((FLine(1, 2, 0)=0) and (FLine(3, 0, 1)*FLine(3, 0, 2)<=0)) or
((FLine(2, 3, 0)=0) and (FLine(1, 0, 2)*FLine(1, 0, 3)<=0)) or
((FLine(3, 1, 0)=0) and (FLine(2, 0, 3)*FLine(2, 0, 1)<=0)) then
WhereDot := 0 else
if (FLine(1, 2, 3)*FLine(1, 2, 0)>0) and (FLine(2, 3, 1)*FLine(2, 3, 0)>0) and (FLine(1, 3, 2)*FLine(1, 3, 0)>0)
then WhereDot := 1 else WhereDot := 2;
end;
{Процедура ожидания обратного хода луча}
Procedure WaitRetrace;Assembler;
asm
mov dx, 03DAh
@VRTL1:
in al, dx
test al, 8
jnz @VRTL1
@VRTL2:
in al, dx
test al, 8
jnz @VRTL2
ret
end;
{++++++++++++++++++++++++++++++++++++++}
{Процедуры и функции для работы с мышью}
Procedure InitMouse; Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse; Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse; Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
end;
Function MouseY : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
end;
Procedure MouseGotoXY(X, Y : Integer); Assembler;
asm
mov ax, 4
mov cx, word ptr X
mov dx, word ptr Y
int 33h
end;
Function MouseIn(X1,Y1,X2,Y2: Integer): Boolean;
begin
MouseIn := (MouseX>X1) and (MouseXY1) and (MouseY 0 do;
end;
{----------------------------------------}
{Установка счётчиков сигналов таймера}
Procedure SetInt1Ch; Assembler;
asm
push es
mov ax, 351Ch
int 21h
mov word ptr OldInt1Ch, bx
mov word ptr OldInt1Ch+2, es
mov word ptr @OI1Ch, bx
mov word ptr @OI1Ch+2, es
pop es
mov ax, 251Ch
push ds
mov dx, seg @int1Ch
mov ds, dx
mov dx, offset @int1Ch
int 21h
pop ds
ret
@int1Ch:
pushf
push ds
push ax
mov ax, seg flag
mov ds, ax
inc word ptr flag
pop ax
pop ds
popf
db 02Eh, 0EAh {cs:jmp 00000000}
@OI1Ch :
dd 0
{ iret}
end;
{Восстаналиваем обработчик прерывания}
Procedure RestoreInt1Ch; Assembler;
asm
push ds
lds dx, OldInt1Ch
mov ax, 251Ch
int 21h
pop ds
end;
{Процедуры и функции "интерфейсика"}
{Строит оси координат}
Procedure BuildScreen;
var
i, j : Byte;
begin
SetBkColor(Black);
ClearViewPort;
SetColor(DarkGray);
MoveTo(0, 240);
LineTo(640, 240);
LineTo(630, 238);
LineTo(630, 242);
LineTo(640, 240);
MoveTo(320, 480);
LineTo(320, 0);
LineTo(318, 10);
LineTo(322, 10);
LineTo(320,0);
SetColor(LightGray);
for i := 1 to 32 do Line(i*20, 239, i*20, 241);
for i := 1 to 24 do Line(319, i*20, 321, i*20);
SetColor(Brown);
OutTextXY(324, 230, '0');
OutTextXY(632, 230, 'x');
OutTextXY(324, 3, 'y');
end;
{Рисует белый треугольник и красную точку. А также выводит сообщение}
{о положении точки}
Procedure DrawTrig;
var
i : Word;
begin
SetColor(White);
SetWriteMode(XORPut);
WaitRetrace;
HideMouse;
MoveTo(xp[1], yp[1]);
LineTo(xp[2], yp[2]);
LineTo(xp[3], yp[3]);
LineTo(xp[1], yp[1]);
MoveTo(x_[1], y_[1]);
LineTo(x_[2], y_[2]);
LineTo(x_[3], y_[3]);
LineTo(x_[1], y_[1]);
SetColor(LightRed);
MoveTo(xp[0], yp[0]);
LineTo(xp[0], yp[0]);
MoveTo(x_[0], y_[0]);
LineTo(x_[0], y_[0]);
ShowMouse;
for i := 0 to 3 do
begin
xp[i] := x_[i];
yp[i] := y_[i];
end;
SetWriteMode(NormalPut);
SetColor(Black);
SetFillStyle(1, 0);
Bar(0,469,200,479);
SetColor(LightBlue);
case WhereDot of
0: OutTextXY(1,469,'На стороне треугольника');
1: OutTextXY(1,469,'Внутри треугольника');
2: OutTextXY(1,469,'Снаружи треугольника');
end;
end;
{Осуществляет перемещение точки (при нажатии левой кнопки)}
{и перемещение координат вершин треугольника (при нажатии правой на вершине)}
Procedure MoveTrigDot(k : Word);
var
Mx, My : Integer;
begin
While MouseButt<>0 do
begin
if Mx <> MouseX then
begin
x_[k] := MouseX;
x[k] := (x_[k]-320)/Sx;
y[k] := (240 - y_[k])/Sy;
DrawTrig;
end;
if My <> MouseY then
begin
y_[k] := MouseY;
x[k] := (x_[k]-320)/Sx;
y[k] := (240 - y_[k])/Sy;
DrawTrig;
end;
Mx := MouseX;
My := MouseY;
end;
x[k] := (x_[k]-320)/Sx;
y[k] := (240 - y_[k])/Sy;
DrawTrig;
end;
{Основная программа}
begin
D := Detect;
InitGraph(D, R, '');
e := GraphResult;
if e <> 0 then
begin
WriteLn('Ошибка при установлении графического режима!');
WriteLn('В папке с программой (demotrig.exe) должен находиться файл EGAVGA.BGI');
WriteLn(GraphErrorMsg(e));
end;
SetInt1Ch;
InitMouse;
x[0] := 0;
y[0] := 0;
x[1] := 1;
y[1] := 1;
x[2] := 1;
y[2] := -1;
x[3] := -1;
y[3] := 0;
for i := 0 to 3 do
begin
x_[i] := 320 + Round(Sx*x[i]);
y_[i] := 240 - Round(Sy*y[i]);
end;
BuildScreen;
ShowMouse;
DrawTrig;
While not KeyPressed do
begin
if MouseButt = 2 then
begin
for i := 1 to 3 do
if MouseIn(xp[i]-2, yp[i]-2, xp[i]+2, yp[i]+2) then MoveTrigDot(i);
end;
if MouseButt = 1 then MoveTrigDot(0);
end;
ReadKey;
HideMouse;
RestoreInt1Ch;
CloseGraph;
end.
< -->