Листинги программ к статье и. М. Павловой "графика на паскале"

1. Создание рисунков с использованием прямой линии

1.1. Использование процедур MoveTo, LineTo

Задание 1.1.1. Нарисовать домик с покатой крышей. В программе вводятся координаты конька крыши.

uses

graph, crt;

var

x1, y1, error, gd, gm: integer;

begin

writeln('Введите начальные координаты:');

readln(x1, y1);

gd:=vga;

gm:=vgahi;

initgraph(gd, gm, 'd:\bp\bgi');

error:=graphresult;

if error<>grok then

begin

writeln('Ошибка открытия графики');

halt(1)

end;

moveto(x1, y1); {Домик}

lineto(x1-100, y1+50);

lineto(x1-100, y1+150);

lineto(x1+100, y1+150);

lineto(x1+100, y1+50);

lineto(x1, y1);

moveto(x1-100, y1+50);

lineto(x1+100, y1+50);

moveto(x1+100, y1+50); {Труба}

lineto(x1+100, y1-10);

lineto(x1+80, y1-10);

lineto(x1+80, y1+40);

moveto(x1+90, y1-15); {Дым}

lineto(x1+80, y1-20);

lineto(x1+90, y1-15);

lineto(x1+90, y1-20);

moveto(x1+90, y1-15);

lineto(x1+100, y1-20);

moveto(x1, y1+100); {Окно}

lineto(x1, y1+80);

lineto(x1, y1+120);

moveto(x1-20, y1+100);

lineto(x1+20, y1+100);

moveto(x1-20, y1+80);

lineto(x1+20, y1+80);

lineto(x1+20, y1+120);

lineto(x1-20, y1+120);

lineto(x1-20, y1+80);

moveto(x1+100, y1+150); {Дверь и крыльцо}

lineto(x1+150, y1+150);

lineto(x1+150, y1+140);

lineto(x1+130, y1+140);

lineto(x1+130, y1+130);

lineto(x1+100, y1+130);

lineto(x1+100, y1+60);

lineto(x1+103, y1+60);

lineto(x1+103, y1+130);

readln;

closegraph;

end.

Задание 1.1.2. Нарисовать квадратную спираль, причем звенья, идущие слева направо и сверху вниз, имеют нечетную длину, а звенья, идущие справа налево и снизу вверх, имеют четную длину. Предлагается вариант программы, когда для одного значения параметра цикла рисуется полный оборот спирали. Спираль рисуется по часовой стрелке из точки, координаты которой задаются с клавиатуры.

uses

graph, crt;

var

error, gd, gm, x, y, i, v, a: integer;

begin

writeln('Введите координаты начала:');

readln(x, y);

writeln('Введите длину звена и количество витков:');

readln(a, v);

gd:=vga;

gm:=vgahi;

initgraph(gd, gm, 'd:\bp\bgi');

error:=graphresult;

if error<>grok then

begin

writeln('Ошибка открытия графики');

halt(1)

end;

moveto(x, y);

for i:=1 to 4*v do

if i mod 2 = 1 then

begin

linerel(i*a, 0);

linerel(0, i*a);

linerel(-(i+1)*a, 0);

linerel(0, -(i+1)*a)

end;

readln;

closegraph;

end.

Задание 1.1.3. Нарисовать диагональную спираль, длина каждого следующего звена которой увеличивается на единицу. Вновь используется прием построения полного витка спирали при одном значении параметра цикла, когда длина следующего звена возрастает за счет увеличения на единицу коэффициентов (i*a, (i+1)*a, (i+2)*a, (i+3)*a).

uses

graph, crt;

var

error, gd, gm, x, y, i, v, a: integer;

begin

writeln('Введите координаты начала:');

readln(x, y);

writeln('Введите длину звена и количество витков:');

readln(a, v);

gd:=vga;

gm:=vgahi;

initgraph(gd, gm, 'd:\bp\bgi');

error:=graphresult;

if error<>grok then

begin

writeln('Ошибка открытия графики');

halt(1)

end;

moveto(x, y);

for i:=1 to 4*v do

if i mod 4 = 1 then

begin

linerel(i*a, -i*a);

linerel((i+1)*a, (i+1)*a);

linerel(-(i+2)*a, (i+2)*a);

linerel(-(i+3)*a, -(i+3)*a)

end;

readln;

closegraph;

end.