3.2.2. Jazyk Delphi

Příklad 3.16. Červi

dodat dokumentaci

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ServerSocket7: TServerSocket;
    Button1: TButton;
    Label1: TLabel;
    ClientSocket1: TClientSocket;
    Button2: TButton;
    Edit1: TEdit;
    Image1: TImage;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Label3: TLabel;
    klavesa: TLabel;
    Timer2: TTimer;
    Button3: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    CheckBox1: TCheckBox;
    Timer3: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket7ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket7ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket7Listen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button3Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Poradi:byte;   {kolikaty clen hry vlastne jsem}
  cer:array[0..6] of record x,y:real;
                            smer:Extended;
                            rychlost:byte;
                            sekund:TDateTime;
                            end;
  klavesy:array[0..6] of string[3];
  cas_zacatku:TDateTime;

implementation

{$R *.DFM}

function vypocti_cas:TDateTime;
begin
vypocti_cas:=Time*24*60*60 - cas_zacatku;
end;

function barvicka(i:byte): TColor;   {funkce vracejici barvicku toho zadaneho cerva}
begin
case i of 0:barvicka:=clred;
          1:barvicka:=clgreen;
          2:barvicka:=clblue;
          3:barvicka:=clblack;
          4:barvicka:=clolive;
          5:barvicka:=clsilver;
          6:barvicka:=claqua
          else barvicka:=clred
          end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
serversocket7.Active:=true;
label1.visible:=true;
label1.caption:=serversocket7.socket.LocalHost;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.host:=edit1.text;
clientsocket1.active:=true;
end;

procedure TForm1.ServerSocket7ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.lines.add('Pripojeni pocitace '+socket.RemoteAddress+' ['+socket.RemoteHost+']');
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
socket.sendtext('DEJ PORADI');
end;

procedure TForm1.ServerSocket7ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var s:string;
    a:byte;
begin
{Komunikace, co obdrzi server}
s:=socket.ReceiveText;
if s='DEJ PORADI' then begin
  if ServerSocket7.socket.activeConnections>SpinEdit1.value then begin
    socket.sendtext('POZDE... UZ JE PLNO...');
    socket.Close;
    memo1.lines.add('Odpojil jsem uzivatele z pocitace ['+socket.RemoteHost+'] z duvodu preplneni.');
    exit;
    end;
  socket.sendtext('PORADI '+inttostr(ServerSocket7.socket.activeConnections)+' '+inttostr(SpinEdit1.value));
  memo1.lines.add('DEJ PORADI od ['+socket.RemoteHost+']');
  memo1.lines.add('PORADI '+inttostr(ServerSocket7.socket.activeConnections)+' '+inttostr(SpinEdit1.value)+
                    ' pro ['+socket.RemoteHost+']');
  if ServerSocket7.socket.activeConnections=SpinEdit1.value then begin
    {Zacina hra...}
    memo1.lines.add('Zacala hra.');
    Timer1.tag:=10;
    Timer1.enabled:=true;
    end;

  end;

if copy(s,1,7)='KLAVESA' then begin
  s:=copy(s,9,256); {odstranime text 'KLAVESA '}
  a:=strtoint(copy(s,1,pos(' ',s)-1));
  s:=copy(s, pos(' ',s)+1, 256);
  a:=a mod (spinedit1.value);
  klavesy[a]:=s;
  end;

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var s:string;
    i:byte;
    j,k:integer;
    a,b,c:word;
begin
{Komunikace, co obdrzi klient}
s:=socket.ReceiveText;
if copy(s,1,7)='PORADI ' then begin
  s:=copy(s,8,length(s));
  poradi:=strtoint(copy(s,1,1));              {toto je poradi}
  SpinEdit1.value:=strtoint(copy(s,3,1));     {toto je pocet hracu}
  memo1.lines.add('Bylo mi od serveru ['+socket.remotehost+'] prideleno poradi cislo '+inttostr(poradi)+' z '
                   +inttostr(SpinEdit1.value)+' hracu.');
  StatusBar1.SimpleText:='�k�e na pipojen�zbylch hr�...'
  end;
if copy(s,1,12)='HRA ZACNE...' then begin
  label3.visible:=true;
  label3.font.Color:=barvicka(poradi mod SpinEdit1.value); {Aby posledni dostal nulu}
  label3.color:=clwhite;
  label3.caption:=copy(s,13,2);
  memo2.SetFocus;
  end;
if copy(s,1,10)='HRA ZACINA' then begin
  label3.visible:=false;
  memo1.Lines.add('Hra zacala.');
  cas_zacatku:=Time*24*60*60;
  end;
if copy(s,1,4)='DIRA' then begin {=}
  s:=copy(s,6,256);  {skrouhnuti pismen "DIRA "}
  a:=strtoint(copy(s,1, POS(' ',S)-1));  {prvni cislo, az do mezery}
  s:=copy(s, POS(' ',S)+1, 256);        {prvni cislo i s mezerou jsme odebrali}
  b:=strtoint(copy(s,1, POS('/',S)-1));  {prvni cislo, az do mezery}
  s:=copy(s, POS('/',S)+1, 256);        {co je za lomitkem, to tam zustane}
  Image1.Picture.Bitmap.Canvas.pen.Color:=clwhite;
  Image1.Picture.Bitmap.Canvas.brush.Color:=clwhite;
  Image1.Picture.Bitmap.Canvas.Ellipse(a,b,a+50,b+50);
  end; {=}
if copy(s,1,12)='POZICE_VSECH' then begin {=}
  s:=copy(s,14,256); {to jsem si odstanil ten text 'POZICE_VSECH '}
  for i:=1 to spinedit1.value do begin {-}
    a:=strtoint(copy(s,1, POS(' ',S)-1));  {prvni cislo, az do mezery}
    s:=copy(s, POS(' ',S)+1, 256);        {prvni cislo i s mezerou jsme odebrali}
    b:=strtoint(copy(s,1, POS(' ',S)-1));  {druhe cislo, az do mezery}
    s:=copy(s, POS(' ',S)+1, 256);        {druhe cislo i s mezerou jsme odebrali}
    c:=strtoint(copy(s,1, POS(' ',S)-1));  {treti cislo, az do mezery}
    s:=copy(s, POS(' ',S)+1, 256);        {treti cislo i s mezerou jsme odebrali}
    Image1.Picture.Bitmap.Canvas.pen.Color:=barvicka(i-1);
    Image1.Picture.Bitmap.Canvas.brush.Color:=barvicka(i-1);
    for j:=-3 to 3 do for k:=-3 to 3 do
      if sqrt(j*j+k*k)<=3 then
         if Image1.Picture.Bitmap.Canvas.Pixels[a+j,b+k]=clwhite then
             Image1.Picture.Bitmap.Canvas.Pixels[a+j,b+k]:=barvicka(i-1);
    end; {-}
  socket.SendText('KLAVESA '+inttostr(poradi)+' '+klavesa.caption);
  end; {=}
end; {of procedure}

procedure TForm1.ServerSocket7Listen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
clientsocket1.host:=serversocket7.Socket.LocalHost;
clientsocket1.active:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
randomize;
poradi:=0;
Image1.Picture.Bitmap.Canvas.pen.Color:=clblack;
image1.Picture.Bitmap.Canvas.Rectangle
                              (0,0,image1.Picture.Bitmap.Width-1,image1.Picture.Bitmap.height-1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:byte;
begin
Timer1.tag:=Timer1.tag-1;
for i:=0 to ServerSocket7.socket.activeConnections-1 do
  if Timer1.tag=0 then begin serversocket7.socket.Connections[i].SendText('HRA ZACINA');
                             Timer1.enabled:=false
                             end
                  else serversocket7.socket.Connections[i].SendText('HRA ZACNE...'+inttostr(Timer1.tag));
if Timer1.tag=0 then begin
  {Musime stanovit startovaci pozice vsech cervu:}
  for i:=0 to ServerSocket7.socket.activeConnections-1 do begin
    cer[i].x:=300+round(100*cos(i*2*pi/SpinEdit1.value));
    cer[i].y:=300+round(100*sin(i*2*pi/SpinEdit1.value));
    cer[i].smer:=pi + i*2*pi/SpinEdit1.value;
    cer[i].rychlost:=1;
    end;
  Timer2.enabled:=true;
  Timer3.enabled:=true;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
klavesa.Caption:=inttostr(key);
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
klavesa.Caption:='0';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
image1.picture.bitmap.canvas.pixels[10,10]:=$00F0F000;
if image1.picture.bitmap.canvas.pixels[10,10] = $00F0F000 then
showmessage('Je to stejna barva.') else showmessage(inttostr(image1.picture.bitmap.canvas.pixels[10,10]));
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var i,k:byte;
    j:shortint;
    s:string;
    hrajicich_hracu:byte;
begin
s:='POZICE_VSECH ';
for i:=0 to ServerSocket7.socket.activeConnections-1 do
  s:=s+inttostr(round(cer[i].x))+' '+inttostr(round(cer[i].y))+' '+inttostr(round(cer[i].smer))+' ';

for i:=0 to ServerSocket7.socket.activeConnections-1 do
  serversocket7.Socket.Connections[i].SendText(s);  {Vsem posleme vsechny pozice}

{Nasleduji pohnuti vsech cervu:}
for i:=0 to ServerSocket7.socket.activeConnections-1 do begin
  if klavesy[i]='39' then cer[i].smer:=cer[i].smer+5/180*pi;
  if klavesy[i]='37' then cer[i].smer:=cer[i].smer-5/180*pi;
  cer[i].x:=cer[i].x+cos(cer[i].smer)*cer[i].rychlost;
  cer[i].y:=cer[i].y+sin(cer[i].smer)*cer[i].rychlost;
  {Testovani, jestli jsme do neceho nevrazili:}
  for j:=-5 to 5 do if Image1.Picture.Bitmap.Canvas.Pixels[
                             round(cer[i].x+5*cos(cer[i].smer+j/5*pi/8)),
                             round(cer[i].y+5*sin(cer[i].smer+j/5*pi/8))]<>clwhite
      then BEGIN cer[i].rychlost:=0;CER[I].SEKUND:=VYPOCTI_CAS  END;
  {Testovani, jestli dva cervi nebezi s hlavickami tesne vedle sebe:}
  for j:=0 to ServerSocket7.socket.activeConnections-1 do if j<>i then
    if sqrt((cer[i].x-cer[j].x)*(cer[i].x-cer[j].x) +
            (cer[i].y-cer[j].y)*(cer[i].y-cer[j].y))<5
      then BEGIN cer[i].rychlost:=0;CER[I].SEKUND:=VYPOCTI_CAS  END;

  end;
{Testujeme, kolik jich zbylo:}
hrajicich_hracu:=0;
for k:=0 to ServerSocket7.socket.activeConnections-1 do
  if cer[k].rychlost>0 then hrajicich_hracu:=hrajicich_hracu+1;
if hrajicich_hracu<2 then begin
  for k:=0 to ServerSocket7.socket.activeConnections-1 do BEGIN
    IF CER[K].RYCHLOST>0 THEN CER[K].SEKUND:=VYPOCTI_CAS;
    Memo3.lines.add(inttostr(k)+'. cerv ... '+inttostr(trunc(cer[k].sekund/60))+' m'
                    +inttostr(trunc(cer[k].sekund) mod 60));
    END;
  Memo3.visible:=true;
  Timer2.enabled:=false;
  end;
{Na konci vsechny klavesy vynulujeme:}
for i:=0 to ServerSocket7.socket.activeConnections-1 do klavesy[i]:='0';

end;

procedure TForm1.Timer3Timer(Sender: TObject);
var xx,yy:word;
    i:byte;
begin
if not(Checkbox1.checked) then exit;
xx:=random(image1.width-50);
yy:=random(image1.height-50);
for i:=0 to ServerSocket7.socket.activeConnections-1 do
  ServerSocket7.socket.Connections[i].sendtext('DIRA '+inttostr(xx)+' '+inttostr(yy)+'/');
end;

end.

Příklad 3.17. Brouci

dodat dokumentaci

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Panel2: TPanel;
    Image2: TImage;
    Panel3: TPanel;
    Image3: TImage;
    Panel4: TPanel;
    Image4: TImage;
    Button1: TButton;
    Timer1: TTimer;
    Memo1: TMemo;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    Image1: TImage;
    TrackBar1: TTrackBar;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const pocet_brouku_konstanta=4;
      pocet_trav_konstanta=20;

var
  Form1: TForm1;
  pocet_trav:byte;
  pocet_brouku:byte;
  brouci: array[1..100] of record cislo_brouka:byte; {abychom je od sebe odlisili}
                                  x,y:integer;
                                  smer:string[2];
                                  krmeni:byte;   {kolik tech trav uz sezral}
                                  end;
  vysledne_skore: array[1..100] of byte;  {vysledne skore, podle cisel brouku.}
  travy: array[1..100] of record x,y:byte;  {kde trava lezi}
                                 panel:TPanel;   {odkaz na dynamicky vyrobeny panel}
                                 obrazek:TImage; {odkaz na dynamicky vyrobeny obrazek}
                                 end;
  poradi:byte;
implementation

{$R *.DFM}


procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
    x,y,smer:integer;
begin
poradi:=0;
pocet_trav:=pocet_trav_konstanta;
pocet_brouku:=pocet_brouku_konstanta;
randomize;
for i:=1 to pocet_trav do begin
  repeat
    x:=trunc(random(10));
    y:=trunc(random(10));
    until stringgrid1.Cells[x,y]='';
  stringgrid1.Cells[x,y]:='_';
  travy[i].panel:=TPanel.create(self);  {tohle vytvori novy sedy panel}
  travy[i].panel.width:=30;
  travy[i].panel.height:=30;
  travy[i].panel.parent:=Form1;  {posadi ten panylek do formulare}

  travy[i].obrazek:=TImage.create(self);  {tohle vytvori novy obrazek}
  travy[i].obrazek.width:=30;
  travy[i].obrazek.height:=30;
  travy[i].obrazek.parent:=travy[i].panel;  {posadi ten obrazek do pripaveneho panelu}
  travy[i].obrazek.Picture.LoadFromFile('.\tr.bmp');

  travy[i].x:=x;
  travy[i].y:=y;
  end;
{Trava hotova. Jeste brouci:}
for i:=1 to pocet_brouku do begin   {of cyklus}
  brouci[i].cislo_brouka:=i;  {to jsme ho pojmenovali}
  repeat
    x:=trunc(random(10));
    y:=trunc(random(10));
    until stringgrid1.Cells[x,y]='';
  smer:=trunc(random(4));
  {Vygenerovano, zapiseme je do pole:}
  if smer=1 then brouci[i].smer:='BL';
  if smer=2 then brouci[i].smer:='BD';
  if smer=3 then brouci[i].smer:='BP';
  if smer=0 then brouci[i].smer:='BN';
  brouci[i].x:=x;
  brouci[i].y:=y;
  brouci[i].krmeni:=0;
  {A jeste brouka zapiseme do stringgridu:}
  stringgrid1.cells[x,y]:=brouci[i].smer;
  end;    {of cyklus}
  Button1.click;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:byte;
begin
  Panel1.left:=31*brouci[1].x + stringgrid1.left +2;
  Panel1.top:=31*brouci[1].y + stringgrid1.top +2;
  Image1.Picture.LoadFromFile('.\'+ brouci[1].smer +inttostr(brouci[1].cislo_brouka)+'.bmp');
  Panel2.left:=31*brouci[2].x + stringgrid1.left +2;
  Panel2.top:=31*brouci[2].y + stringgrid1.top +2;
  Image2.Picture.LoadFromFile('.\'+ brouci[2].smer +inttostr(brouci[2].cislo_brouka)+'.bmp');
  Panel3.left:=31*brouci[3].x + stringgrid1.left +2;
  Panel3.top:=31*brouci[3].y + stringgrid1.top +2;
  Image3.Picture.LoadFromFile('.\'+ brouci[3].smer +inttostr(brouci[3].cislo_brouka)+'.bmp');
  Panel4.left:=31*brouci[4].x + stringgrid1.left +2;
  Panel4.top:=31*brouci[4].y + stringgrid1.top +2;
  Image4.Picture.LoadFromFile('.\'+ brouci[4].smer +inttostr(brouci[4].cislo_brouka)+'.bmp');
  for i:=1 to pocet_trav do begin travy[i].panel.Left:=2+31*travy[i].x +stringgrid1.left;
                                  travy[i].panel.Top :=2+31*travy[i].y +stringgrid1.Top;
                                  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,nahoda:byte;
  function vidim(param:byte) : string;
  var kamkouka_x,kamkouka_y,ii:byte;   {policko, na ktere ten brouk prave civi}
  begin
    if brouci[param].smer='BL' then begin kamkouka_x:=brouci[param].x-1;
                                          kamkouka_y:=brouci[param].y;
                                          end;
    if brouci[param].smer='BP' then begin kamkouka_x:=brouci[param].x+1;
                                          kamkouka_y:=brouci[param].y;
                                          end;
    if brouci[param].smer='BN' then begin kamkouka_x:=brouci[param].x;
                                          kamkouka_y:=brouci[param].y-1;
                                          end;
    if brouci[param].smer='BD' then begin kamkouka_x:=brouci[param].x;
                                          kamkouka_y:=brouci[param].y+1;
                                          end;
    if (kamkouka_x=0) or (kamkouka_y=0) or (kamkouka_x>stringgrid1.ColCount)
       or (kamkouka_y>stringgrid1.RowCount) then  {kouka mimo ctverec}
                                                 begin vidim:='nic'; exit end;
    vidim:='nic';
    for ii:=1 to pocet_brouku do if (brouci[ii].x =kamkouka_x)and (brouci[ii].y=kamkouka_y)
                                             then vidim:='brouk';
    for ii:=1 to pocet_trav do if (travy[ii].x =kamkouka_x)and (travy[ii].y=kamkouka_y)
                                             then vidim:='trava';
    end;  {of function Vidim}

begin
for i:=1 to pocet_brouku do begin
  if brouci[i].cislo_brouka = 1 then spinedit1.Value:=brouci[i].krmeni;
  if brouci[i].cislo_brouka = 2 then spinedit2.Value:=brouci[i].krmeni;
  if brouci[i].cislo_brouka = 3 then spinedit3.Value:=brouci[i].krmeni;
  if brouci[i].cislo_brouka = 4 then spinedit4.Value:=brouci[i].krmeni;
  end;
  
poradi:=poradi+1;
if poradi>pocet_brouku then poradi:=1;

IF brouci[PORADI].cislo_brouka < 3 THEN BEGIN  {--------------------------------------------}
nahoda:=1+trunc(random(3*PORADI));    {bud 3 nebo 6, podle toho, jestli je to 1. nebo 2. brouk}
if nahoda=1 then begin   {otoci se doleva}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BP' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BL';
  end;
if nahoda=2 then begin   {otoci se doprava}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BL' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BP';
  end;
if nahoda>2 then begin    {popoleze o 1 dilek}
  if brouci[poradi].smer='BL' then brouci[poradi].x:=brouci[poradi].x-1;
  if brouci[poradi].smer='BP' then brouci[poradi].x:=brouci[poradi].x+1;
  if brouci[poradi].smer='BD' then brouci[poradi].y:=brouci[poradi].y+1;
  if brouci[poradi].smer='BN' then brouci[poradi].y:=brouci[poradi].y-1;
  end;
                   END; {--------------------------------------------}

IF brouci[PORADI].cislo_brouka = 3 then begin
  if vidim(poradi)='brouk' then begin    {popoleze o 1 dilek}
  if brouci[poradi].smer='BL' then brouci[poradi].x:=brouci[poradi].x-1;
  if brouci[poradi].smer='BP' then brouci[poradi].x:=brouci[poradi].x+1;
  if brouci[poradi].smer='BD' then brouci[poradi].y:=brouci[poradi].y+1;
  if brouci[poradi].smer='BN' then brouci[poradi].y:=brouci[poradi].y-1;
  end;
  if vidim(poradi)='trava' then begin   {otoci se doleva}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BP' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BL';
  end;
  if vidim(poradi)='nic' then begin   {otoci se doprava}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BL' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BP';
  end;
                   END; {--------------------------------------------}

IF brouci[PORADI].cislo_brouka = 4 then begin
  if vidim(poradi)<>'nic' then begin    {popoleze o 1 dilek}
  if brouci[poradi].smer='BL' then brouci[poradi].x:=brouci[poradi].x-1;
  if brouci[poradi].smer='BP' then brouci[poradi].x:=brouci[poradi].x+1;
  if brouci[poradi].smer='BD' then brouci[poradi].y:=brouci[poradi].y+1;
  if brouci[poradi].smer='BN' then brouci[poradi].y:=brouci[poradi].y-1;
  end
                          else begin    {podle nahody}
  nahoda:=1+trunc(random(4));    {bud 3 nebo 6, podle toho, jestli je to 1. nebo 2. brouk}
if nahoda=1 then begin   {otoci se doleva}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BP' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BL';
  end;
if nahoda=2 then begin   {otoci se doprava}
  if brouci[poradi].smer='BL' then brouci[poradi].smer:='BN' else
  if brouci[poradi].smer='BD' then brouci[poradi].smer:='BL' else
  if brouci[poradi].smer='BP' then brouci[poradi].smer:='BD' else
  if brouci[poradi].smer='BN' then brouci[poradi].smer:='BP';
  end;
if nahoda>2 then begin    {popoleze o 1 dilek}
  if brouci[poradi].smer='BL' then brouci[poradi].x:=brouci[poradi].x-1;
  if brouci[poradi].smer='BP' then brouci[poradi].x:=brouci[poradi].x+1;
  if brouci[poradi].smer='BD' then brouci[poradi].y:=brouci[poradi].y+1;
  if brouci[poradi].smer='BN' then brouci[poradi].y:=brouci[poradi].y-1;
  end;
end; {of podle nahody}
                   END; {--------------------------------------------}

if brouci[poradi].x>stringgrid1.ColCount-1 then brouci[poradi].x:=stringgrid1.ColCount-1;
if brouci[poradi].y>stringgrid1.RowCount-1 then brouci[poradi].y:=stringgrid1.RowCount-1;
if brouci[poradi].x<0 then brouci[poradi].x:=0;
if brouci[poradi].y<0 then brouci[poradi].y:=0;

{Tady budeme zkoumat, jestli brouk neco nesezere:}

for i:=1 to pocet_trav do
  if (brouci[poradi].x = travy[i].x) and (brouci[poradi].y = travy[i].y) then begin
    {Nasli jsme travu se stejnymi souradnicemi, jako aktualni brouk, takze:}
    { - znicime komponenty travy:}
    travy[i].obrazek.free;
    travy[i].panel.free;
    { - znicime policko s travou:}
    travy[i]:=travy[pocet_trav];
    pocet_trav:=pocet_trav-1;
    { - nasytime brouka:}
    brouci[poradi].krmeni:=brouci[poradi].krmeni+1;
    end;

for i:=1 to pocet_brouku do if i<>poradi then {aby nesezral sam sebe}
  if (brouci[poradi].x = brouci[i].x) and (brouci[poradi].y = brouci[i].y) then begin
    {Brouk na i-tem miste bude sezran:}

    if pocet_brouku = 4 then Panel4.visible:=false;
    if pocet_brouku = 3 then Panel3.visible:=false;
    if pocet_brouku = 2 then Panel2.visible:=false;

    brouci[poradi].krmeni:=brouci[poradi].krmeni+3;  {bonus za sezrani}

    vysledne_skore[ (brouci[i].cislo_brouka) ]:=brouci[i].krmeni;
                    {--------------------- tohle zarucuje, ze budou serazeni podle cisel}
    brouci[i]:=brouci[pocet_brouku];
    pocet_brouku:=pocet_brouku-1;
    end;

if (pocet_brouku=1) and (pocet_trav=0) then begin {zustal posledni brouk a zadna trava}
  {nechame umrit i posledniho brouka, aby byl ve vyslednem skore:}
  vysledne_skore[ (brouci[1].cislo_brouka) ]:=brouci[1].krmeni+5;
  {zviditelnime vysledky:}
  label1.visible:=true;
  Memo1.show;
  Button2.show;
  Button3.show;
  for i:=1 to pocet_brouku_konstanta do Memo1.lines.add(inttostr(i)+'.brouk... '+inttostr(brouci[i].krmeni));
  timer1.Enabled:=false;

  end;

Button1.click;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
form1.close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:byte;
begin
  label1.hide;
  Memo1.hide;
  Button2.hide;
  Button3.hide;
  for i:=1 to stringgrid1.ColCount do for j:=1 to stringgrid1.RowCount do
    stringgrid1.Cells[i,j]:='';
  for i:=1 to pocet_brouku_konstanta do vysledne_skore[i]:=0;
  timer1.enabled:=true;
  pocet_trav:=pocet_trav_konstanta;
  pocet_brouku:=pocet_brouku_konstanta;
  Panel2.visible:=true;
  Panel3.visible:=true;
  Panel4.visible:=true;
  form1.FormCreate(self);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
timer1.Interval:=trackbar1.Position;
end;

end.

Příklad 3.18. Venovy diagramy

dopsta dokumentaci

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    RichEdit1: TRichEdit;
    Button6: TButton;
    Button7: TButton;
    Button9: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const polomer = 75;
      k_U = 'u';
      k_n = 'n';

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin

stringgrid1.cells[0,0]:='A';
 stringgrid1.cells[1,0]:='100';
 stringgrid1.cells[2,0]:='100';
 stringgrid1.cells[3,0]:='$FF0000';
 stringgrid1.cells[4,0]:='ANO';
stringgrid1.cells[0,1]:='B';
 stringgrid1.cells[1,1]:='100';
 stringgrid1.cells[2,1]:='200';
 stringgrid1.cells[3,1]:='$FF00FF';
 stringgrid1.cells[4,1]:='NE';
stringgrid1.cells[0,2]:='C';
 stringgrid1.cells[1,2]:='200';
 stringgrid1.cells[2,2]:='200';
 stringgrid1.cells[3,2]:='$0000FF';
 stringgrid1.cells[4,2]:='NIC';
stringgrid1.cells[0,3]:='D';
 stringgrid1.cells[1,3]:='150';
 stringgrid1.cells[2,3]:='120';
 stringgrid1.cells[3,3]:='$FFFF00';
 stringgrid1.cells[4,3]:='NIC';

end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
 image1.picture.bitmap.canvas.brush.color:=clwhite;
 image1.picture.bitmap.canvas.brush.style:=bsSolid;
 image1.picture.bitmap.canvas.pen.color:= 0;
 image1.picture.Bitmap.canvas.rectangle(0,0,image1.width-1,height-1);
 image1.picture.bitmap.canvas.pen.color:= clblack;
for i:=0 to stringgrid1.rowcount-1 do begin
  image1.picture.Bitmap.canvas.pen.color:=strtoint(stringgrid1.cells[3,i]);
  image1.picture.bitmap.canvas.brush.style:=bsclear;
  image1.picture.bitmap.canvas.Ellipse(
        strtoint(stringgrid1.cells[1,i])-polomer
        ,strtoint(stringgrid1.cells[2,i])-polomer
        ,strtoint(stringgrid1.cells[1,i])+polomer
        ,strtoint(stringgrid1.cells[2,i])+polomer);

  image1.picture.bitmap.canvas.brush.color:=strtoint(stringgrid1.cells[3,i]);
   case (i mod 4) of
    0:image1.picture.Bitmap.Canvas.Brush.style:=bsbdiagonal;
    1:image1.picture.Bitmap.Canvas.Brush.style:=bsfdiagonal;
    2:image1.picture.Bitmap.Canvas.Brush.style:=bshorizontal;
    3:image1.picture.Bitmap.Canvas.Brush.style:=bsvertical;
          end;

  image1.picture.bitmap.canvas.floodfill(
        strtoint(stringgrid1.cells[1,i]),
         strtoint(stringgrid1.cells[2,i]),
         strtoint(stringgrid1.cells[3,i]),
         fsborder);


  image1.Picture.bitmap.canvas.font.color:=strtoint(stringgrid1.cells[3,i]);
  image1.Picture.bitmap.canvas.font.size:=20;
  image1.Picture.bitmap.canvas.font.name:='arial';
 image1.Picture.bitmap.canvas.textout(
         strtoint(stringgrid1.cells[1,i])-trunc(polomer*sqrt(2)/2) - image1.Picture.bitmap.canvas.textextent(stringgrid1.cells[0,i]).cx,
         strtoint(stringgrid1.cells[2,i])-trunc(polomer*sqrt(2)/2) - image1.Picture.bitmap.canvas.textextent(stringgrid1.cells[0,i]).cy,
         stringgrid1.cells[0,i]);


end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 stringgrid1.rowcount:=stringgrid1.rowcount+1;
end;

procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
if not (checkbox1.checked) then begin
  spinedit1.value:=x;
  spinedit2.value:=y;
  checkbox1.checked:=true;
 end;
end;

procedure TForm1.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
var o_kolik_x,o_kolik_y:integer;
        i:byte;
begin
 o_kolik_x:=x - spinedit1.value;
  o_kolik_y:=y - spinedit2.value;

 for i:=0 to stringgrid1.RowCount -1 do
 if sqrt(sqr(strtoint(stringgrid1.cells[1,i])- spinedit1.value) +
         sqr(strtoint(stringgrid1.cells[2,i])- spinedit2.value)) < polomer
   then begin
      stringgrid1.cells[1,i]:=inttostr(strtoint(stringgrid1.cells[1,i]) + o_kolik_x);
      stringgrid1.cells[2,i]:=inttostr(strtoint(stringgrid1.cells[2,i]) + o_kolik_y);
   end;
checkbox1.checked:=false;
   button1.click;
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,j,rada:integer;
 vkolika:byte;
 maxx,maxy,minx,miny:integer;
begin
 maxx:=0;
 maxy:=0;
 minx:=image1.width;
 miny:=image1.height;
 for rada:=0 to  stringgrid1.rowcount-1 do begin
 if strtoint(stringgrid1.cells[1,rada]) < minx then
        minx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) < miny then
        miny:=strtoint(stringgrid1.cells[2,rada]);
 if strtoint(stringgrid1.cells[1,rada]) > maxx then
        maxx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) > maxy then
        maxy:=strtoint(stringgrid1.cells[2,rada]);
  end;
for I:=minx-polomer-1 to maxx+polomer+1 do
  for J:=miny-polomer-1 to maxy+polomer+1 do begin
  vkolika:=0;
   for rada:=0 to stringgrid1.rowcount - 1 do
    if sqrt(
         sqr(strtoint(stringgrid1.cells[1,rada])- i)+
         sqr(strtoint(stringgrid1.cells[2,rada])- j)) <= polomer
    then
     vkolika:=vkolika + 1;
  if vkolika = stringgrid1.rowcount then
  image1.Picture.Bitmap.canvas.pixels[i,j]:=clred;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var i,j,rada:integer;
 vkolika:byte;
 maxx,maxy,minx,miny:integer;
begin

 maxx:=0;
 maxy:=0;
 minx:=image1.width;
 miny:=image1.height;
 for rada:=0 to  stringgrid1.rowcount-1 do begin
 if strtoint(stringgrid1.cells[1,rada]) < minx then
        minx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) < miny then
        miny:=strtoint(stringgrid1.cells[2,rada]);
 if strtoint(stringgrid1.cells[1,rada]) > maxx then
        maxx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) > maxy then
        maxy:=strtoint(stringgrid1.cells[2,rada]);
  end;
for I:=minx-polomer-1 to maxx+polomer+1 do
  for J:=miny-polomer-1 to maxy+polomer+1 do begin
  vkolika:=0;
   for rada:=0 to stringgrid1.rowcount - 1 do
    if sqrt(sqr(strtoint(stringgrid1.cells[1,rada])- i)  +
         sqr(strtoint(stringgrid1.cells[2,rada])- j)) <= polomer
    then
     vkolika:=vkolika + 1;
  if vkolika >0 then
  image1.Picture.Bitmap.canvas.pixels[i,j]:=clred;
end;
 end;
procedure TForm1.Button5Click(Sender: TObject);
var splnuje:boolean;
rada,i,j:integer;
begin
for i:=0 to image1.width-1 do
 for j:=0 to image1.height-1 do begin
  splnuje:=true;
  for rada:=0 to stringgrid1.rowcount-1 do begin
   if stringgrid1.cells[4,rada]='ANO' then
    if sqrt(sqr(strtoint(stringgrid1.cells[1,rada])- i)  +
            sqr(strtoint(stringgrid1.cells[2,rada])- j)) > polomer
    then
    splnuje:=false;
    if stringgrid1.cells[4,rada]='NE' then
    if sqrt(sqr(strtoint(stringgrid1.cells[1,rada])- i)  +
            sqr(strtoint(stringgrid1.cells[2,rada])- j)) <= polomer
    then
    splnuje:=false;

  end;
  if splnuje then
  image1.Picture.Bitmap.canvas.pixels[i,j]:=clred;
 end;


end;

procedure TForm1.Button6Click(Sender: TObject);
 var pozice:integer;
     t:string;
begin
pozice:=richedit1.CaretPos.x;
t:=richedit1.text;
richedit1.text:=copy(t,1,pozice)+k_n+copy(t,pozice+1,1000);
richedit1.SelStart:=pozice+1;
richedit1.setfocus;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
var i:integer;
begin
{richedit1.selstart:=0;
richedit1.sellength:=length(richedit1.text);
    richedit1.SelAttributes.name:='arial';

 for i:=1 to length(richedit1.text) do
   if (richedit1.text[i]=k_U) or (richedit1.text[i]=k_n)then begin
    richedit1.selstart:=i-1;
    richedit1.sellength:=1;
    richedit1.SelAttributes.name:='symbol'

    end;
 richedit1.sellength:=0;}
end;

procedure TForm1.Button7Click(Sender: TObject);
var pozice:integer;
    t:string;
begin
pozice:=richedit1.CaretPos.x;
t:=richedit1.text;
richedit1.text:=copy(t,1,pozice)+k_U+copy(t,pozice+1,1000);
richedit1.SelStart:=pozice+1;
richedit1.setfocus;
end;

procedure TForm1.Button9Click(Sender: TObject);
var i,j:integer;
    maxx,maxy,minx,miny:integer;
    rada:integer;
{-----------}
function min(x,y:integer):integer;
begin
if x<y then min:=x else min:=y;
end;
{-----------}
function patri(kam:string;x,y:integer):boolean;
var r:byte;
    pozice:integer;
    z:byte;    {pocet otevrenych zavorek}
    i:byte;    {pocitadlo, kde ve vyraze stojime}
begin
patri:=false;
{SHOWMESSAGE(KAM);}
{Nejjednodussi varianta, kdy nejsou ani () ani pruniky, sjednoceni:}
if (pos('(',kam)=0) and (pos(k_n,kam)=0) and (pos(k_U,kam)=0) then begin {=-=}
  for r:=0 to stringgrid1.rowcount-1 do
    if kam=stringgrid1.cells[0,r] then  if sqrt(
                                        SQR(strtoint(stringgrid1.cells[1,r])-x) +
                                        SQR(strtoint(stringgrid1.cells[2,r])-y)) <= polomer
                                        then patri:=true;
  exit
  end; {=-=}
{Malicko slozitejsi varianta, kdy nejsou (), ale je prunik nebo sjednoceni:}
if (pos('(',kam)=0) and ((pos(k_n,kam)>0) or (pos(k_U,kam)>0)) then begin {=-=}
  if pos(k_n,kam)=0 then pozice:=pos(k_U,kam)
                     else if pos(k_U,kam)=0 then pozice:=pos(k_n,kam)
                                             else pozice:=min(pos(k_n,kam),pos(k_U,kam));
  {Po tehle podmince bude v POZICE pozice, kde je prvni sjednotitko nebo prunik}
  if kam[pozice]=k_n then {prunik} patri:=patri(copy(kam,1,pozice-1),x,y) and patri(copy(kam,pozice+1,1000),x,y);
  if kam[pozice]=k_U then {sjedn.} patri:=patri(copy(kam,1,pozice-1),x,y) or  patri(copy(kam,pozice+1,1000),x,y);
  exit
  end; {=-=}
{Jeste slozitejsi varianta, kdy jsou () ohranicujici levy vyraz}
if (pos('(',kam)>0) then
  if not ((pos(k_n,kam)>0) and (pos('(',kam)>pos(k_n,kam))) then
  if not ((pos(k_u,kam)>0) and (pos('(',kam)>pos(k_u,kam))) then begin {=-=}
    if pos('(',kam)>1 then begin showmessage('Nesmyslny vyraz, necekana zavorka.');halt;end;
    z:=1;
    i:=2;
    while (z>0)and(i<=length(kam)) do begin if kam[i]=')' then z:=z-1;
                                            if kam[i]='(' then z:=z+1;
                                            i:=i+1
                                            end;
    i:=i-1;
    if z>0 then begin showmessage('Maly pocet pravych zavorek.');halt;end;
    {Za zavorkou muze byt: nic, prunik, sjednoceni}
    if i=length(kam) then begin patri:=patri(copy(kam,2,length(kam)-2),x,y);exit end; {jen jsme oddelali zavorky}
    if kam[i+1]=k_n then patri:=patri(copy(kam,2,i-2),x,y) and patri(copy(kam,i+2,1000),x,y);
    if kam[i+1]=k_u then patri:=patri(copy(kam,2,i-2),x,y) or  patri(copy(kam,i+2,1000),x,y);
    end; {=-=}
{A posledni varianta, kdy () ohranicuji pravy vyraz:}
if (pos('(',kam)>0) then
  if not ((pos(k_n,kam)>0) and (pos('(',kam)<pos(k_n,kam))) OR
     not ((pos(k_u,kam)>0) and (pos('(',kam)<pos(k_u,kam))) then begin {=-=}
    i:=1;
    while (kam[i]<>k_n) and (kam[i]<>k_u) and (i<=length(kam)) do i:=i+1;
    if i>length(kam) then begin showmessage('Chybi znacka pruniku nebo sjednoceni!');halt end;
    if kam[i]=k_n then patri:=patri(copy(kam,1,i-1),x,y) and patri(copy(kam,i+1,1000),x,y);
    if kam[i]=k_u then patri:=patri(copy(kam,1,i-1),x,y) or  patri(copy(kam,i+1,1000),x,y);
    end {=-=}
end; {of function}
{-----------}
begin
 maxx:=0;
 maxy:=0;
 minx:=image1.width;
 miny:=image1.height;
 for rada:=0 to  stringgrid1.rowcount-1 do begin
 if strtoint(stringgrid1.cells[1,rada]) < minx then
        minx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) < miny then
        miny:=strtoint(stringgrid1.cells[2,rada]);
 if strtoint(stringgrid1.cells[1,rada]) > maxx then
        maxx:=strtoint(stringgrid1.cells[1,rada]);
 if strtoint(stringgrid1.cells[2,rada]) > maxy then
        maxy:=strtoint(stringgrid1.cells[2,rada]);
  end;
for I:=minx-polomer-1 to maxx+polomer+1 do
  for J:=miny-polomer-1 to maxy+polomer+1 do
     if patri(richedit1.text,i,j) then image1.Picture.Bitmap.Canvas.Pixels[i,j]:=clRed;
end;

end.

Příklad 3.19. Paintball

dopsat dokumentaci

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Timer1: TTimer;
    konec: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  uhel,leva,horni: real;
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
with image1.canvas do begin
Brush.color:=$00FE7350;
FloodFill(10,10,0,fsborder);

Pen.color:=$004040FF;
Brush.color:=$004040FF;
rectangle(300,300,350,350);

Pen.color:=clblack;
MoveTo(50,300);
lineto(280,250);
end;
{Kolecko:}
image2.Transparent:=true;
image2.picture.bitmap.TransparentColor:=clwhite;
//leva:=image1.left+70;
//horni:=image1.top+50;
//uhel:=3/2*pi;
leva:=200;
horni:=320;
uhel:=pi;
image2.left:=round(leva);
image2.top:=round(horni);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,j:integer;
    rleft,rtop:integer;
    s,p,uhel:real;
begin
Timer1.enabled:=false;
while not(konec.checked) do begin
  image2.left:=round(leva);
  image2.top:=round(horni);
  leva:=leva-1;
  sleep(1);
  timer1.interval:=timer1.interval-1;
  if timer1.interval=0 then timer1.interval:=1;
  application.ProcessMessages;
  rleft:=image2.left-image1.left+4;
  rtop:=image2.top-image1.top+4;
  for i:=rleft-5 to rleft+5 do
    for j:=rtop-5 to rtop+5 do
      if image1.Canvas.Pixels[i,j]=clblack then
        konec.checked:=true;
  p:=0;
  if konec.checked then begin {odraz:}
  for i:=rleft-10 to rleft+10 do
    for j:=rtop-10 to rtop+10 do
      if i*i+j*j>=25 then
        if image1.Canvas.Pixels[i,j]=clblack then
          begin image1.Canvas.Pixels[i,j]:=clred;
                p:=p+1;
                uhel:=arccos((i-rleft)/sqrt((rleft-i)*(rleft-i)+(rtop-j)*(rtop-j)));
                if rtop-j<0 then uhel:=2*pi-uhel;
                s:=s+uhel;
                showmessage(floattostr(uhel/2/pi*360));
                end;
  end;
  end;
end;

end.