Вы наверное часто видели довольно хитроумные картины, на которых непонятно что изображено, но все равно необычность их форм завораживает и приковывает внимание. Как правило, это хитроумные формы не поддающиеся казалось бы какому-либо математическому описанию. Вы к примеру видели узоры на стекле после мороза или к примеру хитроумные кляксы, оставленные на листе чернильной ручкой, так вот что-то подобное вполне можно записать в виде некоторого алгоритма, а следовательно доступно объясниться с компьютером. Подобные множества называют фрактальными. Вобще, как мне известно фракталы появились не так уж давно, но сразу завоевали свою важную нишу. Фракталы не похожи на привычные нам фигуры, известные из геометрии, и строятся они по определенным алгоритмам, а эти алгоритмы с помощью компьютера можно изобразить на экране. Вобще, если все слегка упростить, то фракталы - это некое преобразование многократно примененное к исходной фигуре.
Здесь хочу остановиться на фрактальных множествах Мандельброта и Жюлиа. Изображения этих множеств не имеют каких либо четко очерченных границ. Особенностью фракталов является то, что даже маленькая часть изображения в конечном итоге представлет общее целое, особенно хорошо этот эффект можно пронаблюдать на примере множества Жюлиа. Кстати на основе этого свойства фракталов основано фрактальное сжатие данных, но эту тему разберем как-нибудь позже (когда накопиться достаточно нужного материала).
Итак приступим к самому главному, ради чего мы здесь и собрались. Как же строятся эти удивителные множества ?
Все сводится к вычислению одной единственной формулы.
Zi+1=Zi2+C
Здесь Z и C - комплексные числа. Как видно, формулы по сути представляет собой обычную рекурсию (или что-то вроде многократно примененного преобразования). Зная правила работы с комплексными числами данную формулу можно упростить и привести к следующему виду.
xi+1=xi2-yi2+a
yi+1=2*xi*yi+b
Построение множества Мандельброта сводится к следующему. Для каждой точки (a,b) проводится серия вычислений по вышеприведенным формулам, причем x0 и y0 принимаются равными нулю, т.е. точка в формуле выступает в качестве константы. На каждом шаге вычиляется величина r=sqrt(x2+y2 ). Значением r ,как ни трудно заметить, является расстояние точки с координатами (x,y) от начала координат ( r=sqrt[ (x-0)2+(y-0)2] ). Исходная точка (a,b) считается принадлежащей множеству Мандельброта, если она никогда не удаляется от начала координат на какое-то критическое число. Для отображения можно подсчитать скорость удаления от центра, если например точка ушла за критическое расстояние, и в зависимости от нее окрасить исходную точку в соответствующие цвет. Полное изображение множества Мандельброта можно получить на плоскости от -2 до 1 по оси x и от -1.5 до 1.5 по оси y. Также известно, что для получения примелимой точности достаточно 100 итеарций (по теории их должно быть бесконечно много). Ниже представлен листинг функции реализующей выполнение итераций и определение принадлежности точки множеству Мандельброта, точнее на выходе мы получаем цвет для соответствующе точки. В качестве критического числа взято число 2. Чтобы не вычислять корень, мы сравниваем квадрат расстояния (r2) с квадратом критического числа, т.е. сравниваем (x2+y2) и 4.
function MandelBrot(a,b: real): TColor;
var x,y,xy: real;
x2,y2: real;
r:real;
k: integer;
begin
r:=0;
x:=0; y:=0;
k:=100;
while (k>0)and(r0)and(r"Delphi Game Creator"), а точнее нам потребуется только компонент TDGCScreen. Опустите его на форму и установите свойство DisplayMode в значение dm320x200x8 (экран размером 320x200 256 цветов). Чтобы была возможность выйти из приложения (выход по нажатию Esc) напишем обработчик для формы события OnKeyPress
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 then
close;
end;
Теперь нам следует переопределить палитру. Будет ее переопределять следующим образом, от черного постепенно к красному цвету, именно эти два цвета будут использованы при создании огня.
procedure TForm1.SetPallete;
var NewPalette: T256PaletteEntry;
i: integer;
PE: TPaletteEntry;
begin
for i:=0 to 255 do begin
PE.peRed:=i;
PE.peGreen:=0;
PE.peBlue:=0;
PE.peFlags:=0;
NewPalette[i]:=PE;
end;
//установить новую палитру
DGCScreen1.SetPalette(NewPalette);
end;
Палитра представляет собой массив из 256 элементов (от 0 до 255). Элементы массива представляют собой объекты типа TPaletteEntry и определяют кокретный цвет в формате RGB (доли красного зеленого и синего). И когда мы указываем какой-либо цвет мы указываем его индекс в палитре а от туда уже выбирается кокретное цветовое представление. Церный цвет это доли всех цветов равно 0, а красный когда доля красного равна 255 а остальных 0. Таким образом мы в цикле заполняем нашу новую палитру, а затем устанавливаем ее с помощью метода SetPalette (см. выше).
Теперь поступим следующим образом, нарисуем какую либо фигуру на экране (линии, текст и т.д.) красным цветом, а затем скопируем весь экран в заранее приготовленный буфер. Тип буфера объявим следующим образом
type
FlameArray=array [1..320,1..200] of byte;
............................
Flame,Flame2: FlameArray;
Теперь Flame2 содержит начальную картинку, а Falme содержит текущее содержимое экрана(но об это позже).
А теперь напишем текст на экране(адрес сайта и e-mail адрес) и запомним его в буфере.
Procedure TForm1.GetReady;
var i,j: integer;
begin
with DGCScreen1.Front.Canvas do begin
Brush.Color:=0;
Font.Color:=255;
Font.Size:=30;
TextOut(10,40,'http://www.chat.ru');
TextOut(100,96,'/~shival');
Font.Size:=20;
TextOut(40,150,'
[email protected]');
//копируем в буфер
for i:=1 to 315 do
for j:=1 to 195 do
begin
if Pixels[i,j]<>0 then begin
Flame2[i,j]:=Pixels[i,j];
end;
end;
release;
end;
end;
Теперь напишем процедуру выводящую снимок огня на экран.
const
RPoint = 6000;
type
ScreenArray=array [1..64000] of byte;
.........................................................
procedure TForm1.DrawFlame;
var i,j: integer;
P: Pointer;
begin
//расставляем случайные точки черного цвета
for i:=1 to RPoint do
Flame[1+random(315),1+random(195)]:=0;
//копируем первоначальный рисунок
for i:=1 to 315 do
for j:=1 to 195 do
begin
if Flame2[i,j]<>0 then
Flame[i,j]:=Flame2[i,j];
end;
Filter; //применяем фильтр
//выводим получившиеся на экран
with DGCScreen1.Front do
begin
P:=GetPointer;
for i:=1 to 315 do
for j:=1 to 195 do
ScreenArray(P^)[i+widthbytes*(j-1)]:=Flame[i,j];
ReleasePointer;
end;
end;
А теперь несколько пояснений к приведенному листингу. Сначала мы на экране (а точнее в буфере, из которого затем выведем на экран) расставляем случайным образом RPoint черных точек. Затем мы копируем в текущий буфер первоначальную картинку из буфера в котором мы ее запомнили, причем мы копируем только саму картинку, т.е. цвета отличные от черного, чтобы не затереть полученный к этому времени огонь. Если постоянно не востанавливать первоначальное изображение, то огонь мигом съест его и перед вами вновь будет черный экран. Далее мы применяем фильтр, фильтр работает с текущим буфером Flame. И теперь получившееся изображение выводим на экран (из буфера Flame). Чтобы вывод происходил быстрее мы получаем с помощью функции GetPointer указатель на область памяти в которой хранится изображение экрана, и пишем все собержимое буфера Flame прямо в память, минуя все инстанции. Когда вы Вызвали функцию GetPointer
Windows блокируется, в это время вы свободно пишете в память а затем вызовом метода ReleasePointer восстанавливаете нормальное функционирование. Используя полученный указатель мы обращаемя к нужному участку памяти и пишем туда нужное значение из буфера Flame.
Теперь осталось написать фильтр.
procedure TForm1.Filter;
var i,j: integer;
res : integer;
begin
for i:=1 to 315 do
for j:=1 to 195 do begin
res:=round((Flame[i-1,j]+
Flame[i,j]+
Flame[i+1,j]+
Flame[i+1,j+1]+
Flame[i,j+1]+
Flame[i-1,j+1])/6);
if res255 then Red:=255;
Green:=Green+128; if Green>255 then Green:=255;
Blue:=Blue+128; if Blue>255 then Blue:=255;
//отображаем результирующую точку
Image2.Picture.Bitmap.Canvas.Pixels[i,j]:=
RGB(Red,Green,Blue);
end;
end;
Как видите листинг практичсеки полностью повторяет листинг размытия за исключением пары моментов. Так что можете немного видоизменить программу и получить совершенно новый эфект.
Размытие по Гаусу
Этот алгоритм был взят из продукта "Советы по Delphi", который вы можете скачать по адресу http://www.webinspector.com/delphi. Поэтому здесь я не буду приводить каких-либо комментариев, а лишь приведу пример листинга, за разъяснениями обращайтесь по указанному адресу.
unit GBlur2;
interface
uses
Windows, Graphics;
type
PRGBTriple = ^TRGBTriple;
TRGBTriple = packed record
b: byte; //легче для использования чем типа rgbtBlue...
g: byte;
r: byte;
end;
PRow = ^TRow;
TRow = array[0..1000000] of TRGBTriple;
PPRows = ^TPRows;
TPRows = array[0..1000000] of PRow;
const MaxKernelSize = 100;
type
TKernelSize = 1..MaxKernelSize;
TKernel = record
Size: TKernelSize;
Weights: array[-MaxKernelSize..MaxKernelSize] of single;
end;
//идея заключается в том, что при использовании TKernel мы игнорируем
//Weights (вес), за исключением Weights в диапазоне -Size..Size.
procedure GBlur(theBitmap: TBitmap; radius: double);
implementation
uses SysUtils;
procedure MakeGaussianKernel(var K: TKernel; radius: double;
MaxData, DataGranularity: double);
//Делаем K (гауссово зерно) со среднеквадратичным отклонением = radius.
//Для текущего приложения мы устанавливаем переменные MaxData = 255,
//DataGranularity = 1. Теперь в процедуре установим значение
//K.Size так, что при использовании K мы будем игнорировать Weights (вес)
//с наименее возможными значениями. (Малый размер нам на пользу,
//поскольку время выполнения напрямую зависит от
//значения K.Size.)
var j: integer;
temp, delta: double;
KernelSize: TKernelSize;
begin
for j:= Low(K.Weights) to High(K.Weights) do begin
temp:= j/radius; K.Weights[j]:= exp(- temp*temp/2);
end;
//делаем так, чтобы sum(Weights) = 1:
temp:= 0;
for j:= Low(K.Weights) to High(K.Weights) do
temp:= temp + K.Weights[j];
for j:= Low(K.Weights) to High(K.Weights) do
K.Weights[j]:= K.Weights[j] / temp;
//теперь отбрасываем (или делаем отметку "игнорировать"
//для переменной Size) данные, имеющие относительно небольшое значение -
//это важно, в противном случае смазавание происходим с малым радиусом и
//той области, которая "захватывается" большим радиусом...
KernelSize:= MaxKernelSize;
delta:= DataGranularity / (2*MaxData);
temp:= 0;
while (temp 1) do begin
temp:= temp + 2 * K.Weights[KernelSize]; dec(KernelSize);
end;
K.Size:= KernelSize;
//теперь для корректности возвращаемого результата проводим ту же
//операцию с K.Size, так, чтобы сумма всех данных была равна единице:
temp:= 0;
for j:= -K.Size to K.Size do
temp:= temp + K.Weights[j];
for j:= -K.Size to K.Size do
K.Weights[j]:= K.Weights[j] / temp;
end;
function TrimInt(Lower, Upper, theInteger: integer): integer;
begin
if (theInteger = Lower) then
result:= theInteger else
if theInteger > Upper then
result:= Upper
else result:= Lower;
end;
function TrimReal(Lower, Upper: integer; x: double): integer;
begin
if (x = lower) then
result:= trunc(x) else
if x > Upper then
result:= Upper else
result:= Lower;
end;
procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow);
var j, n, LocalRow: integer;
tr, tg, tb: double; //tempRed и др.
w: double;
begin
for j:= 0 to High(theRow) do
begin
tb:= 0;
tg:= 0;
tr:= 0;
for n:= -K.Size to K.Size do begin
w:= K.Weights[n];
//TrimInt задает отступ от края строки...
with theRow[TrimInt(0, High(theRow), j - n)] do begin
tb:= tb + w * b;
tg:= tg + w * g;
tr:= tr + w * r;
end;
end;
with P[j] do begin
b:= TrimReal(0, 255, tb);
g:= TrimReal(0, 255, tg);
r:= TrimReal(0, 255, tr);
end;
end;
Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple));
end;
procedure GBlur(theBitmap: TBitmap; radius: double);
var Row, Col: integer;
theRows: PPRows;
K: TKernel;
ACol: PRow; P:PRow;
begin
if (theBitmap.HandleType <> bmDIB)
or (theBitmap.PixelFormat <> pf24Bit) then
raise exception.Create
('GBlur может работать только с 24-битными изображениями');
MakeGaussianKernel(K, radius, 255, 1);
GetMem(theRows, theBitmap.Height * SizeOf(PRow));
GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple));
//запись позиции данных изображения:
for Row:= 0 to theBitmap.Height - 1 do
theRows[Row]:= theBitmap.Scanline[Row];
//размываем каждую строчку:
P:= AllocMem(theBitmap.Width*SizeOf(TRGBTriple));
for Row:= 0 to theBitmap.Height - 1 do
BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P);
//теперь размываем каждую колонку
ReAllocMem(P, theBitmap.Height*SizeOf(TRGBTriple));
for Col:= 0 to theBitmap.Width - 1 do
begin
//- считываем первую колонку в TRow:
for Row:= 0 to theBitmap.Height - 1 do
ACol[Row]:= theRows[Row][Col];
BlurRow(Slice(ACol^, theBitmap.Height), K, P);
//теперь помещаем обработанный столбец на свое
//место в данные изображения:
for Row:= 0 to theBitmap.Height - 1 do
theRows[Row][Col]:= ACol[Row];end;
FreeMem(theRows);
FreeMem(ACol);
ReAllocMem(P, 0);
end;
end.
А использовать этот модуль можно следующим образом
procedure TForm1.Button1Click(Sender: TObject);
var b: TBitmap;
begin
if not openDialog1.Execute then exit;
b:= TBitmap.Create;
b.LoadFromFile(OpenDialog1.Filename);
b.PixelFormat:= pf24Bit;
Canvas.Draw(0, 0, b);
GBlur(b, StrToFloat(Edit1.text));
Canvas.Draw(b.Width, 0, b);
b.Free;
end;
Поэкспериментируйет со вторым параметром процедуры GBlur, для получения различных степеней размытия.
