Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
0 / 0 / 0
Регистрация: 19.06.2018
Сообщений: 10
1

Заполнить фигуру черным цветом

19.06.2018, 22:01. Показов 1038. Ответов 2
Метки нет (Все метки)

написали программу, нужно заполнить ее черным цветом как на рисунке, но не смыкаются линии. Помогите с ошибкой
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
x,y,k:integer;
begin
SetWindowCaption('Титульный лист');
TextOut(180,50, 'Лабораторная работа №3');
TextOut(180,80, 'Тема: Построение паркета');
TextOut(180,110, 'Задание 9 варианта:');
TextOut(180,140, 'Выполнил: Порфирьев Е.В');
TextOut(180,290, 'Нажмите любую клавишу');
readln;
Clearwindow;
repeat
gotoxy(1,1);
Clearwindow;
CenterWindow;
SetWindowCaption('Выполнение');
SetFontColor(clDkGray);
TextOut(180,10, 'Построение паркета');
textcolor(clblack);
writeln('Маштаб');
Readln(k);
x:=-1;
repeat
y:=-1;
     repeat
     rectangle(x,y,x+20*k,y+20*k);
     line(x,y,x+10*k,y+10*k);
     line(x,y+20*k,x+10*k,y+10*k);
     line(x+10*k,y+10*k,x+20*k,y+20*k);
     line(x+10*k,y+10*k,x+20*k,y);
 
     line(x,y+5*k,x+5*k,y+10*k);
     line(x+5*k,y+10*k,x,y+15*k);
     line(x+20*k,y+5*k,x+15*k,y+10*k);
     line(x+20*k,y+15*k,x+15*k,y+10*k);
     //низ;
     line(x+10*k,y+15*k,x+5*k,y+20*k);
     line(x+10*k,y+15*k,x+15*k,y+20*k);
 
     line (x+10*k,y+5*k,x+5*k,y);
     line (x+10*k,y+5*k,x+15*k,y);
     y:=y+20*k;
     until(y>480+5*k);
x:=x+20*k;
until (x>640+5*k);
x:=0;
repeat
y:=0;
     repeat
    floodfill(x+6*k,y+11*k,clblack);
 
 
     y:=y+20*k;
     until(y>480+5*k);
x:=x+20*k;
until (x>641+17*k);
textcolor(clblack);
writeln('Повтор?<y/n>');
readln(c);
until(c<>'y');
End.
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Изображения
 
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
19.06.2018, 22:01
Ответы с готовыми решениями:

Построить черным цветом график функции f(x)=arctgx
Построить черным цветом график функции f(x)=arctgx в Pascal ABC

Ввести с клавиатуры число окружностей и построить фигуру, залив все области разным цветом.
Здравствуйте, помогите пожалуйста) Пропустила тему, теперь никак не разберусь( Ввести с...

Очистить экран, заполнить его зеленым цветом
Задача 2.1. Очистить экран, заполнить его зеленым цветом, затем поменять цвет на синий и...

Очистить экран, заполнить его синим цветом, затем поменять цвет на зеленый
Очистить экран, заполнить его синим цветом, затем поменять цвет на зеленый и продолжать менять...

2
Эксперт Pascal/Delphi
6750 / 4529 / 4797
Регистрация: 05.06.2014
Сообщений: 22,351
20.06.2018, 08:50 2
Катериночка8567, в вашей программе не хватает.
Pascal
1
2
3
4
5
6
uses
graphabc, crt;
 
var
  x, y, k: integer;
  c: char;
0
Модератор
64056 / 47472 / 32727
Регистрация: 18.05.2008
Сообщений: 115,185
20.06.2018, 14:33 3
Я бы так написал, хотя можно еще как-то улучшить ввод-вывод.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
uses Crt,GraphABC;
type point=record
           x,y:integer;
           end;
procedure kletka(x,y,d,k,c1,c2:integer);
var p:array[1..5] of point;
    i,a,c:integer;
begin
a:=d*k div 4;
for i:=4 downto 1 do
 begin
  p[1].x:=x-i*a;p[1].y:=y;
  p[2].x:=x;p[2].y:=y-i*a;
  p[3].x:=x+i*a;p[3].y:=y;
  p[4].x:=x;p[4].y:=y+i*a;
  p[5]:=p[1];
  if odd(i) then  c:=c2 else c:=c1;
  setbrushcolor(c);
  setpencolor(c);
  polygon(p,5);
 end;
end;
var k,a,i,j,x,y:integer;
    c:char;
begin
SetWindowCaption('Титульный лист');
TextOut(180,50, 'Лабораторная работа №3');
TextOut(180,80, 'Тема: Построение паркета');
TextOut(180,110, 'Задание 9 варианта:');
TextOut(180,140, 'Выполнил: Порфирьев Е.В');
TextOut(180,290, 'Нажмите любую клавишу');
readkey;
clrscr;
repeat
//clrscr;
gotoXY(1,1);
repeat
write('Введите маштаб целое число от 1 до 10 k=');
readln(k);
until k in [1..10];
hidecursor;
Clearwindow;
CenterWindow;
SetWindowCaption('Выполнение');
SetFontColor(clDkGray);
TextOut(180,10, 'Построение паркета');
a:=10;
setwindowsize(500,500);
centerwindow;
y:=0;
i:=0;
while y<=windowheight+k*a do
 begin
  inc(i);
  if odd(i) then
   begin
    x:=k*a;
    while x<=windowwidth+k*a do
     begin
      kletka(x,y,a,k,clBlack,clWhite);
      x:=x+2*a*k;
     end;
    end
   else
    begin
     x:=0;
     while x<=windowwidth+k*a do
      begin
       kletka(x,y,a,k,clWhite,clBlack);
       x:=x+2*a*k;
     end;
   end;
  y:=y+a*k ;
 end;
gotoXY(1,1);
textcolor(12);
repeat
writeln('Повтор?<y/n>');
readln(c);
until lowcase(c)in ['y','n'];
until(lowcase(c)='n');
end.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.06.2018, 14:33

Как заполнить фигуру ограниченую несколькими точками одним цветом?
Ребята! Тут у меня фигня творится! мне нужно побыстрее узнать, как мне заполнить фигуру ограниченую...

Проблемы с черным цветом
Подскажите пожалуйста в чем может быть проблема, на новом мониторе samsung черный цвет отображается...

Меню в программах отображаются черным цветом
Доброго времени суток. У меня такая проблема: меню в программах отображаются черным цветом. Как...

Canon mg 7140. Полосит черным цветом
Полосит черным цветом при печати фотографий и и при печати образца проверки сопел. При проверке...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.