VPF::[Pascal]Нарисовать калейдоскоп - Форум программистов

fandelle

Дата 2.6.2009, 16:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 24.9.2008

Репутация: нет
Всего: нет

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

Тут можно взять равносторонний треугольник. Найти центр, построить его относительно центра. Потом делить каждую сторону пополам опускать перпендикуляр и соединять его с вершинами треугольника. И так строить, пока не заполнится экран.
А может есть какое-нибудь более простое решение этой задачи? Подскажите пожалуйста.

volvo877

Дата 2.6.2009, 17:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

Разноцветная "Салфетка Серпинского" рисуется программой из 45 строк. Куда уж проще? По-моему, довольно похоже на то, что ты описал... Надо?

I_Am_Rock

Дата 2.6.2009, 17:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Цитата(volvo877 @ 2.6.2009, 17:34

)

Надо?

Покажи, если не трудно. Мне интересно стало.)

volvo877

Дата 2.6.2009, 18:08 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

I_Am_Rock, ну, смотри: smile

Код


uses graph;

procedure Serp(bX, bY, size, deep: word);

  procedure Triangle;
  var height: Word;
  begin
    height := round(size * sqrt(3)) div 2;
    setcolor(random(15) + 1);
    line(bX, bY, bX - size div 2, bY - height);
    line(bX, bY, bX + size div 2, bY - height);
    line(bX - size div 2, bY - height,
         bX + size div 2, bY - height);
  end;

begin
  if deep > 0 then begin
    Triangle;
    serp(bX - size div 2, bY, size div 2, pred(deep));
    serp(bX + size div 2, bY, size div 2, pred(deep));
    serp(bX, bY - round(size * sqrt(3)) div 2,
             size div 2, pred(deep));
  end;
end;

var
  gd, gm: Integer;
begin
  gd := Detect;
  initgraph(gd, gm, '');
  if graphresult <> grok then begin
    writeln('graphics error'); readln; halt;
  end;
  Randomize;
  serp(GetMaxX div 2, GetMaxY div 2 + 150, 200, 6);

  readln;
  closegraph;
end.

fandelle

Дата 2.6.2009, 18:22 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 24.9.2008

Репутация: нет
Всего: нет

Красиво, но это не совсем то, что нужно.
Тут именно, что треугольники строятся на других треугольниках.

volvo877

Дата 2.6.2009, 18:28 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

Ну, так нарисуй, что именно тебе нужно, и покажи, а то по твоему описанию можно что угодно представить...

fandelle

Дата 2.6.2009, 18:45 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 24.9.2008

Репутация: нет
Всего: нет

Вот пример. И так по всему экрану

Это сообщение отредактировал(а) fandelle - 2.6.2009, 18:46

Присоединённый файл ( Кол-во скачиваний: 31 )

imagegraph.rar 5,37 Kb

volvo877

Дата 2.6.2009, 20:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

fandelle, вот что-то набросал, вроде работает... Похоже?

Код


uses graph;

const R = 50;
procedure draw(curr: integer;
               const center: pointtype; level: integer);
var
  pts: array[1 .. 7] of pointtype;
  tri: array[1 .. 3] of pointtype;
  i: integer;
begin
  {
    Работаем в полярной СК, с центром в точке Center, и углом,
    отсчитываемым от направления горизонтально вправо.

    1. строим 6 точек - вершин правильного 6-угольника с центром
    в начале координат. Для этого просто увеличиваем угол на 60 градусов,
    пока не сделаем полный обход, и находим координаты точки, находящейся
    на расстоянии R от центра. 90 градусов прибавляем, чтобы первая точка
    была строго над центром, выше него (мне так привычнее), если этого не
    сделать - то шестиугольник просто будет ориентирован по другому, можешь
    попробовать...
  }
  for i := 1 to 6 do begin
    pts[i].X := center.X + trunc( R*cos(((60*pred(i) + 90) mod 360) * pi / 180) );
    pts[i].Y := center.Y - trunc( R*sin(((60*pred(i) + 90) mod 360) * pi / 180) );
  end;
  pts[7] := pts[1];

  {
    2. теперь по этим 6-ти точкам + центру рисуем 6 разноцветных треугольников,
    для чего по порядку заполняем массив Tri координатами соседних точек, в то время
    как еще одна точка - всегда центр СК
  }

  setcolor(random(14) + 1);
  for i := 1 to 6 do begin
    tri[1] := center;
    tri[2] := pts[i]; tri[3] := pts[i+1];


      setfillstyle(solidfill, random(14)+1);
      fillpoly(3, tri);

    (*
    moveto(tri[1].x, tri[1].y);
    lineto(tri[2].x, tri[2].y);
    lineto(tri[3].x, tri[3].y);
    lineto(tri[1].x, tri[1].y);
    *)
  end;

  {
    3. Ну вот, теперь 6 треугольников у нас отрисованы, переходим к основному:
    каждая из точек pts[i] становится центром координат, и вокруг нее опять же
    будут построены такие же 6 равносторонних треугольников. Именно поэтому
    алгоритм проходит по одному месту несколько раз - он просто идет с разных
    сторон, а запоминать, где есть отрисованный треугольник, а где его нет - мне
    просто было лениво...
  }

  for i := curr to 6 do
    {
      Здесь - элементарные ограничения на рекурсию, во-первых, нет смысла что-либо
      рисовать, если центр будет вне экрана. Ну, и ограничение глубины тоже введено,
      только до 6-го уровня.
    }
    if ((pts[i].x > 0) and (pts[i].x < getmaxx)) and
       ((pts[i].y > 0) and (pts[i].y < getmaxy)) and (level < 6) then
    begin
      draw(i, pts[i], succ(level));
    end
end;

var
  gd, gm: Integer;
  p: pointtype;
begin
  gd := Detect;
  initgraph(gd, gm, '');
  if graphresult <> grok then begin
    writeln('graphics error'); readln; halt;
  end;

  randomize;
  p.X := getmaxx div 2; p.Y := getmaxy div 2;
  draw(1, p, 0);

  readln;
  closegraph;
end.

Это сообщение отредактировал(а) volvo877 - 3.6.2009, 11:02

fandelle

Дата 3.6.2009, 06:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 24.9.2008

Репутация: нет
Всего: нет

Да, очень похоже.
Не могли бы вы теперь доходчиво объяснить текст и по какому именно принципу строится изображение. Почему например происходит многократное прохождение по одному и тому же месту?

volvo877

Дата 3.6.2009, 11:08 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

Комментарии добавлены.

Теперь о том, как можно поправить программу, чтобы она не рисовала треугольники на одном и том же месте несколько раз. Например, получать координаты точки - центра каждого треугольника (это несложно, по такому же принципу, как получаешь первым циклом 6 вершин многоугольника, только угол сдвинуть на 30 градусов, и уменьшить R в 2 раза). А потом, перед отрисовкой, проверять, если GetColor этой точки (центра треугольника) не совпадает с GetBkColor, то тут уже что-то рисовали, и второй раз этого делать не надо. Но это попробуй реализовать сам, у меня Паскаль сегодня недоступен, только завтра...

fandelle

Дата 3.6.2009, 11:39 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 24.9.2008

Репутация: нет
Всего: нет

Спасибо. Я доведу до ума.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »