Вы наверное часто видели довольно хитроумные картины, на которых непонятно что изображено, но все равно необычность их форм завораживает и приковывает внимание. Как правило, это хитроумные формы не поддающиеся казалось бы какому-либо математическому описанию. Вы к примеру видели узоры на стекле после мороза или к примеру хитроумные кляксы, оставленные на листе чернильной ручкой, так вот что-то подобное вполне можно записать в виде некоторого алгоритма, а следовательно доступно объясниться с компьютером. Подобные множества называют фрактальными. Вобще, как мне известно фракталы появились не так уж давно, но сразу завоевали свою важную нишу. Фракталы не похожи на привычные нам фигуры, известные из геометрии, и строятся они по определенным алгоритмам, а эти алгоритмы с помощью компьютера можно изобразить на экране. Вобще, если все слегка упростить, то фракталы - это некое преобразование многократно примененное к исходной фигуре.

Здесь хочу остановиться на фрактальных множествах Мандельброта и Жюлиа. Изображения этих множеств не имеют каких либо четко очерченных границ. Особенностью фракталов является то, что даже маленькая часть изображения в конечном итоге представлет общее целое, особенно хорошо этот эффект можно пронаблюдать на примере множества Жюлиа. Кстати на основе этого свойства фракталов основано фрактальное сжатие данных, но эту тему разберем как-нибудь позже (когда накопиться достаточно нужного материала).

Итак приступим к самому главному, ради чего мы здесь и собрались. Как же строятся эти удивителные множества ?

Все сводится к вычислению одной единственной формулы.

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 (r<4) do begin x2:=x*x; y2:=y*y; xy:=x*y; x:=x2-y2+a; y:=2*xy+b; r:=x2+y2; dec(k) end; k:=round((k/100)*255); result:=RGB(k,k,k); end;

Множество Жюлиа получается если зафиксировать в формуле значение комплексной константы (a+ib), которая будет одинакова для всех точек, а начальные значения x0 и y0 принимать равными значениям координатам вычисляемой точки. Листинг для множества Жюлиа приведен ниже.

function Julia(x0,y0: real): TColor; var a,b,x,y,x2,y2,xy: real; r:real; speed,k: integer; begin r:=1; a:=-0.55; b:=-0.55; x:=x0; y:=y0; k:=100; while (k>0)and(r<4) do begin x2:=x*x; y2:=y*y; xy:=x*y; x:=x2-y2+a; y:=2*xy+b; r:=x2+y2; dec(k) end; k:=round((k/100)*255); result:=RGB(k,k,k); end;

Ниже приведен листинг функции отображающий данные множества.

procedure TForm1.BitBtn2Click(Sender: TObject); var x_min,y_min,x_max,y_max,hx,hy,x,y: real; i,j,n: integer; color: TColor; begin x_min:=-1.5; x_max:=2; y_min:=-1.5; y_max:=1.5; n:=300; y:=y_min; hx:=(x_max-x_min)/n; hy:=(y_max-y_min)/n; for j:=0 to n do begin x:=x_min; for i:=0 to n do begin if rbM.Checked then color:=MandelBrot(x,y); if rbJ.Checked then color:=Julia(x,y); imPict.Picture.Bitmap.Canvas.Pixels[i,j]:=color; x:=x+hx; end; y:=y+hy; end; end;

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

Для начала разберем принцип создания эфекта огня. В компьютерной графике при работе с изображениями очень часто используются всевозможные фильтры. Давайте рассмотрим принцип построения подобных фильтров. Пусть имеется матрица (таблица) размером 3х3(или 5х5), элементами которой являются какие-либо числа (коэффициенты). Например вот такая

Далее берется какое-то изображение, и к нему применяется этот фильтр следующим образом. Берется часть изображения размером 3х3 (5х5) вокруг текущей точки (x,y)

(x-1,y-1) (x,y-1) (x+1,y-1)
(x-1,y) (x,y) (x+1,y)
(x-1,y+1) (x,y+1) (x+1,y+1)

Теперь накладываем наш фильтр на эту часть изображения и поступаем следующим образом, умножаем цвет точки на соответствующий коэффициент из фильтра, так поступаем для каждой точки, а затем складываем эти произведения. Вконце обычно делят полученную сумму на количество слагаемых. Для нашего примера получим следующее.

( (x-1,y-1)*1 + (x,y-1)*2 + (x+1,y-1)*7 + (x-1,y)*4 + (x,y)*9 + (x+1,y)*6 + (x-1,y+1)*3 + (x,y+1)*8 + (x+1,y+1)*5)) /9

Здесь под координатами (x,y) понимается цвет соответствующей точки. Полученное значение представляет собой новый цвет точки (x,y) (точка вокруг которой было взято изображение). И так мы ищем цвет для каждой точки изображения.

Существует очень занятный фильтр

Данный фильтр как бы вытягивает вверх все изображение. Именно на основе этого фильтра и строится эффект огня. Т.е. мы рисуем красную линию (источник огня) и применяем к ней этот фильтр который вытягивает ее вверх. Если больше ничего не делать, то изображение вытянется и мы получим просто статическую картину. Чтобы этого не произошло, к изображению огня каждый раз добавляется некоторое количество случайно размещенных черных точек, которые вносят разнообразие в изображение и в совокупности с применением фильтра дает требуемый нам эфект. Если точек будет слишком много, то огонь будет плохо "разгораться", и будет ноборот слишком высоко подниматься, если их будет слишком мало, поэтому количестов случайных точек следует подбирать в каждом конкретном случае самому. Вот и вся теория, а теперь перейдем к практике.

При программировании использовался набор компонентов DGC , а точнее нам потребуется только компонент 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.abyss-group.narod.ru'); TextOut(100,96,'/~shival'); Font.Size:=20; TextOut(40,150,'abyss-group@narod.ru'); //копируем в буфер for i:=1 to 315 do for j:=1 to 195 do if Pixels[i,j]<>0 then Flame2[i,j]:=Pixels[i,j]; 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 if Flame2[i,j]<>0 then Flame[i,j]:=Flame2[i,j]; 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 res<10 then Flame[i,j]:=0 else Flame[i,j]:=res; end; end;

Фильтр работает так, как было рассказано ранее, только все цвета индексом меньши чем 10 мы заменяем на обычный черный, вот и все. Теперь напишем обработчик события OnInitialize компонента TDGCScreen.

procedure TForm1.DGCScreen1Initialize(Sender: TObject); var i: integer; begin Randomize; SetPallete; //установить палитру GetReady; //вывести первоначальное изображение DrawFlame; end;

Теперь чтобы огонь горел, а не столя на месте опустим на форму компонент TTimer и установим его свойство Enabled в TRUE а Interval присвоим значение 50. И напишем в его обработчике события OnTimer следующий код.

procedure TForm1.Timer1Timer(Sender: TObject); begin DrawFlame; end;

Т.е. мы просто обновляем экран с определнным промежутком времени, а тем самым мы дали огню гореть. Вот и все. Если хотите можете поэкспериментировать с фильтром. Например примените такой фильтр..

При применении такого фильтра огонь будет подниаться не вверх а немного наискось, как будто дует ветер. Можете поэксперементировать, примините также фильтр размером 5х5.

При применении этого фильтра пламя будет "пожарче". Попробуйте косой огонь с фильтром 5x5 и т.д. (только не хабывайте менять делитель в фильтре). Поэксперементируйте с палитрой, попробуйте в ней сделать три цвета и т.д.

Думаю все Вы не раз использовали популярную программу PhotoShop. Скажите, а нехотелось бы самим написать программу, которая бы делала нечто подобное, в смысле эфектов которые получаются при фильтрации изображения. Если да, то эта статья поможет вам начать ваше нелегкое дело, а дальше ,как говориться, дерзайте сами. Сразу предлагаю всем, кто достаточно искушен в этой области, прислать принцип создания других эфектов, буду Вам очень благодарен. В первых двух эфектах используется принцип фильтрации рассказанный в главе "Огненные буквы (эфект огня)", если вы ее не читали, то советую для начала просмотреть ее, хотя бы то, что касается теории фильтрации.

Для размытия может применятся следующий фильтр:

где а-это какое-либо целое число, обычно просто 1. При применении этой матрицы к изображению следует разделить полученный результат на величину a*8 (величина a находится в восьми клетках). Если а равно 1 то, можно просто сдвинуть результат на 3 разряда вправо (8 - это третья степень двойки). Для осуществления размытия фильтр применяется последовательно к каждой составляющей цвета изображения (RGB - красный, зеленый, синий), а затем в итоге получаем результирующий цвет. Ниже приведен листинг, который реализует эфект размытия.

procedure TForm1.Button1Click(Sender: TObject); var i,j: integer; Red,Green,Blue: byte; W,H: integer; filter: array [1..3,1..3] of integer; begin filter[1,1]:=1; filter[1,2]:=1; filter[1,3]:=1; filter[2,1]:=1; filter[2,2]:=0; filter[2,3]:=1; filter[3,1]:=1; filter[3,2]:=1; filter[3,3]:=1; W:=Image1.Picture.Bitmap.Width-1; H:=Image1.Picture.Bitmap.Height-1; for i:=2 to W do for j:=2 to H do begin with Image1.Picture.Bitmap.Canvas do begin //считаем красную составляющую Red:=((GetRValue(Pixels[i-1,j-1])*filter[1,1]+ GetRValue(Pixels[i,j-1])*filter[1,2]+ GetRValue(Pixels[i+1,j-1])*filter[1,3]+ GetRValue(Pixels[i-1,j])*filter[2,1]+ GetRValue(Pixels[i,j])*filter[2,2]+ GetRValue(Pixels[i+1,j])*filter[2,3]+ GetRValue(Pixels[i-1,j+1])*filter[3,1]+ GetRValue(Pixels[i,j+1])*filter[3,2]+ GetRValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //считаем зеленую составляющую Green:=((GetGValue(Pixels[i-1,j-1])*filter[1,1]+ GetGValue(Pixels[i,j-1])*filter[1,2]+ GetGValue(Pixels[i+1,j-1])*filter[1,3]+ GetGValue(Pixels[i-1,j])*filter[2,1]+ GetGValue(Pixels[i,j])*filter[2,2]+ GetGValue(Pixels[i+1,j])*filter[2,3]+ GetGValue(Pixels[i-1,j+1])*filter[3,1]+ GetGValue(Pixels[i,j+1])*filter[3,2]+ GetGValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //считаем синюю составляющую Blue:=((GetBValue(Pixels[i-1,j-1])*filter[1,1]+ GetBValue(Pixels[i,j-1])*filter[1,2]+ GetBValue(Pixels[i+1,j-1])*filter[1,3]+ GetBValue(Pixels[i-1,j])*filter[2,1]+ GetBValue(Pixels[i,j])*filter[2,2]+ GetBValue(Pixels[i+1,j])*filter[2,3]+ GetBValue(Pixels[i-1,j+1])*filter[3,1]+ GetBValue(Pixels[i,j+1])*filter[3,2]+ GetBValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //отображаем результирующую точку Image2.Picture.Bitmap.Canvas.Pixels[i,j]:= RGB(Red,Green,Blue); end; end;

Здесь Image1 - это объект TImage содержащий исходное изображение, а Image2 - результирующее. А это обработчик OnCreate для формы.

procedure TForm1.FormCreate(Sender: TObject); var Bmp: TBitmap; begin Image1.Picture.Bitmap.PixelFormat:=pf24bit; Bmp:= TBitmap.Create; Bmp.Width:=Image1.Picture.Bitmap.Width; Bmp.Height:=Image1.Picture.Bitmap.Height; Bmp.PixelFormat:=pf24bit; Image2.Picture.Bitmap:=Bmp; end;

Для получения большей степени размытия следует применить эфект к результату и так далее, а также можно использовать матрицу не 3х3 а 5х5, но при этом следует учитывать, что если сумму всех элементов матрицы поделить на наш делитель (в примере это 8) должно получиться 1, иначе возможны непредвиденные результаты обработки изображения.

Это очень интересный эфект, когда все изображенное как бы выдавливается из полотна. Понимаю что объяснил непонятно, но попробуйте написать сами этот эфект и вы не разочаруетесь. Здесь используется матрица следующего вида:

Делитель остается прежним (8 если а=1). Теперь если сумму элементов матрицы поделить на наш делитель , то получиться 0. Таким образом можете поэкспериментировать над матрицей и делителем, но чтобы в результате подобного вычисления получался именно 0. И еще есть одна особенность, но это будет выделено отдельно в листинге:

procedure TForm1.Button1Click(Sender: TObject); var i,j: integer; Red,Green,Blue: byte; W,H: integer; filter: array [1..3,1..3] of integer; begin filter[1,1]:=1; filter[1,2]:=1; filter[1,3]:=1; filter[2,1]:=1; filter[2,2]:=0; filter[2,3]:=-1; filter[3,1]:=-1; filter[3,2]:=-1; filter[3,3]:=-1; W:=Image1.Picture.Bitmap.Width-1; H:=Image1.Picture.Bitmap.Height-1; for i:=2 to W do for j:=2 to H do begin with Image1.Picture.Bitmap.Canvas do begin //считаем красную составляющую Red:=((GetRValue(Pixels[i-1,j-1])*filter[1,1]+ GetRValue(Pixels[i,j-1])*filter[1,2]+ GetRValue(Pixels[i+1,j-1])*filter[1,3]+ GetRValue(Pixels[i-1,j])*filter[2,1]+ GetRValue(Pixels[i,j])*filter[2,2]+ GetRValue(Pixels[i+1,j])*filter[2,3]+ GetRValue(Pixels[i-1,j+1])*filter[3,1]+ GetRValue(Pixels[i,j+1])*filter[3,2]+ GetRValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //считаем зеленую составляющую Green:=((GetGValue(Pixels[i-1,j-1])*filter[1,1]+ GetGValue(Pixels[i,j-1])*filter[1,2]+ GetGValue(Pixels[i+1,j-1])*filter[1,3]+ GetGValue(Pixels[i-1,j])*filter[2,1]+ GetGValue(Pixels[i,j])*filter[2,2]+ GetGValue(Pixels[i+1,j])*filter[2,3]+ GetGValue(Pixels[i-1,j+1])*filter[3,1]+ GetGValue(Pixels[i,j+1])*filter[3,2]+ GetGValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //считаем синюю составляющую Blue:=((GetBValue(Pixels[i-1,j-1])*filter[1,1]+ GetBValue(Pixels[i,j-1])*filter[1,2]+ GetBValue(Pixels[i+1,j-1])*filter[1,3]+ GetBValue(Pixels[i-1,j])*filter[2,1]+ GetBValue(Pixels[i,j])*filter[2,2]+ GetBValue(Pixels[i+1,j])*filter[2,3]+ GetBValue(Pixels[i-1,j+1])*filter[3,1]+ GetBValue(Pixels[i,j+1])*filter[3,2]+ GetBValue(Pixels[i+1,j+1])*filter[3,3]) div 8 ); //это та фишка о которой было сказано ранее Red:=Red+128; if Red>255 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", который вы можете скачать по адресу 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 < delta) and (KernelSize > 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 <= Upper) and (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 < upper) and (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, для получения различных степеней размытия.

• программист