вот пример с простым закрашиванием. Чтобы переделать на смену картинки нужно сравнения canvas.Pixels[x,y]=clRed переделать в проверку перенесена ли уже точка, и написать перенос окружности с битмапа на битмап. Хотя наверное можно заменить на квадрат
| Код |
procedure TForm1.BitBtn1Click(Sender: TObject);
var n,m,MaxM:integer;rct:TRect;x,y,id:integer;d:real;refr:integer;
begin
with img.Picture.Bitmap do
begin
d:=2;
MaxM:=5;
refr:=((width+height) div 2);
canvas.Brush.Color:=clRed;
canvas.Pen.Color:=clRed;
for n:=1 to Width*Height do //заменить на проверку остались ли неперенесенные точки
begin
m:=0;
repeat
x:=random(Width);
y:=random(Height);
inc(m);
until (canvas.Pixels[x,y]<>clRed) or (m>=MaxM);
if (m=MaxM) and (canvas.Pixels[x,y]=clRed) then dec(MaxM);
id:=round(d*1.5);
if canvas.Pixels[x,y]=clRed then inc(x,id);
if canvas.Pixels[x,y]=clRed then dec(y,id);
if canvas.Pixels[x,y]=clRed then dec(x,id);
if canvas.Pixels[x,y]=clRed then dec(x,id);
if canvas.Pixels[x,y]=clRed then inc(y,id);
if canvas.Pixels[x,y]=clRed then inc(y,id);
if canvas.Pixels[x,y]=clRed then inc(x,id);
if canvas.Pixels[x,y]=clRed then inc(x,id);
if canvas.Pixels[x,y]=clRed then d:=d*2;
rct.Left:=round(x-d/2);
rct.Top:=round(y-d/2);
rct.Right:=round(x+d/2);
rct.Bottom:=round(y+d/2);
canvas.Ellipse(rct);
if n mod refr=0 then img.Refresh;
end;
end;
end;
|
img это TImage. |
.
... 