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

Кривые Серпинского

20.01.2017, 01:12. Показов 987. Ответов 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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
program DGDGDFGDFG;
uses GraphABC;
const
   power=1; {порядок меняется в зависимости от изменяемого числа}
var
  h, x, y: integer;
function calcZ(i: integer): integer;
begin
   if i=0 then calcZ:=1
   else calcZ:=2*calcZ(i-1)+3;
end;
procedure DrawSegment(a, b: integer);
begin
Line(x, y, x+a*h, y+b*h);
x:=x+a*h;
y:=y+b*h;
end;
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
    if i>0 then 
    begin
      LineAB(i-1); 
      DrawSegment(1, 1); 
      LineCD(i-1); 
      DrawSegment(2, 0);
      LineGH(i-1); 
      DrawSegment(1, -1); 
      LineAB(i-1);
    end;
end;
Procedure LineCD;
  begin
   if i>0 then 
   begin
    LineCD(i-1); 
    DrawSegment(-1, 1); 
    LineEF(i-1); 
    DrawSegment(0, 2);
    LineAB(i-1); 
    DrawSegment(1, 1); 
    LineCD(i-1);
   end;
  end;
Procedure LineEF;
  begin
   if i>0 then 
   begin
    LineEF(i-1); 
    DrawSegment(-1, -1); 
    LineGH(i-1); 
    DrawSegment(-2, 0);
    LineCD(i-1); 
    DrawSegment(-1, 1); 
    LineEF(i-1);
  end;
end;
Procedure LineGH;
  begin
   if i>0 then 
   begin
    LineGH(i-1); 
    DrawSegment(1, -1); 
    LineAB(i-1); 
    DrawSegment(0, -2);
    LineEF(i-1); 
    DrawSegment(-1, -1); 
    LineGH(i-1);
   end;
end;
begin
  h := round(Window.Height/(calcZ(power) + 1));
  x := Window.Width div 2 - Window.Height div 2 + h;
  y := 0;
  moveto(x, y);
  LineAB(power); 
  DrawSegment(1, 1); 
  LineCD(power); DrawSegment(-1, 1);
  LineEF(power); 
  DrawSegment(-1, -1); 
  LineGH(power); 
  DrawSegment(1, -1);
end.
0
Заказывайте контрольные, курсовые и дипломы здесь.
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
20.01.2017, 01:12
Ответы с готовыми решениями:

треугольник Серпинского
Помогите пожалуйста написвть программу построения треугольника Серпинского с подробным описанием...

Треугольник Серпинского
Дан треугольник Серпинского. (Одинаковые) события надо выделить (одинаковыми) цветами. Добавлено...

Фрактал. Треугольники (не Серпинского)
Помогите пожалуйста с графикой, нужен такой фрактал

Кривые, эллипс, параметры и тд
Построить кривые по заданному параметрическому представлению: Эллипс с большой и малой полуосями,...

2
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,133
20.01.2017, 16:16 2
Посмотрите эту тему.
Кривые Серпинсого

Добавлено через 36 минут
Вот поправленный Ваш код.
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
83
84
85
86
87
88
program DGDGDFGDFG;
uses GraphABC;
var
  h, x, y, power: integer;
function calcZ(i: integer): integer;
begin
   if i=0 then calcZ:=1
   else calcZ:=2*calcZ(i-1)+3;
end;
procedure DrawSegment(a, b: integer);
begin
Line(x, y, x+a*h, y+b*h);
x:=x+a*h;
y:=y+b*h;
end;
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
    if i>0 then
    begin
      LineAB(i-1);
      DrawSegment(1, 1);
      LineCD(i-1);
      DrawSegment(2, 0);
      LineGH(i-1);
      DrawSegment(1, -1);
      LineAB(i-1);
    end;
end;
Procedure LineCD(i:byte);
  begin
   if i>0 then
   begin
    LineCD(i-1);
    DrawSegment(-1, 1);
    LineEF(i-1);
    DrawSegment(0, 2);
    LineAB(i-1);
    DrawSegment(1, 1);
    LineCD(i-1);
   end;
  end;
Procedure LineEF(i:byte);
  begin
   if i>0 then
   begin
    LineEF(i-1);
    DrawSegment(-1, -1);
    LineGH(i-1);
    DrawSegment(-2, 0);
    LineCD(i-1);
    DrawSegment(-1, 1);
    LineEF(i-1);
  end;
end;
Procedure LineGH(i:byte);
  begin
   if i>0 then
   begin
    LineGH(i-1);
    DrawSegment(1, -1);
    LineAB(i-1);
    DrawSegment(0, -2);
    LineEF(i-1);
    DrawSegment(-1, -1);
    LineGH(i-1);
   end;
end;
begin
repeat
write('Введите порядок кривой от 1 до 7 power=');
readln(power);
until power in [1..7];
Window.Clear;
  h := round(Window.Height/(calcZ(power) + 1));
  x := Window.Width div 2 - Window.Height div 2 + h;
  y := 0;
  moveto(x, y);
  LineAB(power);
  DrawSegment(1, 1);
  LineCD(power); DrawSegment(-1, 1);
  LineEF(power);
  DrawSegment(-1, -1);
  LineGH(power);
  DrawSegment(1, -1);
end.
1
0 / 0 / 0
Регистрация: 20.01.2017
Сообщений: 2
20.01.2017, 20:48  [ТС] 3
Спасибо огромное!!!!!
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.01.2017, 20:48

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Построить кривые 4ого порядка
1) Вы можете "нарисовать" на экране монитора кривую четвёртого порядка? Их нужно нарисовать сразу...

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

Построить кривые по заданному параметрическому представлению
Построить кривые по заданному параметрическому представлению Кардиоида x = a cos t(1+cost), y = a...

Построить кривые по заданному параметрическому представлению
помогите пожалуйста решить две задачи по графике:(желательно на АВСпаскаль) 1. Построить кривые по...

Кривые Серпинского
Построить кривые Серпинского 1-го и 2-го порядков.

Кривая Серпинского
uses GraphABC; type TPoint = auto class X, Y: real; end; procedure RLine(x, y, x1,...


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

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

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