{Alapinfok:}
{Adott egy ketszinu bmp, ahol }
{           az egyik szin a labda, a masik pedig a hatter}
{... es a labdanak nincs eles hatarvonala, }
{ azaz "atmosodik" a hatterbe, de van olyan hely, ahol }
{ nagyon sok labdaszinu potty van -> ezt kell megkeresni}
{kezdet: van egy bmp-file, amin pixelenkent vegigmegy}
{ --> csak sajnos nem a canvas-ra teszi, egyelore...}
{lista helyett lehet, hogy celszerubb vermet hasznalni a "kidobas" muvelet miatt, bar...}

{--- valtozok1 ---}

const const elvart=80; {szazalek}
    labdaszin=clwhite; hatterszin=clblack;
    tlapszin=clblue; {a teglalapnak}
    aktszin=red; {a canvas pixeles bejarasakor eppen holt tartunk - egy pixel}

type TSik=record bfx,bfy,jax,jay:integer; end;
type TPont=record x,y:integer; end;
type telem=Tpont;
  tlistaelemmut=^tlistaelem;
  tlistaelem=record
    ertek:telem;
    kov:tlistaelemmut; end;

{--- valtozok1 vege ---}
{--- lista ---}

  tlista=object
   private
     fej:tlistaelemmut;
     hiba:boolean;
   public
     akt:tlistaelemmut;
     procedure ures;
     function ures_e:boolean;
     procedure kovetkezore;
     procedure beszurmoge(e:telem);
     procedure kihagy; end;

procedure tlista.ures;
begin fej:=nil; akt:=nil; hiba:=false; end;

function tlista.ures_e:boolean;
begin  ures_e:=(fej=nil); end;

procedure tlista.kovetkezore;
begin
if ures_e then hiba:=true
     else if vege_e then hiba:=true else akt:=akt^.kov;
end;

procedure tlista.beszurmoge(e:telem);
var uj:Tlistaelemmut;
begin
  new(uj); { Ha nem sikerult lefoglalni, akkor "nil"-el ter vissza }
  if uj<>nil then begin
    uj^.ertek:=e;
    uj^.kov:=nil;
    if ures_e then begin fej:=uj; akt:=uj; end
      else begin
      uj^.kov:=akt^.kov;
      akt^.kov:=uj;
      akt:=uj; end; end
  else hiba:=true;
end;

procedure tlista.kihagy;
var elozo:Tlistaelemmut;
begin
  if ures_e then hiba:=true
    else begin
     if akt=fej then begin
        fej:=akt^.kov;
        dispose(akt);
        akt:=fej; end
       else begin
         elozo:=fej;
         while elozo^.kov<>akt do
           elozo:=elozo^.kov;
         elozo^.kov:=akt^.kov;
         dispose(akt);
         akt:=elozo; end;
    end;
end;

{--- lista vege ---}
{--- valtozok2 ---}
var l:tlista;
    alapsik:TSik;
    teglalap:TSik; {a teglalap: balfent.x, balfent,y, jobblent.x, jobblent,y}

Function kerekit(a:byte):byte
var svr:real; svi:integer;
begin
  svr:=((a+1)/8);
  svi:=round(svr);
  kerekit:=svi;
end;

{--- valtozok2 vege ---}
{--- eljarasok ---}

Procedure rajzol(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
var    i,j:integer; {ciklusvaltozok}
begin
   {rajzolas}
   for i:=bfx to jax do begin
     image.canvas.pixels[i,bfy]:=tlapszin; {felso oldal}
   end; {i}
   for j:=bfy to jay do begin
     image.canvas.pixels[bfx,j]:=tlapszin; {bal oldal}
   end; {j}
   ujy:=bfy+lepeskoz; {a lenti csikhoz a szelesseg beallitasa}
   for i:=bfx to jax do begin
     image.canvas.pixels[i,ujy]:=tlapszin;  {lenti csik}
   end; {i}
   ujx:=bfx+lepeskoz;
   for j:=bfy to jay do begin
     image.canvas.pixels[ujx,j]:=tlapszin;  {jobb oldal}
   end; {j}
end;

Procedure elmentes(teglalap:TSik; var tcv:TCanvas);
var i,j:integer;
begin
{mentes}
   for i:=teglalap.bfx to teglalap.jax do begin
    for j:=teglalap.bfy to teglalap.jay do begin
     tcv.pixels[i,j]:=image.canvas.pixels[i,j];
    end; {j}
   end; {i}
end;

Procedure visszaallitas(teglalap:tSik var tcv:TCanvas);
var i,j:integer;
begin
   {visszaallitas}
   for i:=teglalap.bfx to teglalap.jax do begin
    for j:=teglalap.bfy to teglalap.jay do begin
     image.canvas.pixels[i,j]:=tcv.pixels[i,j];
    end; {j}
   end; {i}
end;

Procedure TenylegKore(var l2:tlista; const teglalap; var tenylegjo:boolean);
var k:Tpont; {a kor kozpeppontja}
    r:integer; {a kor sugara}
    KorTerulet:real; TeglalapTerulet:real;
    teglalapA,teglalapB:integer;

  procedure korkiszamit(var l2:tlista; var k:tpont; var r:integer);
  type tszam=record
   szamlalo,nevezo:real; {a tortek ket resze}
    ertek:integer; {es az eredmeny, ami egy pixel-koordinata}
  var x,y:Tszam;
    a1,a2,a3:Tpont; {segedvaltozok -> a kor kozeppontja}
    JoKore:boolean; {jo e ez a kor labdanak?}
  begin
    {pontok a listabol ki}
    a1:=l.akt^.ertek; {elso pont}
    a2:=l.akt^.kov^.ertek; {masodik pont}
    a3:=l.akt^.kov^.kov^.ertek; {harmadik pont}

    {felezopontok meghatarozasa}
    f1.x:=abs(a1.x-a2.x)/2; f1.y:=abs(a1.y-a1.y)/2;
    f2.x:=abs(a2.x-a3.x)/2; f2.y:=abs(a2.y-a3.y)/2;

    {a kor kozeppontja koordinatainak kiszamitasa}
    y.szamlalo:=( (a1*f1.x) + (b1*f1.y) - (a1.x) )
    y.nevezo:=b1;
    x.szamlalo:=( (b1*a2*f2.x) + (b2*f2.y) - (b2a1*f1.x) );
    x.nevezo:=( (b1*b1) + (b2*a1) );
    x.ertek:=trunc(x.szamlalo/x.nevezo);
    y.ertek:=trunc(y.szamlalo/y.nevezo);
    r:= sqrt( ((f1.x-k.x)*(f1.x-k.x)) + ((f1.y-k.y)*(f1.y-k.y)) ); {a sugar}
  end;

  procedure korellenoriz(k:Tpont; r:integer; teglalap:TSik; var tenylegjo:boolean);
  var i,j:integer; labdaszindb:integer;
      arany:real; {a ket terulet ara'nya}
      aranyint:integer;
  begin
    for i:=teglalap.bfx to jax do begin
     for j:=teglalap.bfy to teglalap.jay do begin
      if ( (image.canvas.pixels[i,j]=labdaszin) and (tav(i,j,k)<=r) )
        then inc(labdaszindb); {megszamoljuk a "jo" pottyoket}
     end; {j}
    end; {i}
    korterulet:=lepeskoz*lepeskoz*PI; {r*r*PI <- r=lepeskoz}
    arany:=labdaszindb/korterulet; arany:=arany*100; aranyint:=trunc(arany);
    tenylegjo:=(aranyint>=elvart);
  end; {korellenoriz}

begin
  korkiszamit(l2,k,r); {a kor parametereinek megadasa}
  korellenoriz(k,r,teglalap,tenylegjo); {ez a kor megfelelo-e?}
end;

procedure TeglalapEll (teglalap:TSik; k:Tpont; r:integer; var joe:boolean);
var i:integer; {ciklusvaltozo}
    atlag:real; {a teglalapon belul hany szazalek megfelelo szinu}
    atlagint:integer;
    db:integer; {a teglalapon belul hany megfelelo szinu pottyot talalt?}
    l2:Tlista; {a teglalap megfelelo pontjainak igyujtesehez}
    tenylegjo:boolean; {jo-e a kor?}

begin
   for i:=teglalap.bfx to teglalap.jax do begin
     for j:=teglalap.bfy to teglalap.jay do begin   {pixeles bejaras}
      if kerekit(pont[i,j].szin)=labdaszin then begin
                   inc(db);                         {mennyit talaltunk}
                   l2.beszur(x,y);                  {eltesszuk kesobbre}
                 end; {if kerekit...}
     end; {for j}
    end; {for i}
    atlag:=db/i; {JoPixelekDB/maxpixel(i) - magyarul, a hely hany szazaleka "labda"}
    atlag:=atlag*100;
    atlagint:=trunc(atlag);    {a kisebb-nagyobb nem mindig mukodik real-re}
  if (atlagint>=elvart) then TenylegKore(l2,teglalap,tenylegjo); {a 2. listaban...}
  if ( (atlagint>=elvart) and (tenylegjo) )
         then joe:=true else joe:=false;
end; {teglalap ellenorzese}

procedure lnemures(var alapsik: TSik; var l:Tlista);
var tcv:TCanvas; {a menteshez}
    kiszoveg:string; {ezt fogja kiirni}
    k:TPont; {a leendo kor kozepe}
    r:integer; {a leendo kor sugara}
begin
  repeat
    a1:=l.akt^.ertek; {elso pont}
    a2:=l.akt^.kov^.ertek; {masodik pont}
   if ( tavolsag(a1,a2) < (2*lepeskoz) ) then begin
        teglalap.bfx:=a1.x-lepeskoz; teglalap.bfy:=a1.y-lepeskoz;
        teglalap.jax:=a2.x+lepeskoz; teglalap.bfy:=a2.y+lepeskoz;
      end  {tavolsag kicsi}

     else begin { if (tavolsag(a1,a2) >= (2*lepeskoz)) }
        a:=a1;
        teglalap.bfx:=a.x-lepeskoz; teglalap.bfy:=a.y-lepeskoz;
        teglalap.jax:=a.x+lepeskoz; teglalap.jay:=a.y+lepeskoz;
      end {tavolsag nagy}

     {ezeket mindket ag eseten vegre kell hajtania};
     elmentes(teglalap,tcv);
     rajzol(teglalap.bfx, teglalap.bfy, teglalap.jax, teglalap.jay);
     teglalapell(teglalap,k,r,joe); {TeglalapEllenorzes}
     if not(joe) then begin
            visszaallit(teglalap,tcv);
            l.kihagy; {az aktualisat torli es megy a kovetkezore}
  until ((joe) or (l.urese)); {azaz jo}
     if (joe) then begin
                   kiszoveg:='Megtalaltam a labdat! A kozepe[x]: ';
                   ShowMessage(kiszoveg,k.x,' [y]: ',k.y,' a sugar: ');
               end;
      else ShowMessage('Nincs meg a labda'); {elvileg mindig megvan}
end;

Procedure Elj1(const alapsik: TSik, const lepeskoz:integer; var l:Tlista);
var svszin:byte; {az aktualis pixel milyen szinu}
    svpont:Tpont;
begin
  j:=alapsik.bfy;
  while (j<=alapsik.jay) do begin
    i:=alapsik.bfx;
    while (i<=alapsik.jax) do begin
    svszin:=image.canvas.pixels[i,j];
    image.canvas.pixels[i,j]:=aktszin; {bejeloljuk, hol tartunk}
    if kerekit(svszin)=labdaszin then begin
           svpont.x:=i; svpont.y:=j; l.beszurmoge(svpont)    {ahol gyanus a pont}
    image.canvas.pixels[i,j]:=svszin; {az aktualis pixel visszakapja az eredeti szinet}
    i:=i+lepeskoz;
   end; {while i}
    j:=j+lepeskoz;
  end; {while j}
end; {elj 1}

procedure inic;
begin
  l.ures; {letrehoz egy ujat, uresen}
  lepeskoz:=16; {elvileg barmennyi lehetne, csak igy konnyebb 2-vel osztani}
  alapsik.bfx:=0; alapsik.bfy:=0;
  alapsik.jax:=image.width; {GetMaxX}
  alapsik.jay:=image.height; {GetMaxY}
end;

{--- eljarasok vege ---}
BEGIN
  inic;
  repeat
    Elj1(alapsik, lepeskoz, l);  {n-esevel pixelenkent jarja be a canvas-t}
    If ( (l.urese) and (lepeskoz<>1) )
          then lepeskoz:=(lepeskoz div 2); {lepeskoz felezese}
  until ( not(l.urese) or ((l.urese) and (lepeskoz=0)) );
  if not(l.urese) then lnemures(alapsik,l); {ha talalt labdaszinu pontot}
  if l.urese then ShowMessage('Nincs labda a kepen'); {elvileg kellene lennie labdanak, mindig}
END.