begin
if m[1,1] <> m[2,1] then
begin
xa:=((y-m[1,1])*(m[2,2]-m[1,2]))div(m[2,1]-m[1,1])+m[1,2];
xb:=((y-m[1,1])*(m[3,2]-m[1,2]))div(m[3,1]-m[1,1])+m[1,2];
end
else
begin
xa:=m[1,1];
xb:=m[2,1];
end;
Draw_Texture(xa,y,xb,y);
end;
for y:=m[2,1] to m[3,1] do
begin
if m[2,1] <> m[3,1] then
begin
xa:=((y-m[2,1])*(m[3,2]-m[2,2]))div(m[3,1]-m[2,1])+m[2,2];
xb:=((y-m[1,1])*(m[3,2]-m[1,2]))div(m[3,1]-m[1,1])+m[1,2];
end
else
begin
xa:=m[2,1];
xb:=m[3,1];
end;
Draw_Texture(xa,y,xb,y)
end;
end;
procedure TDraw_PLT.Draw_Mnogougolnik(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);
var
m_v: array [1..6, 1..2] of integer;
m_n: array [1..6, 1..2] of integer;
m_y: array [1..6, 1..2] of integer;
Cort: array [1..6] of integer;
i,k, min,max, j, y, x: integer;
sr:real;
begin
{Деление шестиугольника пополам}
cort[1]:=y1;
cort[2]:=y2;
cort[3]:=y3;
cort[4]:=y4;
cort[5]:=y5;
cort[6]:=y6;
min:=y1;
max:=y1;
for k:=1 to 6 do
begin
if cort[k]<min then min:=cort[k];
if cort[k]>max then max:=cort[k];
end;
sr:=(min+max)/ 2;
{сортировка вершин шестиугольника}
m_y[1, 1]:=y1;
m_y[2, 1]:=y2;
m_y[3, 1]:=y3;
m_y[4, 1]:=y4;
m_y[5, 1]:=y5;
m_y[6, 1]:=y6;
m_y[1, 2]:=x1;
m_y[2, 2]:=x2;
m_y[3, 2]:=x3;
m_y[4, 2]:=x4;
m_y[5, 2]:=x5;
m_y[6, 2]:=x6;
For i:=1 to 2 do
begin
for j:=1 to 6 do
begin
if (cort[j]>sr) or (cort[j]=sr) then
m_v[j,i]:=m_y[j,i]
else
m_v[j,i]:=0 ;
if cort[j]<sr then
m_n[j,i]:= m_y[j,i]
else
m_n[j,i]:=0;
end;
end;
{сортировка верхних вершин}
for j:= 1 to 7 do
begin
for i:= 1 to 5 do
begin
if (m_v[i+1, 2]<m_v[i, 2]) then
begin
y:= m_v[i+1, 1];
x:= m_v[i+1, 2];
m_v[i+1, 1]:=m_v[i, 1];
m_v[i+1, 2]:=m_v[i, 2];
m_v[i, 1]:= y;
m_v[i, 2]:= x;
end;
end;
end;
{сортировка нижних вершин}
for j:= 1 to 7 do
begin
for i:= 1 to 5 do
begin
if m_n[i+1, 2]>m_n[i, 2] then
begin
y:= m_n[i+1, 1];
x:= m_n[i+1, 2];
m_n[i+1, 1]:=m_n[i, 1];
m_n[i+1, 2]:=m_n[i, 2];
m_n[i, 1]:= y;
m_n[i, 2]:= x;
end;
end;
end;
{все вершины шестиугольника в один массив}
for j:=1 to 2 do
begin
for i:=1 to 6 do
begin
if (m_v[i,j]<>0)and (m_v[i+6,j+6]<>0) then m_y[i,j]:=m_v[i,j]
else m_y[i,j]:=m_n[i,j]
end;
end;
TDraw_PLT.Draw_Line(m_y[1,2], m_y[1,1],m_y[2,2], m_y[2,1]);
TDraw_PLT.Draw_Line(m_y[2,2], m_y[2,1],m_y[3,2], m_y[3,1]);
TDraw_PLT.Draw_Line(m_y[3,2], m_y[3,1],m_y[4,2], m_y[4,1]);
TDraw_PLT.Draw_Line(m_y[4,2], m_y[4,1],m_y[5,2], m_y[5,1]);
TDraw_PLT.Draw_Line(m_y[5,2], m_y[5,1],m_y[6,2], m_y[6,1]);
TDraw_PLT.Draw_Line(m_y[6,2], m_y[6,1],m_y[1,2], m_y[1,1]);
end;
procedure TDraw_PLT.Draw_MnogougolnikZakr( x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);
var
m_v: array [1..6, 1..2] of integer;
m_n: array [1..6, 1..2] of integer;
m_y: array [1..6, 1..2] of integer;
Cort: array [1..6] of integer;
i,k, min,max, j, y, x: integer;
sr_x,sr_y,bl_versh:real;
begin
{Деление шестиугольника пополам по х}
cort[1]:=x1;
cort[2]:=x2;
cort[3]:=x3;
cort[4]:=x4;
cort[5]:=x5;
cort[6]:=x6;
min:=x1;
max:=x1;
for k:=1 to 6 do
begin
if cort[k]<min then min:=cort[k];
if cort[k]>max then max:=cort[k];
end;
sr_x:=(min+max)/ 2;
{Деление шестиугольника пополам по оси у}
cort[1]:=y1;
cort[2]:=y2;
cort[3]:=y3;
cort[4]:=y4;
cort[5]:=y5;
cort[6]:=y6;
min:=y1;
max:=y1;
for k:=1 to 6 do
begin
if cort[k]<min then min:=cort[k];
if cort[k]>max then max:=cort[k];
end;
sr_y:=(min+max)/ 2;
{сортировка вершин шестиугольника}
m_y[1, 1]:=y1;
m_y[2, 1]:=y2;
m_y[3, 1]:=y3;
m_y[4, 1]:=y4;
m_y[5, 1]:=y5;
m_y[6, 1]:=y6;
m_y[1, 2]:=x1;
m_y[2, 2]:=x2;
m_y[3, 2]:=x3;
m_y[4, 2]:=x4;
m_y[5, 2]:=x5;
m_y[6, 2]:=x6;
For i:=1 to 2 do
begin
for j:=1 to 6 do
begin
if (cort[j]>sr_y) or (cort[j]=sr_y) then
m_v[j,i]:=m_y[j,i] else m_v[j,i]:=0 ;
if cort[j]<sr_y then
m_n[j,i]:= m_y[j,i]
else
m_n[j,i]:=0;
end;
end;
{сортировка верхних вершин}
for j:= 1 to 7 do
begin
for i:= 1 to 5 do
begin
if (m_v[i+1, 2]<m_v[i, 2]) then
begin
y:= m_v[i+1, 1];
x:= m_v[i+1, 2];
m_v[i+1, 1]:=m_v[i, 1];
m_v[i+1, 2]:=m_v[i, 2];
m_v[i, 1]:= y;
m_v[i, 2]:= x;
end;
end;
end;
{сортировка нижних вершин}
for j:= 1 to 7 do
begin
for i:= 1 to 5 do
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.