Студопедия

Главная страница Случайная страница

Разделы сайта

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






Код програми






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.

 

 






© 2023 :: MyLektsii.ru :: Мои Лекции
Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав.
Копирование текстов разрешено только с указанием индексируемой ссылки на источник.