
Среда программирования:
Lazarus 1.0.6 win64
Статья по теме:
Рассмотрим обобщение ковра Серпинского. Берётся единичный квадрат, который делится на девять частей. Некоторые из этих частей выбрасываются. К оставшимся применяется аналогичная процедура.
Код программы:
unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; PaintBox1: TPaintBox; procedure Button1Click(Sender: TObject); private { private declarations } function BR : Boolean; procedure Sierp(x1, y1, x2, y2 : Real; n : Integer); public { public declarations } end; var Form1: TForm1; x1, y1, x2, y2, x3, y3 : Real; A : array [1..3, 1..3] of Boolean; Key : integer; implementation {$R *.lfm} { TForm1 } function TForm1.BR : Boolean; begin if Random > 0.5 then BR := true else BR := false end; procedure TForm1.Sierp(x1, y1, x2, y2 : Real; n : Integer); var x1n, y1n, x2n, y2n: real; begin if n > 0 then begin x1n := 2*x1/3+x2 / 3; x2n := x1/3+2*x2 / 3; y1n := 2*y1/3+y2 / 3; y2n := y1/3+2*y2 / 3; {if n = 1 then} Paintbox1.canvas.Rectangle(round(x1),round(y1),round(x2),round(y2)); if A[1,1] then Sierp(x1, y1, x1n, y1n, n-1); if A[1,2] then Sierp(x1n, y1, x2n, y1n, n-1); if A[1,3] then Sierp(x2n, y1, x2, y1n, n-1); if A[2,1] then Sierp(x1, y1n, x1n, y2n, n-1); if A[2,2] then Sierp(x1n, y1n, x2n, y2n, n-1); if A[2,3] then Sierp(x2n, y1n, x2, y2n, n-1); if A[3,1] then Sierp(x1, y2n, x1n, y2, n-1); if A[3,2] then Sierp(x1n, y2n, x2n, y2, n-1); if A[3,3] then Sierp(x2n, y2n, x2, y2, n-1) end end; procedure TForm1.Button1Click(Sender: TObject); var j,i:integer; begin Randomize; key:=0; repeat for i:=1 to 3 do for j:=1 to 3 do A[i,j] := BR; Sierp(1, 1, 1+9*9*5, 1+9*9*5, 5); key:=key+1; until Key <> 1000; end; end.
Прикрепленный файл | Размер |
---|---|
Исходные коды и запускаемый файл | 763.28 кб |