Советы по графике в 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(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;

При рассмотрении темы большую помощь оказала статья А.Колесникова "Визуализация фрактальных структур" в "Компьтерных вестях".

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

Первый способ.

Первый способ состоит в обработки событий нажатия клавиши мыши на форме, перемещения мыши и отпускании клавиши. Предварительно следует объявить следующие переменные.

Переменная Hit в начале работы должны иметь значение False. Это удобно сделать в обработчике события формы OnCreate.

Далее следует написать обработчик для события OnMouseDown(нажата клавиша мыши).

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Hit:=true;
_x:=X; _y:=Y;
end;

Здесь мы мутем присваивания перменно Hit значение true указываем, что было произведено нажатие кнопки мыши (пока кнопка будет удерживаться в нажатом состоянии значение переменной Hit будет равно true). Также здесь мы запоминаем текущие координаты мыши. Далее следует написать обработчик для события OnMouseMove (перемещение курсора мыши)

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Hit then begin
left:=left+(x-_x);
top:=top+(y-_y);
end;
end;

Сначала идет проверка нажата ли клавиша мыши, если нажата, то перемещаем наше окно. И осталось написать обработчик для события OnMouseUp.

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Hit:=false;
end;

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

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

После этого описываем соответствующий обработчик.

procedure TForm1.WMNCHITTEST (var Msg: TWMNCHITTEST);
begin
inherited;
if Msg.Result=HTCLIENT then
Msg.Result:=HTCAPTION;
end;

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

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

1	2	7
4	9	6
3	8	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) (точка вокруг которой было взято изображение). И так мы ищем цвет для каждой точки изображения.
Существует очень занятный фильтр

0	0	0
1	1	1
1	1	1

Данный фильтр как бы вытягивает вверх все изображение. Именно на основе этого фильтра и строится эффект огня. Т.е. мы рисуем красную линию (источник огня) и применяем к ней этот фильтр который вытягивает ее вверх. Если больше ничего не делать, то изображение вытянется и мы получим просто статическую картину. Чтобы этого не произошло, к изображению огня каждый раз добавляется некоторое количество случайно размещенных черных точек, которые вносят разнообразие в изображение и в совокупности с применением фильтра дает требуемый нам эфект. Если точек будет слишком много, то гонь будет плохо "разгораться", и будет ноборот слишком высоко подниматься, если их будет слишком мало, поэтому количестов случайных точек следует подбирать в каждом конкретном случае самому. Вот и вся теория, а теперь перейдем к практике.
При программировании использовался набор компонентов DGC (см. Раздел "Учимся"->"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 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 следующий код.

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

0	0	1
0	1	1
1	1	1

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

0	0	0	0	0
0	0	0	0	0
1	1	1	1	1
1	1	1	1	1
1	1	1	1	1

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

Вы хотите чтобы ваше приложение было замечено потребителем ? Немалую роль в этом играет оформление. Оформление это не только удобный интерфейс и красивые картинки. Как правило запоминаются приложения, которые выделяются из общей массы чем-то особенным. Предлагаю Вам создать формы нестандартной формы. Если Вас интересует создание окон в виде звезды или еще более вычурной формы, то располагайтесь поудобнее и читайте эту статью.
Начнем мы с рассмотрения работы с регионами в Windows. Регион в Windows представляет собой некоторую замкнутую фигуру. Например круг или звезда, или прямоугольник и т.д. Давайте рассмотрим примеры построения таких регионов. Первая функция для построения регионов:

Данная функция создает область представляющую собой элипс вписаный в прямоугольник, координаты которого задаются с помощью параметров Left,Top,Right,Bottom. Функция возвращает дескриптор области, с помощью которого можно будет в дальнейшем с ней работать.

Данная функция по действию аналогична предыдущей, только параметры прямоугольника задаются структурой TRect.

Создает регион, форма которого определяется массивом Points, который задается слеующим образом:
Points: array [1..nPoints] of TPoint;
nPoints , как Вы уже поняли, это количество точек.
FillMode - определет какая именно область войдет в регион. Здесь как мне кажется этот параметр особого значения не имеет и как правило устанавливается равным ALTERNATE.

function CreatePolyPolygonRgn(const pPtStruct; const pIntArray; nCount, FillMode: integer): HRGN;

Создает регион, который состоит из нескольких регионов.
pPtStruct - это как бы массив массивов, т.е. массив элементами которого являются массивы вида array [1..n] of TPoint, каждый такой элемент представляет собой отдельный регион.
pIntArray - массив, элементы которого показывают количестов вершин в соответствующем регионе
nCount - количество задаваемых регионов.
FillMode - режим заполнения.

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

function CreateRoundRectRgn (Left,Top,Right,Bottom, WidthEl,HeightEl: integer) : HRGN;

Создает прямоугольный регион (размеры Left,Top,Right,Bottom) с закругленными углами. Параметры WidthEl и HeightEl определяют параметры закругления.

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

Функция комбинирует два региона Source1 и Source2 и получает новый регион Dest.
Mode - это режим комбинирования регионов, значения параметра приведены в таблице.

Значение Описание
RGN_AND Результат комбинирования - пересечение регионов
RGN_COPY Результат - копия региона Source1.
RGN_DIFF Результат - часть региона Source1 которая не
принадлежит региону Source2.
RGN_OR Результат - объединение двух регионов
RGN_XOR Результат - объединение регионов минус их
пересечение.

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

Данная функция для окна с дескриптором hWnd устанавливает новую область отображения, которую определяет созданный регион Rgn. Регион может быть любой формы. Параметр RDraw установленный в TRUE указывает операционной системе перерисовать окно после изменения его области отображения. Т.е. теперь все что есть на форму будет так же работать как и всегда, но отображаться будет только то, что попало в указанный регион.

Сейчас мы рассмотрим еще две полезные функции и после этого построим форму в виде звезды, которая хорошо подойдет для окна About.

Функция определяет попала ли точка (X,Y) в регион Rgn.

Функция рисует рамку для региона Rgn. DC- дескриптор плотна, на котором рисуем рамку
Brush - кисть которой рисуем,
W,H - параметры рамки (ширина и высота).

Ну а теперь построим вот такую форму.

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

procedure TForm1.FormCreate(Sender: TObject);
var Star1,Star2: HRGN;
Ver: array [1..11] of TPoint;
_Height,_Width,CapY: integer;
begin
BorderStyle:=bsNone; // обязательно установить, чтобы Windows
//не мешалась со своим отображением границы
CapY := GetSystemMetrics(SM_CYCAPTION)+8; //получаем высоту заголовока
//создаем регион (внешний)
Ver[1]:=Point(0,3*height div 10);
Ver[2]:=Point(3*width div 10,3*height div 10);
Ver[3]:=Point(5*width div 10,0);
Ver[4]:=Point(7*width div 10,3*height div 10);
Ver[5]:=Point(width,3*height div 10);
Ver[6]:=Point(8*width div 10,5*height div 10);
Ver[7]:=Point(width,height);
Ver[8]:=Point(8*width div 10,9*height div 10);
Ver[9]:=Point(2*width div 10,9*height div 10);
Ver[10]:=Point(0,height);
Ver[11]:=Point(2*width div 10,5*height div 10);
Star1:=CreatePolygonRgn(Ver,11,ALTERNATE);

//создаем внутренний регион (в виде треугольника)
Ver[1]:=Point(5*width div 10,6*height div 10);
Ver[2]:=Point(6*width div 10,7*height div 10);
Ver[3]:=Point(4*width div 10,7*height div 10);
Star2:=CreatePolygonRgn(Ver,3,ALTERNATE);
//вычитаем из внешнего региона внутренний
CombineRgn(Star1,Star1,Star2,RGN_DIFF);
//устанавливаем окну новый регион
SetWindowRgn(Handle,Star1,true);
DeleteObject(Star2); //удаляем ненужный объект
//создаем регион для рамки (внешний)
_Width:=width-4; _height:=height-4;
Ver[1]:=Point(2,2+3*_height div 10);
Ver[2]:=Point(2+3*_width div 10,2+3*_height div 10);
Ver[3]:=Point(2+5*_width div 10,2);
Ver[4]:=Point(2+7*_width div 10,2+3*_height div 10);
Ver[5]:=Point(2+_width,2+3*_height div 10);
Ver[6]:=Point(2+8*_width div 10,2+5*_height div 10);
Ver[7]:=Point(2+_width,2+_height);
Ver[8]:=Point(2+8*_width div 10,2+9*_height div 10);
Ver[9]:=Point(2+2*_width div 10,2+9*_height div 10);
Ver[10]:=Point(2,2+_height);
Ver[11]:=Point(2+2*_width div 10,2+5*_height div 10);
rBound:=CreatePolygonRgn(Ver,11,ALTERNATE);

//создаем регион для рамки (внутренний)
_width:=width+4; _height:=height+4;
Ver[1]:=Point(5*_width div 10-2,6*_height div 10-2);
Ver[2]:=Point(6*_width div 10-2,7*_height div 10-2);
Ver[3]:=Point(4*_width div 10-2,7*_height div 10-2);
Star2:=CreatePolygonRgn(Ver,3,ALTERNATE);
CombineRgn(rBound,rBound,Star2,RGN_DIFF);
DeleteObject(Star2);

//создаем регион для заголовка (из большого треугольника вычитаем поменьше)
//причем основания треугольников совмещены
Ver[1]:=Point(3*width div 10+4,3*height div 10);
Ver[2]:=Point(5*width div 10,4);
Ver[3]:=Point(7*width div 10-4,3*height div 10);
rTitle:=CreatePolygonRgn(Ver,3,ALTERNATE);

Ver[1]:=Point(3*width div 10+(4+CapY),3*height div 10);
Ver[2]:=Point(5*width div 10,(4+CapY));
Ver[3]:=Point(7*width div 10-(4+CapY),3*height div 10);
Star2:=CreatePolygonRgn(Ver,3,ALTERNATE);
CombineRgn(rTitle,rTitle,Star2,RGN_DIFF);
DeleteObject(Star2);
end;

Прошу не забыть предварительно объявит переменные rTitle и rBound. Это можно сделать в разделе private объявления класса:

Таким образом, мы создали окно не стандартной формы, теперь научимся рисовать ему рамку и перетаскивать за заголовок. Отображение рамки и заголовка проивзодится в обработчике события onPaint.

procedure TForm1.FormPaint(Sender: TObject);
begin
//рисуем рамку. Сначала мы рисуем широкую серую оконтовку
//а затем на ней более узкую белую, добиваясь этим
//некторого подобия трехмерности.
Canvas.Brush.Color:=clGray;
FrameRgn(Canvas.Handle,
rBound,
Canvas.Brush.Handle,
2,
2);
Canvas.Brush.Color:=clWhite;
FrameRgn(Canvas.Handle,
rBound,
Canvas.Brush.Handle,
1,
1);
//а теперь отображаем заголовок
Canvas.Brush.Color:=clBlue;
PaintRgn(Canvas.Handle,rTitle);
//здесь можно нарисовать текст на загловке кнопочки и т.д.
end;

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

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHITTEST);
begin
inherited; //вызываем обработчик по умолчанию
WITH Msg DO
//переводим экранные координаты в оконные и работаем с ними
WITH ScreenToClient(Point(XPos,YPos)) DO
//если нажатие было над регионом заголовка
//то дать знать об этом Windows, остальное она сделает за вас
IF PtInRegion(rTitle, X, Y) THEN
Result := htCaption;
end;

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

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

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

a	a	a
a	0	a
a	a	a

где а-это какое-либо целое число, обчно просто 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, иначе возможны непредвиденные результаты обработки изображения.

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

а	a	a
a	0	-a
-a	-a	-a

Делитель остается прежним (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", который вы можете скачать по адресу 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 < 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, для получения различных степеней размытия.