Пример: Домик в Паскале
Навигация
Чат
Форум
Загрузка...

Скачать: DOM.PAS

В программе применены:

## Код

uses Graph, CRT;

var
Gd, Gm : Integer;

type
XY = record
X : Integer;
Y : Integer;
end;

procedure LineXY(A, B : XY);
begin
Line(A.X, A.Y, B.X, B.Y);
end;

procedure AddXY(A, B : XY; var Res : XY);
begin
Res.X := A.X + B.X;
Res.Y := A.Y + B.Y;
end;

procedure SubXY(A, B : XY; var Res : XY);
begin
Res.X := A.X - B.X;
Res.Y := A.Y - B.Y;
end;

procedure MulXY(A : XY; L : Integer; var Res : XY);
begin
Res.X := A.X * L;
Res.Y := A.Y * L;
end;

procedure CopyXY(A : XY; var Res : XY);
begin
Res.X := A.X;
Res.Y := A.Y;
end;

procedure DrawRect(Origin, Dir1, Dir2 : XY;
X1, Y1, X2, Y2 : Integer; Fill, Draw : Boolean);
var
a, b, c, d, e, f, g : XY;
Points :  array[1 .. 5] of XY;
begin
MulXY(Dir1, X1, a);
MulXY(Dir1, X2, b);
MulXY(Dir2, Y1, c);
MulXY(Dir2, Y2, d);
AddXY(Origin, a, e);
AddXY(e, c, Points[1]);
AddXY(e, d, Points[2]);
AddXY(Origin, b, f);
AddXY(f, d, Points[3]);
AddXY(f, c, Points[4]);
CopyXY(Points[1], Points[5]);
if Fill then
FillPoly(5, Points);
if Draw then
DrawPoly(5, Points);
end;

procedure DrawWall(Origin, Dir1, Dir2 : XY;
L1, L2 : Integer; Oddity : Boolean);
{ Рисует кирпичную стену }
var
i, j : Integer;
a, b, c, d, e : XY;
Poly : array[1 .. 5] of XY;
begin
{ Внешний контур }
CopyXY(Origin, Poly[1]);
MulXY(Dir1, L1, c);
MulXY(Dir2, L2, d);
AddXY(c, d, e);
AddXY(Origin, c, Poly[2]);
AddXY(Origin, e, Poly[3]);
AddXY(Origin, d, Poly[4]);
CopyXY(Origin, Poly[5]);
FillPoly(5, Poly);
DrawPoly(5, Poly);
{ Кирпичи }
for i := 1 to L2 - 1 do
begin
{ Line(Origin + Dir2 * i,
Origin + Dir2 * i + Dir1 * L1) }

MulXY(Dir2, i, a);
AddXY(Origin, a, b);
AddXY(b, c, d);
LineXY(b, d);
end;
for i := 1 to L2 do
begin
MulXY(Dir2, i - 1, a);
AddXY(Origin, a, b);
MulXY(Dir2, i, a);
AddXY(Origin, a, c);
for j := 1 to L1 - 1 do
begin
if ((i mod 2) = 1) xor ((j mod 2) = 1) xor Oddity then
begin
{ Line(Origin + Dir2 * (i - 1) + Dir1 * j,
Origin + Dir2 * i       + Dir1 * j) }

MulXY(Dir1, j, a);
AddXY(b, a, d);
AddXY(c, a, e);
LineXY(d, e);
end;
end;
end;
end;

type XYC = record
X, Y, C : LongInt; { проективные координаты }
end;

procedure XY2XYC(A : XY; var Res : XYC);
begin
Res.X := A.X;
Res.Y := A.Y;
Res.C := 1;
end;

procedure XYC2XY(A : XYC; var Res : XY);
var
ResX, ResY : LongInt;
begin
ResX := A.X div A.C;
ResY := A.Y div A.C;
Res.X := ResX;
Res.Y := ResY;
end;

procedure IncidXYC(A, B : XYC; var Res : XYC);
begin
Res.X :=  A.Y * B.C - A.C * B.Y;
Res.Y := -A.C * B.X + A.X * B.C;
Res.C :=  A.X * B.Y - A.Y * B.X;
end;

procedure Intersect(a1, a2, b1, b2 : XY; var Res : XY);
{ Точка пересечения линий a1a2 и b1b2 }
var pa1, pa2, pb1, pb2, { проективные координаты точек a1, a2, b1 и b2 }
pal, pbl, { проективные координаты линий a1a2 и b1b2 }
pRes : XYC; { проективные координаты точки пересечения }
begin
XY2XYC(a1, pa1); XY2XYC(a2, pa2); XY2XYC(b1, pb1); XY2XYC(b2, pb2);
IncidXYC(pa1, pa2, pal);
IncidXYC(pb1, pb2, pbl);
IncidXYC(pal, pbl, pRes);
XYC2XY(pRes, Res);
end;

procedure Cloud(X, Y : Integer);
const CloudImage : array[1 .. 7] of String =
('        .  .    .    .             ',
'     .    .   .   .     .  .       ',
'   .  .  .   .      .  .  .  .     ',
'  .   . .  .  .  .    .   .   .  . ',
'   .  .   .  .  .  . .  .   .  .   ',
'     .   .   . . .  .    . .       ',
'                                   ');
var
i, j : Integer;
begin
for i := 1 to 7 do
for j := 1 to Length(CloudImage[1]) do
if CloudImage[i, j] = '.' then
PutPixel(X + j - 1, Y + i - 1, LightGray);
end;

var
a, b, c, d, e, f, g, h, i, j, k, l, m, n, o,
p, q, r, s, t, u, v, w, x, y, z, a0, b0, c0 : XY;
Roof : array[1 .. 5] of XY;
Roof2 : array[1 .. 4] of XY;
Shadow : array[1 .. 9] of XY;
begin
Gd := VGA;
Gm := VGAHi; { 640x480 }
InitGraph(Gd, Gm, 'X:\BP');

{ Небо }
SetFillStyle(SolidFill, LightCyan);
Bar(0, 0, 639, 479);

{ Облака }
Cloud( 89,  91); Cloud( 90,  82); Cloud( 11,  91); Cloud( 72,  98);
Cloud( 52,  27); Cloud( 42,  77); Cloud( 98,  58); Cloud( 48,  12);
Cloud( 67,  62); Cloud(167,  34); Cloud( 62,  73); Cloud(363,  54);
Cloud(122,  46); Cloud( 40,  46); Cloud( 27,  26); Cloud( 49,  23);

{ Трава }
SetFillStyle(SolidFill, LightGreen);
FillEllipse(320, 380, 500, 200);

{ Кирпичные стены }
SetLineStyle(SolidLn, 0, NormWidth);
SetColor(Black);
SetFillStyle(SolidFill, Brown);

a.X := 200;
a.Y := 150;
b.X := 10;
b.Y := 0;
c.X := 0;
c.Y := 10;
DrawWall(a, b, c, 20, 20, False);
MulXY(b, 20, d);
AddXY(a, d, e);
f.X := 5;
f.Y := -5;
DrawWall(e, f, c, 20, 20, True);

{ Крыша }
MulXY(b, 4, g);
SubXY(a, g, h);
MulXY(f, 4, i);
SubXY(h, i, Roof[1]);
AddXY(e, g, j);
SubXY(j, i, Roof[2]);
CopyXY(Roof[2], Roof2[1]);
MulXY(f, 20 + 4, k);
AddXY(e, k, l);
AddXY(l, g, Roof2[2]);
MulXY(f, 10, m);
AddXY(a, m, n);
MulXY(c, 9, o);
SubXY(n, o, p);
MulXY(b, 10 - 4, q);
AddXY(p, q, Roof[4]);
MulXY(b, 10 + 4, r);
AddXY(p, r, Roof[3]);
CopyXY(Roof[3], Roof2[3]);

CopyXY(Roof[1], Roof[5]);
CopyXY(Roof2[1], Roof2[4]);

SetFillStyle(SolidFill, LightGray);
FillPoly(5, Roof);
DrawPoly(5, Roof);
SetFillStyle(SolidFill, DarkGray);
FillPoly(4, Roof2);
DrawPoly(4, Roof2);

{ Тень }
s.X := 8;
s.Y := 3;
MulXY(c, 20, t);
MulXY(s, 20, u);
AddXY(t, u, v);
AddXY(a, t, Shadow[1]);
AddXY(a, v, w);
AddXY(Roof[1], v, Shadow[3]);
MulXY(f, 20 + 4 + 4, x);
AddXY(Shadow[3], x, y);
Intersect(Shadow[1], w, Shadow[3], y, Shadow[2]);
AddXY(Roof[2], v, Shadow[4]);
AddXY(Roof2[2], v, Shadow[5]);
AddXY(e, t, Shadow[8]);
MulXY(f, 20, z);
AddXY(Shadow[8], z, Shadow[7]);
SubXY(Shadow[7], u, a0);
Intersect(Shadow[5], y, Shadow[7], a0, Shadow[6]);
CopyXY(Shadow[1], Shadow[9]);

SetFillStyle(SolidFill, Green);
FillPoly(9, Shadow);

{ Дверь }

SetFillStyle(SolidFill, Red);
DrawRect(e, f, c, 7, 8, 13, 20, True, True);

{ Окно }
SetColor(White);
SetFillStyle(SolidFill, Blue);
DrawRect(a, b, c, 6, 6, 14, 14, True, True);
DrawRect(a, b, c, 10, 6, 14, 14, True, True);
DrawRect(a, b, c, 10, 6, 14, 9, True, True);

{ Табличка }
SetColor(Blue);
SetFillStyle(SolidFill, White);
DrawRect(a, b, c, 1, 2, 19, 5, True, True);

SetTextStyle(5, HorizDir, 1);
OutTextXY(a.X + b.X * 1 + c.X * 1 + 3, a.Y + b.Y * 2 + c.Y * 2,
'Дом-2: Перестройка');

while not KeyPressed do
Delay(200);

CloseGraph;
end.

 Код для вставки: :: :: :: ГОСТ :: Поделиться: // Для форумов: [url=http://pascal.net.ru/%D0%94%D0%BE%D0%BC%D0%B8%D0%BA]Пример: Домик в Паскале[/url] Для блогов: Пример: Домик в Паскале Для Википедии: [http://pascal.net.ru/%D0%94%D0%BE%D0%BC%D0%B8%D0%BA Пример: Домик в Паскале] По ГОСТу: Пример: Домик в Паскале [Электронный ресурс] // Сайт «Всё о Паскале». — Режим доступа: http://pascal.net.ru/%D0%94%D0%BE%D0%BC%D0%B8%D0%BA (дата обращения: 15.06.2024).  http://pascal.net.ru/%D0%94%D0%BE%D0%BC%D0%B8%D0%BA

Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"