IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> помогите с рекурсивной функцией
xsires
сообщение 2.06.2010 23:52
Сообщение #1





Группа: Пользователи
Сообщений: 3
Пол: Мужской
Реальное имя: Alex

Репутация: -  0  +


помогите с рекурсивной функцией


procedure box(x1m,y1m,x2m,y2m:real;l:boolean);
var x1,x2,y1,y2:integer;
 begin
 if l=true then
 SetFillStyle(1,11)
 else
 setfillstyle(1,black);
  x1:=integer(round(x1m));
  x2:=integer(round(x2m));
  y1:=integer(round(y1m));
  y2:=integer(round(y2m));
 bar(x1,y1,x2,y2);
 end;




рисует квадратик елси l = true если l = false закрашиваем квадратик


а вот сама в процедура которую я немогу доделать ( ( (

procedure build(x1,y1,x2,y2:real);
 begin

  box(x1,y1,x2,y2,true);

  box(x1,y1,x1+((x2-x1)/3),y1+((y2-y1)/3),false);
  box(x2-((x2-x1)/3),y1,x2,y1+((y2-y1)/3),false);
  box(x1,y2-((y2-y1)/3),x1+((x2-x1)/3),y2,false);
  box(x2-((x2-x1)/3),y2-((y2-y1)/3),x2,y2,false);

  box(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3),true);
  box(x2-((x2-x1)/3),y1 -((y2-y1)/3),x2,y1,true);
  box(x1,y2,x1 +((x2-x1)/3),y2+((y2-y1)/3),true);
  box(x2,y2-((y2-y1)/3),x2+((x2-x1)/3),y2,true);


 build(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3));
 build(x2-((x2-x1)/3),y1 -((y2-y1)/3),x2,y1);
 build(x1,y2,x1 +((x2-x1)/3),y2+((y2-y1)/3));
 build(x2,y2-((y2-y1)/3),x2+((x2-x1)/3),y2);
  end;







строки


 build(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3));
 build(x2-((x2-x1)/3),y1 -((y2-y1)/3),x2,y1);
 build(x1,y2,x1 +((x2-x1)/3),y2+((y2-y1)/3));
 build(x2,y2-((y2-y1)/3),x2+((x2-x1)/3),y2);



должны выполнятся все сразу

а на деле выполняется ток первая строка


 build(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3));



кто нить подскажите решение проблемы .... мне нуна чтобы выполнялись 4 строки сразу а не ток первая
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
xsires
сообщение 3.06.2010 0:13
Сообщение #2





Группа: Пользователи
Сообщений: 3
Пол: Мужской
Реальное имя: Alex

Репутация: -  0  +


Цитата(volvo @ 3.06.2010 1:04) *

Я тебе уже сказал - приводи код полностью... Это первое. Второе - для Паскаля есть специальная подсветка. И третье. Где здесь ты увидел теоретический вопрос? dry.gif

Перенесено...

P.S. Где условие выхода из рекурсии? У тебя скорее всего переполняется стек, и программа просто вылетает. Потому что ты нигде не говоришь программе, что при нулевых или отрицательных значениях параметров (это как пример, может, ты сделаешь другие условия) продолжать рекурсивные вызовы не надо, пора остановиться.



сори за флуд ... просто до завтра нуна задать ... )) выполняется ток 1 срока build() до 2 строки build() не доходит ... функция повторяется на первой строки build .. cтроится ток часть фрактала ....

Добавлено через 1 мин.
uses crt,graph;
var 
x1m,x2m,y1m,y2m:real;
procedure  graphinit;
var
gd,gm:integer;
begin
	gd := Detect;
	InitGraph(gd, gm,'');
end;

procedure box(x1m,y1m,x2m,y2m:real;l:boolean);
var
x1,x2,y1,y2:integer;
 begin
 if l=true then
 SetFillStyle(1,11)
 else
 setfillstyle(1,black);
  x1:=integer(round(x1m));
  x2:=integer(round(x2m));
  y1:=integer(round(y1m));
  y2:=integer(round(y2m));
 bar(x1,y1,x2,y2);
 end;

procedure build(x1,y1,x2,y2:real);
 begin


  box(x1,y1,x2,y2,true);

  box(x1,y1,x1+((x2-x1)/3),y1+((y2-y1)/3),false);
  box(x2-((x2-x1)/3),y1,x2,y1+((y2-y1)/3),false);
  box(x1,y2-((y2-y1)/3),x1+((x2-x1)/3),y2,false);
  box(x2-((x2-x1)/3),y2-((y2-y1)/3),x2,y2,false);

  box(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3),true);
  box(x2-((x2-x1)/3),y1 -((y2-y1)/3),x2,y1,true);
  box(x1,y2,x1 +((x2-x1)/3),y2+((y2-y1)/3),true);
  box(x2,y2-((y2-y1)/3),x2+((x2-x1)/3),y2,true);

 build(x1-((x2-x1)/3),y1,x1,y1+((y2-y1)/3));
build(x2-((x2-x1)/3),y1 -((y2-y1)/3),x2,y1);
  build(x1,y2,x1 +((x2-x1)/3),y2+((y2-y1)/3));
 build(x2,y2-((y2-y1)/3),x2+((x2-x1)/3),y2);
  end;
 end;

begin
graphinit;
x1m := getmaxy/2-75;
y1m := getmaxy/2-75;
x2m := getmaxy/2+75;
y2m := getmaxy/2+75;

choice:=0;
build(x1m,y1m,x2m,y2m);

readln;
end.

программа должна рисовать фрактал разбивая квадраты на равные части

Сообщение отредактировано: Lapp - 3.06.2010 5:20


Эскизы прикрепленных изображений
Прикрепленное изображение
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 26.07.2025 3:09
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"