Технический форум

Технический форум (http://www.tehnari.ru/)
-   Basic (http://www.tehnari.ru/f127/)
-   -   Узор из квадратов (http://www.tehnari.ru/f127/t249652/)

iks2 28.10.2016 10:54

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

Код:

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


Vladimir_S 28.10.2016 12:46

Вложений: 1
Цитата:

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

Да легко (Паскаль; 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.



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

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.