DataLife Engine > Программирование > Советы по графике в Delphi
Советы по графике в Delphi14 сентября 2007. Разместил: podpole |
Вы наверное часто видели довольно хитроумные картины, на которых непонятно что изображено, но все равно необычность их форм завораживает и приковывает внимание. Как правило, это хитроумные формы не поддающиеся казалось бы какому-либо математическому описанию. Вы к примеру видели узоры на стекле после мороза или к примеру хитроумные кляксы, оставленные на листе чернильной ручкой, так вот что-то подобное вполне можно записать в виде некоторого алгоритма, а следовательно доступно объясниться с компьютером. Подобные множества называют фрактальными. Вобще, как мне известно фракталы появились не так уж давно, но сразу завоевали свою важную нишу. Фракталы не похожи на привычные нам фигуры, известные из геометрии, и строятся они по определенным алгоритмам, а эти алгоритмы с помощью компьютера можно изобразить на экране. Вобще, если все слегка упростить, то фракталы - это некое преобразование многократно примененное к исходной фигуре.
Здесь хочу остановиться на фрактальных множествах Мандельброта и Жюлиа. Изображения этих множеств не имеют каких либо четко очерченных границ. Особенностью фракталов является то, что даже маленькая часть изображения в конечном итоге представлет общее целое, особенно хорошо этот эффект можно пронаблюдать на примере множества Жюлиа. Кстати на основе этого свойства фракталов основано фрактальное сжатие данных, но эту тему разберем как-нибудь позже (когда накопиться достаточно нужного материала). Итак приступим к самому главному, ради чего мы здесь и собрались. Как же строятся эти удивителные множества ? Все сводится к вычислению одной единственной формулы. 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, для получения различных степеней размытия. |