Рассмотрим реализацию данного эффекта на примере задачи порождения мыльных пузырей.
Суть задачи заключается в том, что на плоскости случайным образом задаются точки, и из них, как из центров, строятся окружности с увеличивающимися радиусами и уменьшающейся яркостью. В каждой точке плоскости цвет берется от окружности с большей яркостью, т.е. от ближайшей. На картинке получается нечто похожее на взбитую пену.
Увеличивая количество пузырей можно соответственно получить разнообразные отображения.
Program Noname;
uses CRT, Math, Graph;
Type
dArray = Array[0..0] of LongInt;
pArray = ^dArray;
var
i, j, k,
x, y, q, step,
xmax, ymax,
v, col, uu: longint;
ColDepth: word;
red, green, blue: LongInt;
xc, yc, r: pArray;
begin
xmax := 800; // Разрешение по горизонтали
ymax := 600; // Разрешение по вертикали
ColDepth := 16; // Максимальная глубина цвета
v := 8; // Количество пузырей
step := 4; // Шаг движения по x и y ("мозаичность" картины):
Randomize;
SetSVGAMode(xmax,ymax,ColDepth,LFBorBanked); // Установим графический режим
if GraphResult<>grOk then begin // Проверка результата
Writeln('Mode not supported..');
Halt(0);
end;
GetMem(xc,v*SizeOf(LongInt)); // Выделение памяти для 3х массивов
GetMem(yc,v*SizeOf(LongInt));
GetMem(r, v*SizeOf(LongInt));
For i := 0 To pred(v) do begin // Задание случайных координат
xc^[i] := Random(xmax);
yc^[i] := Random(ymax);
end;
// В цикле проходим все поле по X и Y
x := 0;
While (x < xmax) do begin
y := 0;
While (y < ymax) do begin
For q := 0 To pred(v) do begin
r^[q] := Trunc(Power(IntPower((xc^[q] - x),2) +
IntPower((yc^[q] - y),2),0.5));
end;
// Сортируем пузырьки методом пузырька по возрастанию радиуса
For k := 0 To v - 2 do begin
For j := 0 To v - 2 do begin
If r^[j] > r^[j + 1] Then begin
uu := r^[j];
r^[j] := r^[j + 1];
r^[j + 1] := uu;
End;
end;
end;
// Задаем цвет
red := 255 - r^[0];
green := 255 - Trunc(r^[0] * 1.3);
blue := 255 - Trunc(r^[0] * 1.1);
If red < 0 Then red := 0;
If green < 0 Then green := 0;
If blue < 0 Then blue := 0;
Col := RGBColor(red, green, blue);
// Рисуем очередную точку или квадрат
If (step = 1) Then PutPixel(x, y, Col)
else begin
SetFillColor(Col);
Bar (x, y, x + step, y + step);
end;
Inc(y,step);
end;
Inc(x,step);
end;
FreeMem(xc,v*SizeOf(LongInt)); // Освождение памяти
FreeMem(yc,v*SizeOf(LongInt));
FreeMem(r, v*SizeOf(LongInt));
Repeat until ReadKey=#27;
CloseGraph;
end.
Ключевые слова:
Поверхностное натяжение
