$360.32


$403.73


$30.16


Советы по графике в Delphi

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


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


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

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

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,«sia@itt.net.ru»);
//копируем в буфер
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, для получения различных степеней размытия.

 

Интересное

Пишем браузер
Продолжаю тему клонирования программ darkamster«a на Delphi в С++Builder. В этой статье я покажу, как с помощью стандартных компонентов, можно создать свой браузер. Браузер будет на движке...
Подробнее...
Как правильно обращаться с...
Подключение компьютера. Итак, Вы привезли домой коробки, распаковали. (Не забудьте, что, если Вы купили компьютер зимой, и по дороге он немного замерз, следует подождать 3-4 часа, прежде чем его...
Подробнее...
Сущность ООП
Одна из вещей, которую вы могли бы захотеть реализовать — пользовательский интерфейс, предоставляющий доступ к файлу персональных данных. ООП предоставляет вам безусловно лучшие механизмы для его...
Подробнее...

Продукт "1С: Бухгалтерия 8 КОРП". Что это такое и для чего он нужен? Бухгалтера строго соблюдают порядок ведения хозяйственной деятельности предприятия. Прошли времена, когда нелегкий труд...
Подробнее...
Обучение рисованию животных. Поэтапное обучение рисованию. Методика правополушарного рисования
Что моя бабушка говорила...
Закон о возмещении ущерба в случае похищения персональных данных 2007 года получил единодушное согласие сената. Как это часто бывает с нашей законодательной властью, две палаты конгресса —...
Подробнее...
Выделенный сервер
Вас интересует вопрос, что такое выделенный сервер(Dedicated Server) и для чего он нужен.Этот хостинг, который предоставляет клиенту в полное пользование отдельным выделенным сервером. Есть...
Подробнее...
Основы позиционирования блоков
Блоки — прямоугольные области, используемые в CSS для формирования и отображения документов. Это упрощенно, очень сильно упрощенно, но для начала вполне может и хватить.С появлением нового...
Подробнее...
Мужской стиль
Ни для кого не секрет, что одной из главных черт всех успешных деловых людей является умение хорошо выглядеть. На любых переговорах и встречах, деловой человек будет выглядеть впечатлительно....
Подробнее...
Своя система голосования
Вы когда-нибудь хотели узнать мнение своих посетителей по тому или иному поводу?Например, «что Вы хотите видеть на сайте» или «нравиться ли Вам наш новый дизайн» ?Уверен, что...
Подробнее...
Запуск mergemaster для...
В статье рассматривается работа с программой mermemaster при обновлении ОС FreeBSDDisclaimer Я ни в коем разе не претендую, что установка сделана правильно, корректно, «так как надо» и...
Подробнее...