Как нарисовать домик в паскале абс
Перейти к содержимому

Как нарисовать домик в паскале абс

Как нарисовать домик в паскале абс

Если нужно — используйте.
Что не получается?

так все картинки во всех четвертях одинаковы
а в остальных четвертях вашего рисунка что должно быть? пусто?
оператор цикла для рисования забора нужен?

Serge_Bliznykov
Посмотреть профиль
Найти ещё сообщения от Serge_Bliznykov

мне не понятен оператор цикла для одинаковых частей! к примеру:
. (идёт программа)
и вот нужны необходимые одинаковые детали
я не понимаю как работать с циклами для рисования! или как это делать через процедуру?

нет!
у Вас Pascal ABC.NET (он существенно отличается от Pascal ABC)

Serge_Bliznykov
Посмотреть профиль
Найти ещё сообщения от Serge_Bliznykov

что не работает?
ошибка какая?
или как?

Serge_Bliznykov
Посмотреть профиль
Найти ещё сообщения от Serge_Bliznykov

Я пыталась сделать эту часть в цикле:
setpencolor(clyellow);
rectangle(120,90,160,140);
floodfill(122,99,clyellow);
setpencolor(clgreen);
line(140,90,140,160);

но ничего не получается. Прошу, помогите!

Serge_Bliznykov
Посмотреть профиль
Найти ещё сообщения от Serge_Bliznykov


Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке — https://slurm.club/3MeqNEk

Как нарисовать домик в паскале абс

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

  • Проективная геометрия
  • DrawPoly , FillPoly
  • PutPixel

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: Перестройка’ ) ;

Работа с графикой в PascalABC

Работа с графикой в PascalABC

После запуска PascalABC, по умолчанию, запускается текстовый режим. Для работы с графикой служит отдельное графическое окно.

Чтобы его открыть, необходимо подключить модуль GraphABC. В этом модуле содержится набор процедур и функций, предназначенных для работы с графическим экраном, а также некоторые встроенные константы и переменные, которые могут быть использованы в программах с графикой.

С их помощью можно создавать разнообразные графические изображения и сопровождать их текстовыми надписями.

Подключение осуществляется в разделе описаний.
Формат подключения модуля GraphABC:Uses GraphABC;

Графический экран PascalABC (по умолчанию) содержит 640 точек по горизонтали и 400 точек по вертикали. Начало отсчета – левый верхний угол экрана. Ось x направлена вправо, а ось y –вниз. Координаты исчисляются в пикселях.

Все команды библиотеки GraphABC являются подпрограммами и описаны в виде процедур и функций. Для того, что бы команда выполнилась необходимо указать команду и задать значения параметров.

Управление графическим окном

Работа с графикой в PascalABC

После запуска PascalABC, по умолчанию, запускается текстовый режим. Для работы с графикой служит отдельное графическое окно.

Чтобы его открыть, необходимо подключить модуль GraphABC. В этом модуле содержится набор процедур и функций, предназначенных для работы с графическим экраном, а также некоторые встроенные константы и переменные, которые могут быть использованы в программах с графикой.

С их помощью можно создавать разнообразные графические изображения и сопровождать их текстовыми надписями.

Подключение осуществляется в разделе описаний.
Формат подключения модуля GraphABC:Uses GraphABC;

Графический экран PascalABC (по умолчанию) содержит 640 точек по горизонтали и 400 точек по вертикали. Начало отсчета – левый верхний угол экрана. Ось x направлена вправо, а ось y –вниз. Координаты исчисляются в пикселях.

Все команды библиотеки GraphABC являются подпрограммами и описаны в виде процедур и функций. Для того, что бы команда выполнилась необходимо указать команду и задать значения параметров.

Процедуры рисования графических примитивов

Работа с графикой в PascalABC

Процедуры, используемые для работы с цветом

Работа с графикой в PascalABC

Процедуры для работы с текстом

Работа с графикой в PascalABC

Цвета в PascalABC

Работа с графикой в PascalABC

Пример графической программы, рисующей изображение дома:

Работа с графикой в PascalABC

Программа, рисующая фигурку:

Работа с графикой в PascalABC

Практическая работа за компьютером

Задание 1. Определите координаты и составьте программу, выводящую на экран рисунок дома и дерева.

Работа с графикой в PascalABC

Программа будет иметь вид:

Задание 2. Используя оператор цикла и введя переменную для пересчета координат по оси x, постройте “поселок”, состоящий из 5 домов. Внесите соответствующие дополнения и изменения в предыдущую программу.

Работа с графикой в PascalABC

Весь наш «поселок» выстроился вдоль горизонтальной оси экрана — оси X. Построение рисунка начинается с левого верхнего угла стены первого дома — точки с координатами (100, 50). Координата Y не изменяется. Чтобы начать рисовать второй домик, нужно координату X увеличить на 150 (50 точек — ширина первого дома и 100 точек — расстояние между домиками).

Выберем в качестве параметра цикла целочисленную переменную X.
Для всех элементов нашего рисунка абсолютное значение координаты X заменим на относительное. Например, для стены дома процедура для рисования запишется следующим образом:

Сформулируем условие выполнения цыклических действий для нашей задачи.Какие координаты имеет левый верхний угол пятого дома? Конечное значение выбранного нами параметра цикла x = 700. Тогда условие выполнения цикла записывается так: x<=700.

Словесное описание алгоритма коротко можно записать так:

Переменной цикла x присвоить начальное значение 100. Пока x<=700 выполнять серию действий «Нарисуй дом и дерево», после каждого фрагмента рисунка увеличивать значение переменной цикла на 150.

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *