Лабораторна робота №1. Алгоритми для виявлення обличчя 1 Виділення областей за кольором шкіри

1
Лабораторна робота №1. Алгоритми для виявлення обличчя
1.1 Виділення областей за кольором шкіри
Наявність інформації про колір потенційно може покращити процес виявлення обличчя, оскільки звужує область пошуку обличчя, а отже, і зменшує кількість хибних позитивних виявлень. Тому розглянемо метод на основі комбінованого каскаду класифікаторів для виявлення обличчя на кольорових зображеннях. При цьому у комбінованому каскаді потрібно сформуємо ще один рівень виявлення облич-кандидатів, що передує каскаду простих класифікаторів, на основі сегментації за кольором шкіри.
Враховуючи, що сегментація за кольором шкіри може базуватися на пікселях або на регіонах, візьмемо за основу піксельну сегментацію, яка передбачає побудову класифікатора, що відділяє пікселі шкіри від пікселів фону. При цьому доцільно використати метод моделювання з явним визначенням границь кластеру кольору шкіри, так як він є простим у використанні, швидким і достатньо точним.
Існує декілька кольорових просторів, які застосовують для сегментації за кольором шкіри, наприклад, для RGB використовують наступні явно визначені границі кластеру кольору шкіри (для кожного з каналів R, G, B):
 Модель кольору шкіри при денному освітленні:
R>95 and G>40 and B>20 max(R,G,B)-min(R,G,B)>15 and |R-G|>15 and R>G and R>D
 Модель кольору шкіри при яскравому освітленні:
R>220 and G>210 and B>170 and |R-G|<16 and R>B and G>B
 Дослідити кольорові простори TSL, YCbCr та YIQ, для яких, у свою чергу, встановлено наступні границі кластеру КШ:
TSL: 0,45<=T<=0,65
YCbCr: 85<=C
b
<=135 and 135<=C
r
<=160
YIQ: 0,02<=I<=0,22 and -0,08<=Q<=0,12
Завдання:
 Розробити п/з, яке використовуючи RGB зможе локалізувати обличчя в реальному часі і виділяти потенційно корисний об’єкт (область з домінуючою червоною складовою).
 Реалізувати додатково ще одну модель за узгодженням (TSL або YCbCr або YIQ) і порівняти (експериментально) результати;
 Реалізувати усі моделі, їх комбінації та порівняти отримані результати.
Провести експерименти в реальному часі. Локалізація кількох об’єктів на зображенні (обвести область з потенційним обличчям прямокутником, як це робилось із цифрами).
Звіт повинен містити:

2
 *.docx, що містить постановку задачі, аналітичний опис основного методу, алгоритм реалізації, візуалізацію (скріншоти, графіки тощо), висновок
(порівняльна таблиця), література, додаток (Вихідний код );
 робочий е-проект;
 проект повинен бути реалізований на платформі, що розроблена студентом на попередньому курсі – розширюєте можливості платформи.
За бажанням (додатковий бал):
(на тестовому наборі UCD, зображеня з 224 вертикальними фронтальними обличчями.
Подальша обробка сегментованого зображення може бути здійснена або виділенням сегментів з кольором шкіри та подачею кожного з них на вхід комбінованого каскаду класифікаторів як окремого зображення, або обробкою комбінованим каскадом всього вхідного зображення з накладеною бінарною маскою, в якій одиниці містять пікселі з кольором шкіри, а нулі – фон. Доцільно використати останній підхід, який потенційно потребує менше обчислювальних затрат (не потрібно знаходити інтегральне зображення для кожного сегмента, області сегментів не обробляються повторно, коли більші сегменти включають менші) та дозволяє виявити більше облич кандидатів
(обробляються краї сегментів, які можуть містити частково сегментовані обличчя).
У такому випадку з метою уникнення обробки фонових областей вхідного зображення при виявленні облич-кандидатів каскад простих класифікаторів обробляє лише ті вікна, наповненість яких нулями (пікселями фону) на бінарній масці не перевищує 70 %.

3
Лабораторна №2. Контур обличчя
1.2 Алгоритм аналізу форми областей зображення
Велика частина існуючих методів виділення обличчя по кольору стикається з проблемами присутності на зображенні значної кількості об’єктів, близьких за кольором до шкіри. Причина полягає в тому, що об’єднання пікселів кольору шкіри на першому кроці алгоритмів виявлення обличчя проводиться без врахування форми, розмірів і взаємного розміщення виділених областей. У подібного підходу є відчутний недолік – методи групування пікселів шкіри, що не враховують обмеження на форму обличчя.
Можна помилково згрупувати в одну область пікселі, які реально відносяться до різних областей. В зв’язку з цим тільки однієї інформації про колір недостатньо для стійкого виділення обличь, тому потрібно розширити набір ознак допоміжними властивостями зображення обличчя.
Розглянемо геометричні характеристики. Порівняємо два підходи: виділимо потенційну область за допомогою прямокутника і еліпса.
За допомогою прямокутника робиться аналогічно як і при розпізнаванні цифр.
Для опису еліпса використовується п’ять параметрів: координати центра еліпса ( x , y ), розміри великої і малої осі (a, b), а також кут нахилу
Θ (рис. 1).
Рисунок 1. Параметри еліпса.
Позначимо за G зв’язану множину пікселів зображення, w x,y
–
інтенсивність пікселя з координатами (x, y). Координати ( x , y ) центра еліпса вираховуються за формулами (1), (2):

5
(8)
Дана модель володіє великою гнучкістю і дозволяє вбудовувати додаткові умови та обмеження на можливу форму виділених областей
(пропорції, положення, орієнтація еліпса).
Завдання:
 Розробити п/з, яке використовуючи геометричний підхід зможе локалізувати обличчя в реальному часі і виділяти потенційно корисний об’єкт (еліпс повинен обводити область з домінуючою червоною складовою).
 Кожна модель обводиться еліпсом зі своїм кольором (TSL або
YCbCr або YIQ) і порівняти (експериментально) результати;
 Реалізувати усі моделі, їх комбінації та порівняти отримані результати. Провести експерименти в реальному часі.
Локалізація кількох об’єктів на зображенні за допомогою еліпсу.
Звіт повинен містити:
 *.docx, що містить постановку задачі, аналітичний опис основного методу, алгоритм реалізації, візуалізацію (скріншоти, графіки тощо), висновок
(порівняльна таблиця), література, додаток (Вихідний код );
 робочий е-проект;
 проект повинен бути реалізований на платформі, що розроблена студентом на попередньому курсі – розширюєте можливості платформи.
За бажанням (і додатковий бал): на тестовому наборі UCD, зображення з вертикальними фронтальними обличчями.

7
Додатки
Код програми
unit znahodjennia_oblycca; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, StdCtrls, ExtCtrls, Jpeg, Math; type
TForm1 = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
Button1: TButton;
Image1: TImage;
Button2: TButton;
Image3: TImage; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end; var
Form1: TForm1; implementation
{$R *.dfm} type boolarr=array[1..1000,1..1000] of boolean; const h=400; const w=400; const pi=3.1415926535897932384626433832; var bmpin,bmpout: TBitmap;
HH, WW: real; procedure Ellipse(X,Y,A,B: integer; Angle: real); var
I,S,C,H2,K1,K2,R: real;
X1,X2,Y1,Y2,X3,Y3,X4,Y4,YY: integer; begin
I:=(180-Angle)*PI/180;
S:=Sin(I);
C:=Cos(I);
H2:=Sqr(A*S)+Sqr(B*C); if H2=0 then begin
K1:=0;
K2:=0;

8 end else begin
K1:=S*C*(Sqr(A)-Sqr(B))/H2;
K2:=A*B/H2; end;
YY:=0; while Sqr(YY)<=H2 do begin
R:=K2*Sqrt(H2-Sqr(YY));
X1:=Round(K1*YY+R);
X2:=Round(K1*YY-R); bmpout.Canvas.Pen.Color:=clRed; if YY=0 then begin bmpout.Canvas.Pixels[X+X1,Y+YY]:=bmpout.Canvas.Pen.Color; bmpout.Canvas.Pixels[X-X1,Y-YY]:=bmpout.Canvas.Pen.Color; end else begin bmpout.Canvas.MoveTo(X+X1,Y+YY); bmpout.Canvas.LineTo(X+X3,Y+YY-1); bmpout.Canvas.MoveTo(X+X2,Y+YY); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X1,Y-YY); bmpout.Canvas.LineTo(X-X3,Y-YY+1); bmpout.Canvas.MoveTo(X-X2,Y-YY); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end;
X3:=X1;
X4:=X2;
Inc(YY); end;
H2:=Int(1.99*(YY-Sqrt(H2))); bmpout.Canvas.MoveTo(X+X3,Y+YY-1); bmpout.Canvas.LineTo(X+X3-Round(R),Y+YY-Round(H2)); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X3,Y-YY+1); bmpout.Canvas.LineTo(X-X3+Round(R),Y-YY+Round(H2)); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end; procedure znah(bmpin,bmpout:Tbitmap;colshkr:boolarr); var g:array [1..1000,1..1000] of boolean; i,j,k,n,r,l,p,q,t,e,w,h,pn,x,y,a,b:integer; sx,sy,sw:longint; rr,gg,bb:byte;

9 u1,u02,u20,teta,imin,imax:real; col:TColor; px,py:array [1..30000] of integer; begin for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do g[i,j]:=false; for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do if ((colshkr[i,j]) and (not(g[i,j]))) then begin pn:=1; px[1]:=j; py[1]:=i; g[i,j]:=true; l:=j; r:=j; r:=r+1; while ((colshkr[i,r])and(not(g[i,r]))and(r<=bmpin.Width)) do begin pn:=pn+1; px[pn]:=r; py[pn]:=i; g[i,r]:=true; r:=r+1; end; r:=r-1; t:=i+1; repeat e:=0; w:=0; for p:=l to r do if ((colshkr[t,p]) and (not(g[t,p]))) then begin pn:=pn+1; px[pn]:=p; py[pn]:=t; g[t,p]:=true; if ((colshkr[t,p]) and (e=0) ) then e:=p; if ((colshkr[t,p]) and (e<>0)) then w:=p; end; l:=e; r:=w; if l=r then break; p:=l-1; while ((colshkr[t,p]) and (not(g[t,p])) and (p>=1)) do begin pn:=pn+1; px[pn]:=p; py[pn]:=t;

10 g[t,p]:=true; p:=p-1; end; l:=p+1; p:=r+1; while ((colshkr[t,p]) and (not(g[t,p])) and (p<=bmpin.Width)) do begin pn:=pn+1; px[pn]:=p; py[pn]:=t; g[t,p]:=true; p:=p+1; end; r:=p-1; t:=t+1; until ((r=l) or (t>bmpin.Height)); sx:=0; sy:=0; sw:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); sw:=sw+rr; sx:=sx+px[k]*rr; sy:=sy+py[k]*rr; end; x:=round(sx/sw); y:=round(sy/sw); u1:=0; u20:=0; u02:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); u1:=u1+(px[k]-x)*(py[k]-y)*rr; u02:=u02+sqr(px[k]-x)*rr; u20:=u20+sqr(py[k]-y)*rr; end; if u20=u02 then teta:=arctan(0) else teta:=arctan(2*u1/(u20-u02))/2; imin:=0; imax:=0; for k:=1 to pn do

11 begin imax:=imax+sqrt(abs((px[k]-x)*sin(teta)-(py[k]-y)*cos(teta))); imin:=imin+sqrt(abs((px[k]-x)*cos(teta)-(py[k]-y)*sin(teta))); end; if imin=0 then u02:=0 else u02:=power(imax,3)/imin; if imax=0 then u20:=0 else u20:=power(imin,3)/imax; a:=round(power((4/pi),1/4)*power(u02,1/8)); b:=round(power((4/pi),1/4)*power(u20,1/8)); if (a<4*b) and (a>3*b) then ellipse(x,y,a,b,teta); end; end; function min(r:byte;g:byte;b:byte):byte; begin result:=r; if bresult then result:=b; if g>result then result:=g; end; procedure TForm1.Button1Click(Sender: TObject); begin if openpicturedialog1.Execute then begin image1.Picture.LoadFromFile(openpicturedialog1.filename); bmpin:=TBitmap.Create; bmpin.assign(image1.Picture.Graphic);
Image1.AutoSize := true;
Image1.AutoSize := false;
HH := Image1.Height / h;
WW := Image1.Width / w; if (HH > WW) then begin
Image1.Height := trunc(Image1.Height / HH);
Image1.Width := trunc(Image1.Width / HH);
Image1.Stretch := True; end else begin
Image1.Height := trunc(Image1.Height / WW);
Image1.Width := trunc(Image1.Width / WW);
Image1.Stretch := True; end;

12 end; end; procedure TForm1.Button2Click(Sender: TObject); var r,g,b:byte; rr,gg,t,s,p:real; color:Tcolor; i,j,k,l,m:integer; colshkr:boolarr; z:array[1..9] of byte; h1,h2,h3,h4,x:real; bmpp: TBitmap; begin bmpout:=TBitmap.Create; bmpout.Assign(bmpin); bmpp:=TBitmap.Create; bmpp.Assign(bmpin); for i:=1 to bmpout.Width do for j:=1 to bmpout.Height do begin color:=bmpout.Canvas.Pixels[i,j]; r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); if ((r>95) and (g>40) and (b>20) and (r>g) and (r>b) and (abs(r-g)>15) and
((max(r,g,b)-min(r,g,b))>15)) or ((r>220)and (g>120) and (b>170) and (abs(r- g)<=15) and (r>b) and (g>b)) then colshkr[i,j]:=true else colshkr[i,j]:=false; if ((r>0) or (b>0) or (g>0)) then begin rr:=r; gg:=g; p:=r; p:=p+g; p:=p+b; rr:=rr/p-1/3; gg:=gg/p-1/3; if gg=0 then t:=0; if gg>0 then t:=(arctan(rr/gg))/(2*pi)+1/4; if gg<0 then t:=(arctan(rr/gg))/(2*pi)+3/4; if ((t>=0.45) and (t<=0.65) and colshkr[i,j]) then colshkr[i,j]:=true else colshkr[i,j]:=false; end else colshkr[i,j]:=false; end; for i:=1 to bmpin.Width do for j:=1 to bmpin.Height do begin color:=bmpin.Canvas.Pixels[i,j];

13 r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); r:=round(0.3*r+0.59*g+0.11*b); bmpp.Canvas.Pixels[i,j]:=rgb(r,r,r); end; for i:=2 to (bmpp.Width-1) do for j:=2 to (bmpp.Height-1) do begin z[1]:=getrvalue(bmpp.Canvas.Pixels[i-1,j-1]); z[2]:=getrvalue(bmpp.Canvas.Pixels[i,j-1]); z[3]:=getrvalue(bmpp.Canvas.Pixels[i+1,j-1]); z[4]:=getrvalue(bmpp.Canvas.Pixels[i-1,j]); z[5]:=getrvalue(bmpp.Canvas.Pixels[i,j]); z[6]:=getrvalue(bmpp.Canvas.Pixels[i+1,j]); z[7]:=getrvalue(bmpp.Canvas.Pixels[i-1,j+1]); z[8]:=getrvalue(bmpp.Canvas.Pixels[i,j+1]); z[9]:=getrvalue(bmpp.Canvas.Pixels[i+1,j+1]); h1:=abs(z[7]+2*z[8]+z[9]-z[1]-2*z[2]-z[3]); h2:=abs(z[3]+2*z[6]+z[9]-z[1]-2*z[4]-z[7]); h3:=abs(z[2]+2*z[3]-z[4]+z[6]-2*z[7]-z[8]); h4:=abs(2*z[9]+z[8]+z[6]-z[4]-z[2]-2*z[1]); x:=50; if
((h1>x) or
(h2>x) or
(h3>x) or
(h4>x)) then bmpp.Canvas.Pixels[i,j]:=clBlack else bmpp.Canvas.Pixels[i,j]:=clWhite; end; znah(bmpin,bmpout,colshkr); image3.Picture.Assign(bmpout);
Image3.AutoSize := true;
Image3.AutoSize := false;
HH := Image3.Height / h;
WW := Image3.Width / w; if (HH > WW) then begin
Image3.Height := trunc(Image3.Height / HH);
Image3.Width := trunc(Image3.Width / HH);
Image3.Stretch := True; end else begin
Image3.Height := trunc(Image3.Height / WW);
Image3.Width := trunc(Image3.Width / WW);
Image3.Stretch := True; end; end;

14 end.unit znahodjennia_oblycca; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, StdCtrls, ExtCtrls, Jpeg, Math; type
TForm1 = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
Button1: TButton;
Image1: TImage;
Button2: TButton;
Image3: TImage; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end; var
Form1: TForm1; implementation
{$R *.dfm} type boolarr=array[1..1000,1..1000] of boolean; const h=400; const w=400; const pi=3.1415926535897932384626433832; var bmpin,bmpout: TBitmap;
HH, WW: real; procedure Ellipse(X,Y,A,B: integer; Angle: real); var
I,S,C,H2,K1,K2,R: real;
X1,X2,Y1,Y2,X3,Y3,X4,Y4,YY: integer; begin
I:=(180-Angle)*PI/180;
S:=Sin(I);
C:=Cos(I);
H2:=Sqr(A*S)+Sqr(B*C); if H2=0 then begin
K1:=0;
K2:=0; end else begin
K1:=S*C*(Sqr(A)-Sqr(B))/H2;

15
K2:=A*B/H2; end;
YY:=0; while Sqr(YY)<=H2 do begin
R:=K2*Sqrt(H2-Sqr(YY));
X1:=Round(K1*YY+R);
X2:=Round(K1*YY-R); bmpout.Canvas.Pen.Color:=clRed; if YY=0 then begin bmpout.Canvas.Pixels[X+X1,Y+YY]:=bmpout.Canvas.Pen.Color; bmpout.Canvas.Pixels[X-X1,Y-YY]:=bmpout.Canvas.Pen.Color; end else begin bmpout.Canvas.MoveTo(X+X1,Y+YY); bmpout.Canvas.LineTo(X+X3,Y+YY-1); bmpout.Canvas.MoveTo(X+X2,Y+YY); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X1,Y-YY); bmpout.Canvas.LineTo(X-X3,Y-YY+1); bmpout.Canvas.MoveTo(X-X2,Y-YY); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end;
X3:=X1;
X4:=X2;
Inc(YY); end;
H2:=Int(1.99*(YY-Sqrt(H2))); bmpout.Canvas.MoveTo(X+X3,Y+YY-1); bmpout.Canvas.LineTo(X+X3-Round(R),Y+YY-Round(H2)); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X3,Y-YY+1); bmpout.Canvas.LineTo(X-X3+Round(R),Y-YY+Round(H2)); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end; procedure znah(bmpin,bmpout:Tbitmap;colshkr:boolarr); var g:array [1..1000,1..1000] of boolean; i,j,k,n,r,l,p,q,t,e,w,h,pn,x,y,a,b:integer; sx,sy,sw:longint; rr,gg,bb:byte; u1,u02,u20,teta,imin,imax:real; col:TColor; px,py:array [1..30000] of integer; begin

16 for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do g[i,j]:=false; for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do if ((colshkr[i,j]) and (not(g[i,j]))) then begin pn:=1; px[1]:=j; py[1]:=i; g[i,j]:=true; l:=j; r:=j; r:=r+1; while ((colshkr[i,r])and(not(g[i,r]))and(r<=bmpin.Width)) do begin pn:=pn+1; px[pn]:=r; py[pn]:=i; g[i,r]:=true; r:=r+1; end; r:=r-1; t:=i+1; repeat e:=0; w:=0; for p:=l to r do if ((colshkr[t,p]) and (not(g[t,p]))) then begin pn:=pn+1; px[pn]:=p; py[pn]:=t; g[t,p]:=true; if ((colshkr[t,p]) and (e=0) ) then e:=p; if ((colshkr[t,p]) and (e<>0)) then w:=p; end; l:=e; r:=w; if l=r then break; p:=l-1; while ((colshkr[t,p]) and (not(g[t,p])) and (p>=1)) do begin pn:=pn+1; px[pn]:=p; py[pn]:=t; g[t,p]:=true; p:=p-1; end; l:=p+1;

17 p:=r+1; while ((colshkr[t,p]) and (not(g[t,p])) and (p<=bmpin.Width)) do begin pn:=pn+1; px[pn]:=p; py[pn]:=t; g[t,p]:=true; p:=p+1; end; r:=p-1; t:=t+1; until ((r=l) or (t>bmpin.Height)); sx:=0; sy:=0; sw:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); sw:=sw+rr; sx:=sx+px[k]*rr; sy:=sy+py[k]*rr; end; x:=round(sx/sw); y:=round(sy/sw); u1:=0; u20:=0; u02:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); u1:=u1+(px[k]-x)*(py[k]-y)*rr; u02:=u02+sqr(px[k]-x)*rr; u20:=u20+sqr(py[k]-y)*rr; end; if u20=u02 then teta:=arctan(0) else teta:=arctan(2*u1/(u20-u02))/2; imin:=0; imax:=0; for k:=1 to pn do begin imax:=imax+sqrt(abs((px[k]-x)*sin(teta)-(py[k]-y)*cos(teta))); imin:=imin+sqrt(abs((px[k]-x)*cos(teta)-(py[k]-y)*sin(teta))); end;

18 if imin=0 then u02:=0 else u02:=power(imax,3)/imin; if imax=0 then u20:=0 else u20:=power(imin,3)/imax; a:=round(power((4/pi),1/4)*power(u02,1/8)); b:=round(power((4/pi),1/4)*power(u20,1/8)); if (a<4*b) and (a>3*b) then ellipse(x,y,a,b,teta); end; end; function min(r:byte;g:byte;b:byte):byte; begin result:=r; if bresult then result:=b; if g>result then result:=g; end; procedure TForm1.Button1Click(Sender: TObject); begin if openpicturedialog1.Execute then begin image1.Picture.LoadFromFile(openpicturedialog1.filename); bmpin:=TBitmap.Create; bmpin.assign(image1.Picture.Graphic);
Image1.AutoSize := true;
Image1.AutoSize := false;
HH := Image1.Height / h;
WW := Image1.Width / w; if (HH > WW) then begin
Image1.Height := trunc(Image1.Height / HH);
Image1.Width := trunc(Image1.Width / HH);
Image1.Stretch := True; end else begin
Image1.Height := trunc(Image1.Height / WW);
Image1.Width := trunc(Image1.Width / WW);
Image1.Stretch := True; end; end; end; procedure TForm1.Button2Click(Sender: TObject); var r,g,b:byte;

19 rr,gg,t,s,p:real; color:Tcolor; i,j,k,l,m:integer; colshkr:boolarr; z:array[1..9] of byte; h1,h2,h3,h4,x:real; bmpp: TBitmap; begin bmpout:=TBitmap.Create; bmpout.Assign(bmpin); bmpp:=TBitmap.Create; bmpp.Assign(bmpin); for i:=1 to bmpout.Width do for j:=1 to bmpout.Height do begin color:=bmpout.Canvas.Pixels[i,j]; r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); if ((r>95) and (g>40) and (b>20) and (r>g) and (r>b) and (abs(r-g)>15) and
((max(r,g,b)-min(r,g,b))>15)) or ((r>220)and (g>120) and (b>170) and (abs(r- g)<=15) and (r>b) and (g>b)) then colshkr[i,j]:=true else colshkr[i,j]:=false; if ((r>0) or (b>0) or (g>0)) then begin rr:=r; gg:=g; p:=r; p:=p+g; p:=p+b; rr:=rr/p-1/3; gg:=gg/p-1/3; if gg=0 then t:=0; if gg>0 then t:=(arctan(rr/gg))/(2*pi)+1/4; if gg<0 then t:=(arctan(rr/gg))/(2*pi)+3/4; if ((t>=0.45) and (t<=0.65) and colshkr[i,j]) then colshkr[i,j]:=true else colshkr[i,j]:=false; end else colshkr[i,j]:=false; end; for i:=1 to bmpin.Width do for j:=1 to bmpin.Height do begin color:=bmpin.Canvas.Pixels[i,j]; r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); r:=round(0.3*r+0.59*g+0.11*b);

20 bmpp.Canvas.Pixels[i,j]:=rgb(r,r,r); end; for i:=2 to (bmpp.Width-1) do for j:=2 to (bmpp.Height-1) do begin z[1]:=getrvalue(bmpp.Canvas.Pixels[i-1,j-1]); z[2]:=getrvalue(bmpp.Canvas.Pixels[i,j-1]); z[3]:=getrvalue(bmpp.Canvas.Pixels[i+1,j-1]); z[4]:=getrvalue(bmpp.Canvas.Pixels[i-1,j]); z[5]:=getrvalue(bmpp.Canvas.Pixels[i,j]); z[6]:=getrvalue(bmpp.Canvas.Pixels[i+1,j]); z[7]:=getrvalue(bmpp.Canvas.Pixels[i-1,j+1]); z[8]:=getrvalue(bmpp.Canvas.Pixels[i,j+1]); z[9]:=getrvalue(bmpp.Canvas.Pixels[i+1,j+1]); h1:=abs(z[7]+2*z[8]+z[9]-z[1]-2*z[2]-z[3]); h2:=abs(z[3]+2*z[6]+z[9]-z[1]-2*z[4]-z[7]); h3:=abs(z[2]+2*z[3]-z[4]+z[6]-2*z[7]-z[8]); h4:=abs(2*z[9]+z[8]+z[6]-z[4]-z[2]-2*z[1]); x:=50; if
((h1>x) or
(h2>x) or(h3>x) or
(h4>x)) then bmpp.Canvas.Pixels[i,j]:=clBlack else bmpp.Canvas.Pixels[i,j]:=clWhite; end; znah(bmpin,bmpout,colshkr); image3.Picture.Assign(bmpout);
Image3.AutoSize := true;
Image3.AutoSize := false;
HH := Image3.Height / h;
WW := Image3.Width / w; if (HH > WW) then begin
Image3.Height := trunc(Image3.Height / HH);
Image3.Width := trunc(Image3.Width / HH);
Image3.Stretch := True; end else begin
Image3.Height := trunc(Image3.Height / WW);
Image3.Width := trunc(Image3.Width / WW);
Image3.Stretch := True; end; end; end.unit znahodjennia_oblycca; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

21
Dialogs, ExtDlgs, StdCtrls, ExtCtrls, Jpeg, Math; type
TForm1 = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
Button1: TButton;
Image1: TImage;
Button2: TButton;
Image3: TImage; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end; var
Form1: TForm1; implementation
{$R *.dfm} type boolarr=array[1..1000,1..1000] of boolean; const h=400; const w=400; const pi=3.1415926535897932384626433832; var bmpin,bmpout: TBitmap;
HH, WW: real; procedure Ellipse(X,Y,A,B: integer; Angle: real); var
I,S,C,H2,K1,K2,R: real;
X1,X2,Y1,Y2,X3,Y3,X4,Y4,YY: integer; begin
I:=(180-Angle)*PI/180;
S:=Sin(I);
C:=Cos(I);
H2:=Sqr(A*S)+Sqr(B*C); if H2=0 then begin
K1:=0;
K2:=0; end else begin
K1:=S*C*(Sqr(A)-Sqr(B))/H2;
K2:=A*B/H2; end;
YY:=0; while Sqr(YY)<=H2 do

22 begin
R:=K2*Sqrt(H2-Sqr(YY));
X1:=Round(K1*YY+R);
X2:=Round(K1*YY-R); bmpout.Canvas.Pen.Color:=clRed; if YY=0 then begin bmpout.Canvas.Pixels[X+X1,Y+YY]:=bmpout.Canvas.Pen.Color; bmpout.Canvas.Pixels[X-X1,Y-YY]:=bmpout.Canvas.Pen.Color; end else begin bmpout.Canvas.MoveTo(X+X1,Y+YY); bmpout.Canvas.LineTo(X+X3,Y+YY-1); bmpout.Canvas.MoveTo(X+X2,Y+YY); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X1,Y-YY); bmpout.Canvas.LineTo(X-X3,Y-YY+1); bmpout.Canvas.MoveTo(X-X2,Y-YY); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end;
X3:=X1;
X4:=X2;
Inc(YY); end;
H2:=Int(1.99*(YY-Sqrt(H2))); bmpout.Canvas.MoveTo(X+X3,Y+YY-1); bmpout.Canvas.LineTo(X+X3-Round(R),Y+YY-Round(H2)); bmpout.Canvas.LineTo(X+X4,Y+YY-1); bmpout.Canvas.MoveTo(X-X3,Y-YY+1); bmpout.Canvas.LineTo(X-X3+Round(R),Y-YY+Round(H2)); bmpout.Canvas.LineTo(X-X4,Y-YY+1); end; procedure znah(bmpin,bmpout:Tbitmap;colshkr:boolarr); var g:array [1..1000,1..1000] of boolean; i,j,k,n,r,l,p,q,t,e,w,h,pn,x,y,a,b:integer; sx,sy,sw:longint; rr,gg,bb:byte; u1,u02,u20,teta,imin,imax:real; col:TColor; px,py:array [1..30000] of integer; begin for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do g[i,j]:=false; for i:=1 to bmpin.Height do for j:=1 to bmpin.Width do

24 px[pn]:=p; py[pn]:=t; g[t,p]:=true; p:=p+1; end; r:=p-1; t:=t+1; until ((r=l) or (t>bmpin.Height)); sx:=0; sy:=0; sw:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); sw:=sw+rr; sx:=sx+px[k]*rr; sy:=sy+py[k]*rr; end; x:=round(sx/sw); y:=round(sy/sw); u1:=0; u20:=0; u02:=0; for k:=1 to pn do begin col:=bmpin.Canvas.Pixels[px[k],py[k]]; rr:=GetRValue(col); gg:=GetGValue(col); bb:=GetBValue(col); rr:=round(0.3*rr+0.59*gg+0.11*bb); u1:=u1+(px[k]-x)*(py[k]-y)*rr; u02:=u02+sqr(px[k]-x)*rr; u20:=u20+sqr(py[k]-y)*rr; end; if u20=u02 then teta:=arctan(0) else teta:=arctan(2*u1/(u20-u02))/2; imin:=0; imax:=0; for k:=1 to pn do begin imax:=imax+sqrt(abs((px[k]-x)*sin(teta)-(py[k]-y)*cos(teta))); imin:=imin+sqrt(abs((px[k]-x)*cos(teta)-(py[k]-y)*sin(teta))); end; if imin=0 then u02:=0 else u02:=power(imax,3)/imin; if imax=0 then u20:=0 else u20:=power(imin,3)/imax; a:=round(power((4/pi),1/4)*power(u02,1/8)); b:=round(power((4/pi),1/4)*power(u20,1/8));

25 if (a<4*b) and (a>3*b) then ellipse(x,y,a,b,teta); end; end; function min(r:byte;g:byte;b:byte):byte; begin result:=r; if bresult then result:=b; if g>result then result:=g; end; procedure TForm1.Button1Click(Sender: TObject); begin if openpicturedialog1.Execute then begin image1.Picture.LoadFromFile(openpicturedialog1.filename); bmpin:=TBitmap.Create; bmpin.assign(image1.Picture.Graphic);
Image1.AutoSize := true;
Image1.AutoSize := false;
HH := Image1.Height / h;
WW := Image1.Width / w; if (HH > WW) then begin
Image1.Height := trunc(Image1.Height / HH);
Image1.Width := trunc(Image1.Width / HH);
Image1.Stretch := True; end else begin
Image1.Height := trunc(Image1.Height / WW);
Image1.Width := trunc(Image1.Width / WW);
Image1.Stretch := True; end; end; end; procedure TForm1.Button2Click(Sender: TObject); var r,g,b:byte; rr,gg,t,s,p:real; color:Tcolor; i,j,k,l,m:integer; colshkr:boolarr;

26 z:array[1..9] of byte; h1,h2,h3,h4,x:real; bmpp: TBitmap; begin bmpout:=TBitmap.Create; bmpout.Assign(bmpin); bmpp:=TBitmap.Create; bmpp.Assign(bmpin); for i:=1 to bmpout.Width do for j:=1 to bmpout.Height do begin color:=bmpout.Canvas.Pixels[i,j]; r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); if ((r>95) and (g>40) and (b>20) and (r>g) and (r>b) and (abs(r-g)>15) and
((max(r,g,b)-min(r,g,b))>15)) or ((r>220)and (g>120) and (b>170) and (abs(r- g)<=15) and (r>b) and (g>b)) then colshkr[i,j]:=true else colshkr[i,j]:=false; if ((r>0) or (b>0) or (g>0)) then begin rr:=r; gg:=g; p:=r; p:=p+g; p:=p+b; rr:=rr/p-1/3; gg:=gg/p-1/3; if gg=0 then t:=0; if gg>0 then t:=(arctan(rr/gg))/(2*pi)+1/4; if gg<0 then t:=(arctan(rr/gg))/(2*pi)+3/4; if ((t>=0.45) and (t<=0.65) and colshkr[i,j]) then colshkr[i,j]:=true else colshkr[i,j]:=false; end else colshkr[i,j]:=false; end; for i:=1 to bmpin.Width do for j:=1 to bmpin.Height do begin color:=bmpin.Canvas.Pixels[i,j]; r:=GetRValue(color); g:=GetGValue(color); b:=GetBValue(color); r:=round(0.3*r+0.59*g+0.11*b); bmpp.Canvas.Pixels[i,j]:=rgb(r,r,r); end; for i:=2 to (bmpp.Width-1) do for j:=2 to (bmpp.Height-1) do

27 begin z[1]:=getrvalue(bmpp.Canvas.Pixels[i-1,j-1]); z[2]:=getrvalue(bmpp.Canvas.Pixels[i,j-1]); z[3]:=getrvalue(bmpp.Canvas.Pixels[i+1,j-1]); z[4]:=getrvalue(bmpp.Canvas.Pixels[i-1,j]); z[5]:=getrvalue(bmpp.Canvas.Pixels[i,j]); z[6]:=getrvalue(bmpp.Canvas.Pixels[i+1,j]); z[7]:=getrvalue(bmpp.Canvas.Pixels[i-1,j+1]); z[8]:=getrvalue(bmpp.Canvas.Pixels[i,j+1]); z[9]:=getrvalue(bmpp.Canvas.Pixels[i+1,j+1]); h1:=abs(z[7]+2*z[8]+z[9]-z[1]-2*z[2]-z[3]); h2:=abs(z[3]+2*z[6]+z[9]-z[1]-2*z[4]-z[7]); h3:=abs(z[2]+2*z[3]-z[4]+z[6]-2*z[7]-z[8]); h4:=abs(2*z[9]+z[8]+z[6]-z[4]-z[2]-2*z[1]); x:=50; if
((h1>x)or
(h2>x) or
(h3>x) or
(h4>x)) then bmpp.Canvas.Pixels[i,j]:=clBlack else bmpp.Canvas.Pixels[i,j]:=clWhite; end; znah(bmpin,bmpout,colshkr); image3.Picture.Assign(bmpout);
Image3.AutoSize := true;
Image3.AutoSize := false;
HH := Image3.Height / h;
WW := Image3.Width / w; if (HH > WW) then begin
Image3.Height := trunc(Image3.Height / HH);
Image3.Width := trunc(Image3.Width / HH);
Image3.Stretch := True; end else begin
Image3.Height := trunc(Image3.Height / WW);
Image3.Width := trunc(Image3.Width / WW);
Image3.Stretch := True; end;