Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Basic


Ответ
 
Опции темы Опции просмотра
Старый 28.10.2016, 10:54   #1 (permalink)
iks2
Member
 
Регистрация: 22.10.2016
Сообщений: 62
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Узор из квадратов

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

Код:
DECLARE SUB f (x!, y!, r!, p!)
CLS

CONST k = 3.5
SCREEN 11
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
END

SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 10000: NEXT
      CALL f(x, y, r / k, p - 1)
      CALL f(x + r, y, r / k, p - 1)
      CALL f(x + r, y + r, r / k, p - 1)
      CALL f(x, y + r, r / k, p - 1)
      CALL f(x - r, y + r, r / k, p - 1)
      CALL f(x - r, y, r / k, p - 1)
      CALL f(x - r, y - r, r / k, p - 1)
      CALL f(x, y - r, r / k, p - 1)
      CALL f(x + r, y - r, r / k, p - 1)
   END IF
END SUB
Миниатюры
509.gif  
iks2 вне форума   Ответить с цитированием

Старый 28.10.2016, 10:54
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

По данным ссылкам возможно найдется решение проблемы

Необходимо написать программу вывода всех квадратов натуральных чисел
Чем на оргстекле можно вырезать узор?
Нужен узор для гравировки

Старый 28.10.2016, 12:46   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,382
Сказал(а) спасибо: 328
Поблагодарили 558 раз(а) в 194 сообщениях
Репутация: 106949
По умолчанию

Цитата:
Сообщение от iks2 Посмотреть сообщение
Требуется написать программу, которая рисует узор, представленный на картинке. Собственно не требуется делать точную копию, но так, чтобы было похоже.
Да легко (Паскаль; GrfStart - самописный модуль инициализации графики):
Код:
Uses CRT, Graph, GrfStart;

Var
 i,j,k,m:Word;

Procedure RCT(Xc,Yc,A:Word);
begin
 Bar(Xc-A,Yc-A,Xc+A,Yc+A);
 Rectangle(Xc-A,Yc-A,Xc+A,Yc+A);
end;

Begin
 INITIALIZE;
 ClearDevice;
 SetFillStyle(SolidFill,GetBkColor);
 SetLineStyle(SolidLn,0,ThickWidth);
 RCT((GetMaxX div 2),(GetMaxY div 2), 140);
 for i:=0 to 2 do
  for j:=0 to 2 do
   begin
    RCT((GetMaxX div 2)-140+j*140,(GetMaxY div 2)-140+i*140, 40);
    for k:=0 to 2 do
     for m:=0 to 2 do
      RCT((GetMaxX div 2)-180+j*140+m*40,(GetMaxY div 2)-180+i*140+k*40, 10);
   end;
 ReadKey
End.
Миниатюры
aa01.jpg  
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 09:58.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.