unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

const elvart=80; {szazalek}
    labdaszin=clwhite; hatterszin=clblack;
    tlapszin=clblue; {a teglalapnak}
    aktszin=clred; {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;
   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;




type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Function kerekit(a:byte):byte;
    Procedure rajzol(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
    Procedure elmentes(teglalap:TSik; var tcv:TCanvas);
    Procedure visszaallitas(teglalap:tSik; var tcv:TCanvas);
    Procedure TenylegKore(var l2:tlista; const teglalap; var tenylegjo:boolean);
      {procedure korellenoriz(k:Tpont; r:integer; teglalap:TSik; var tenylegjo:boolean);
        procedure korkiszamit(var l2:tlista; var k:tpont; var r:integer);}
    procedure TeglalapEll (teglalap:TSik; k:Tpont; r:integer; var joe:boolean);
    procedure lnemures(var alapsik: TSik; var l:Tlista);
    Procedure Elj1(const alapsik: TSik; const lepeskoz:integer; var l:Tlista);
    procedure inic;
  end;

var
  Form1: TForm1;
 l:tlista;
    alapsik:TSik;
    teglalap:TSik; {a teglalap: balfent.x, balfent,y, jobblent.x, jobblent,y}
    lepeskoz:integer;
    joe:boolean;

implementation

{$R *.DFM}

{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 ---}

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


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 ---}

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

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

Procedure Tform1.rajzol(bfx,bfy,jax,jay:integer; var tcv:TCanvas);
var    i,j,ujy,ujx:integer; {ciklusvaltozok}
begin
   {rajzolas}
   for i:=bfx to jax do begin
     image1.canvas.pixels[i,bfy]:=tlapszin; {felso oldal}
   end; {i}
   for j:=bfy to jay do begin
     image1.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
     image1.canvas.pixels[i,ujy]:=tlapszin;  {lenti csik}
   end; {i}
   ujx:=bfx+lepeskoz;
   for j:=bfy to jay do begin
     image1.canvas.pixels[ujx,j]:=tlapszin;  {jobb oldal}
   end; {j}
end;

Procedure tform1.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]:=image1.canvas.pixels[i,j];
    end; {j}
   end; {i}
end;

Procedure tform1.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
     image1.canvas.pixels[i,j]:=tcv.pixels[i,j];
    end; {j}
   end; {i}
end;

Procedure Tform1.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;end; {es az eredmeny, ami egy pixel-koordinata}
  var x,y:Tszam;
    a1,a2,a3,f1,f2: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:=round(abs(a1.x-a2.x)/2); f1.y:=round(abs(a1.y-a1.y)/2);
    f2.x:=round(abs(a2.x-a3.x)/2); f2.y:=round(abs(a2.y-a3.y)/2);

    {a kor kozeppontja koordinatainak kiszamitasa}
{    y.szamlalo:=( (aa1*f1.x)+(bb1*f1.y)-(a1.x)
    y.nevezo:=b1;
    x.szamlalo:=( (bb1*aa2*f2.x) + (bb2*f2.y) - (bb2*aa1*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 teglalap.jax do begin
     for j:=teglalap.bfy to teglalap.jay do begin
{!!!      if ( (image1.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 tform1.TeglalapEll (teglalap:TSik; k:Tpont; r:integer; var joe:boolean);
var i,j: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(image1.canvas.pixels[i,j])=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 tform1.lnemures(var alapsik: TSik; var l:Tlista);
var tcv:TCanvas; {a menteshez}
    kiszoveg:string; {ezt fogja kiirni}
    k,a1,a2: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
            visszaallitas(teglalap,tcv);
            l.kihagy; {az aktualisat torli es megy a kovetkezore}
            end;
  until ((joe) or (l.ures_e)); {azaz jo}
     if (joe) then begin
                   kiszoveg:='Megtalaltam a labdat! A kozepe[x]: ';
                   ShowMessage(kiszoveg+inttostr(k.x)+' [y]: '+inttostr(k.y)+' a sugar: ');
               end
      else ShowMessage('Nincs meg a labda'); {elvileg mindig megvan}
end;

Procedure tform1.Elj1(const alapsik: TSik; const lepeskoz:integer; var l:Tlista);
var svszin:byte; {az aktualis pixel milyen szinu}
    svpont:Tpont;
    j,i:integer;
begin
  j:=alapsik.bfy;
  while (j<=alapsik.jay) do begin
    i:=alapsik.bfx;
    while (i<=alapsik.jax) do begin
    svszin:=image1.canvas.pixels[i,j];
    image1.canvas.pixels[i,j]:=aktszin; {bejeloljuk, hol tartunk}
    if kerekit(svszin)=labdaszin then begin
           svpont.x:=i; svpont.y:=j; l.beszurmoge(svpont); end;   {ahol gyanus a pont}
    image1.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 tform1.inic;
var s:string;
begin
  l.ures; {letrehoz egy ujat, uresen}
  lepeskoz:=16; {elvileg barmennyi lehetne, csak igy konnyebb 2-vel osztani}
  s:=edit1.text;
  image1.picture.loadfromfile(s);
  alapsik.bfx:=0; alapsik.bfy:=0;
  alapsik.jax:=image1.width; {GetMaxX}
  alapsik.jay:=image1.height; {GetMaxY}
end;

{--- eljarasok vege ---}

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

end;
q
end.