Главная страница Случайная страница
КАТЕГОРИИ:
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Код програми
|
|
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;
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
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;
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;
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 b< result then result: =b;
if g< result then result: =g;
end;
function max(r: byte; g: byte; b: byte): byte;
begin
result: =r;
if b> result 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;
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
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,
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
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
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;
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;
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 b< result then result: =b;
if g< result then result: =g;
end;
function max(r: byte; g: byte; b: byte): byte;
begin
result: =r;
if b> result 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;
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
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,
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
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
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;
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;
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 b< result then result: =b;
if g< result then result: =g;
end;
function max(r: byte; g: byte; b: byte): byte;
begin
result: =r;
if b> result 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;
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
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.