program lab1_10;

uses crt,graph;

const
M1 : array[1..4,1..2] of real =((20,20),
(250,20),
(250,180),
(20,180));
M2: array[1..3,1..2] of real =((500,300),
(600,400),
(400,400));

D:integer=1;
var
X,xc1,xc2,xc3,xc4,yc1,yc2,yc3,yc4: real;
check:boolean;
gd,gm:integer;
DXY: array[1..4,1..2] of real;
M,MM: array[1..4] of integer;
Y, Q, P: array[1..4] of real;

procedure Dr(x1,x2,x3,x4,y1,y2,y3,y4:real);
begin

LineTo(round(x2),round(y2));
LineTo(round(x3),round(y3));
LineTo(round(x4),round(y4));
LineTo(round(x1),round(y1));
end;
procedure filling;
var
I,J, K : integer;
begin
MoveTo(round(M1[1,1]), round(M1[1,2]));
xc1:= M1[1,1];
xc2:=M1[2,1];
xc3:=M1[3,1];
xc4:=M1[4,1];
yc1:= M1[1,2];
yc2:=M1[2,2];
yc3:=M1[3,2];
yc4:=M1[4,2];
Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4);
Readkey;

for I:=1 to 15 do
begin
Delay(20000);
if not check then
begin
setcolor(white);
Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4);
setcolor(magenta);
end;
xc1:= xc1+dxy[1,1];
xc2:= xc2+dxy[2,1];
xc3:= xc3+dxy[3,1];
xc4:= xc4+dxy[4,1];
yc1:= (M2[M[1],2]- M1[1,2])/(M2[M[1],1]- M1[1,1])*(xc1-M1[1,1])+M1[1,2];
yc2:= (M2[M[2],2]- M1[2,2])/(M2[M[2],1]- M1[2,1])*(xc2-M1[2,1])+M1[2,2];
yc3:= (M2[M[3],2]- M1[3,2])/(M2[M[3],1]- M1[3,1])*(xc3-M1[3,1])+M1[3,2];
yc4:= (M2[M[4],2]- M1[4,2])/(M2[M[4],1]- M1[4,1])*(xc4-M1[4,1])+M1[4,2];


MoveTo(round(xc1), round(yc1));
Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4);
end;

MoveTo(round(x), round(yc1));
Dr(X, x, x, x, yc1, yc2, yc3, yc4);
DXY[1,1]:= (M2[1,1]-X)/15;
DXY[2,1]:= (M2[2,1]-X)/15;
DXY[3,1]:= (M2[3,1]-X)/15;
DXY[4,1]:= (M2[D,1]-X)/15;
P[1]:= X;
P[2]:=x;
P[3]:=x;
P[4]:=x;

for I:=1 to 15 do
begin
if not check then
begin
setcolor(white);
Dr(x, x, x, x, yc1, yc2, yc3, yc4);
setcolor(magenta);
end;
P[1]:= P[1]+dxy[1,1];
P[2]:= P[2]+dxy[2,1];
P[3]:= P[3]+dxy[3,1];
P[4]:= P[4]+dxy[4,1];
Q[1]:= (M2[1,2]-M1[MM[1],2])/(M2[1,1]-M1[MM[1],1])*(P[1]-M1[MM[1],1])+M1[MM[1],2];
Q[2]:= (M2[2,2]- M1[MM[2],2])/(M2[2,1]- M1[MM[2],1])*(P[2]-M1[MM[2],1])+M1[MM[2],2];
Q[3]:= (M2[3,2]- M1[MM[3],2])/(M2[3,1]- M1[MM[3],1])*(P[3]-M1[MM[3],1])+M1[MM[3],2];
Q[4]:= (M2[D,2]- M1[MM[4],2])/(M2[D,1]- M1[MM[4],1])*(P[4]-M1[MM[4],1])+M1[MM[4],2];
Delay(20000);
{ Readkey;}
if not check then cleardevice;
MoveTo(round(P[1]), round(Q[1]));
Dr(P[1], P[2], P[3], P[4], Q[1], Q[2], Q[3], Q[4]);
end;

MoveTo(round(M2[1,1]), round(M2[1,2]));
Dr(M2[1,1], M2[2,1], M2[3,1], M2[D,1], M2[1,2], M2[2,2], M2[3,2], M2[D,2]);
end;

procedure corr;
var
I,B, J,K: integer;
bb: boolean;
begin
randomize;
for I:=1 to 4 do
begin
MM[I]:= 0;
M[I]:=0;
end;
for I:=1 to 4 do
begin
while true do
begin
bb:=false;
B:= random(4)+1;
for J:=1 to 4 do
if M[J]= B then
begin
bb:= true;
break;
end;
if not bb then
begin
M[I]:= B;
MM[B]:=I;
break;
end;
end;

end;
for I:=1 to 4 do
if M[I]=4 then
M[I]:= D;
X:= (M1[3,1]+M2[3,1])/2;
y[1]:=(M2[M[1],2]- M1[1,2])/(M2[M[1],1]- M1[1,1])*(xc1-M1[1,1])+M1[1,1];
y[2]:=(M2[M[2],2]- M1[2,2])/(M2[M[2],1]- M1[2,1])*(xc2-M1[2,1])+M1[2,1];
y[3]:=(M2[M[3],2]- M1[3,2])/(M2[M[3],1]- M1[3,1])*(xc3-M1[3,1])+M1[3,1];
y[4]:=(M2[M[4],2]- M1[4,2])/(M2[M[4],1]- M1[4,1])*(xc4-M1[4,1])+M1[4,1];
for I:=1 to 4 do
begin
DXY[I,1]:= (X-M1[I,1])/15;
DXY[I,2]:= (Y[I]-M1[I,2])/15;
end;
end;

procedure preparation;
var i:integer;
c:char;
begin
writeln('Points correspondence:');
for i:=1 to 4 do
writeln(MM[i],'-',M[i]);
writeln('Do you want to show all current figures (slave) (y/n)?');
readln(c);
if (c='y') or (c='Y') then check:=true else check:=false;
end;


begin
corr;
preparation;
gd:=detect;
gm:=0;
initgraph(GD,gm,'');

SetBkColor(White);
SetColor(Magenta);
filling;
ReadKey;
closegraph;
end.

Соседние файлы в папке Архив указанных лаб