unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Shape15: TShape;
    Shape16: TShape;
    Shape17: TShape;
    Shape18: TShape;
    Shape19: TShape;
    Shape20: TShape;
    Edit1: TEdit;
    Shape21: TShape;
    Shape22: TShape;
    Shape23: TShape;
    Shape24: TShape;
    Shape25: TShape;
    Shape26: TShape;
    Shape27: TShape;
    Shape28: TShape;
    Shape29: TShape;
    Shape30: TShape;
    Shape31: TShape;
    Shape32: TShape;
    Shape33: TShape;
    Shape34: TShape;
    Shape35: TShape;
    Shape36: TShape;
    Shape37: TShape;
    Shape38: TShape;
    Shape39: TShape;
    Shape40: TShape;
    Shape41: TShape;
    Shape42: TShape;
    Shape43: TShape;
    Shape44: TShape;
    Shape45: TShape;
    Shape46: TShape;
    Button2: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Shape49: TShape;
    MainMenu1: TMainMenu;
    hra1: TMenuItem;
    st1: TMenuItem;
    koniec1: TMenuItem;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure klikni(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure stisni(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure urob(x2:integer;f:TShape;p:boolean);
    procedure sprav(g:TShape;f:Tshape);
    procedure koniec1Click(Sender: TObject);
    procedure st1Click(Sender: TObject);
    procedure ukaz;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 prvok=record
   x,y,z,v:integer;
  end;
var
  Form1: TForm1;
  x1,x2,y1,z,a1,b1,n:integer;
  f:Tshape;
  c: array [1..4] of integer;
  d: array [1..10] of prvok;
  p,q:boolean;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 halt;
end;

procedure TForm1.klikni(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   x1:=Tbutton(sender).tag;
   edit1.text:=inttostr(x1);
   a1:=0;
   if ((4*n)>=x1) and (4*(n-1)<x1) then  begin
                                          a1:=x1 mod 4;
                                          if a1=0 then a1:=4;
                                          edit2.text:=inttostr(a1);
                                          edit1.text:=inttostr(x1);
                                       end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  F:=SHAPE49;
  F.VISIBLE:=FALSE;
   ukaz;
end;

procedure TForm1.stisni(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 y1:=TButton(sender).tag;
 edit3.text:=inttostr(a1);
 if a1<>0 then begin
                if a1=1 then d[n].x:=y1-100;
                if a1=2 then d[n].y:=y1-100;
                if a1=3 then d[n].z:=y1-100;
                if a1=4 then d[n].v:=y1-100;

                if  shape41.tag=y1 then f.brush.color:=shape41.brush.color;
                if  shape42.tag=y1 then f.brush.color:=shape42.brush.color;
                if  shape43.tag=y1 then f.brush.color:=shape43.brush.color;
                if  shape44.tag=y1 then f.brush.color:=shape44.brush.color;
                if  shape45.tag=y1 then f.brush.color:=shape45.brush.color;
                if  shape46.tag=y1 then f.brush.color:=shape46.brush.color;

                urob(x1,f,q);
              end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var k,s1,s2,i,j:integer;
begin
 edit5.text:=inttostr(d[n].x);
 edit6.text:=inttostr(d[n].y);
 edit7.text:=inttostr(d[n].z);
 edit8.text:=inttostr(d[n].v);
 if (d[n].x<>d[n].y) and (d[n].x<>d[n].z) and  (d[n].x<>d[n].v) and (d[n].y<>d[n].z) and (d[n].y<>d[n].v) and (d[n].z<>d[n].v) and(d[n].x<>0) and (d[n].y<>0) and (d[n].z<>0) and (d[n].v<>0)and (n<6) then
 begin
  s1:=0;
  s2:=0;
  q:=false;
  for i:=1 to 4 do
  for j:=1 to 4 do
   begin
     if (i=1) and (d[n].x=c[j])and (i=j) then inc(s1);
     if (i=2) and (d[n].y=c[j])and (i=j) then inc(s1);
     if (i=3) and (d[n].z=c[j])and (i=j) then inc(s1);
     if (i=4) and (d[n].v=c[j])and (i=j) then inc(s1);
     if (i=1) and (d[n].x=c[j]) then inc(s2);
     if (i=2) and (d[n].y=c[j]) then inc(s2);
     if (i=3) and (d[n].z=c[j]) then inc(s2);
     if (i=4) and (d[n].v=c[j]) then inc(s2);
   end;
   edit9.text:=inttostr(s1);
   edit10.text:=inttostr(s2);
   s2:=s2-s1;
   if (s1=4) and (s2=0) then messagedlg('Gratulujem',mtInformation,[mbok],0 );
   k:=20+(n-1)*4+1;
   f.brush.color:=clblack;
   if s1<>0 then    repeat
                       urob(k,f,q);
                       inc(k);
                    dec(s1);
                    until (s1=0);
   f.brush.color:=clwhite;
   if s2<>0 then    repeat
                      urob(k,f,q);
                       inc(k);
                     dec(s2);
                    until (s2=0);
 n:=n+1;
 if n=6 then messagedlg('Skus to na buduce',mtInformation,[mbok],0 );
 q:=true;
 end
 else begin
       if (d[n].x=0) or (d[n].y=0) or (d[n].z=0) or (d[n].v=0)then messagedlg('Nezadali ste niektoru z farieb',mtInformation,[mbok],0 )
       else messagedlg('Farby sa nesmu opakovat',mtInformation,[mbok],0 );
      end;

end;
procedure TForm1.urob(x2:integer;f:Tshape;p:boolean);
begin
if  p then begin
 if  (shape1.tag=x2) then sprav(shape1,f);
 if  (shape2.tag=x2) then sprav(shape2,f);
 if  (shape3.tag=x2) then sprav(shape3,f);
 if  (shape4.tag=x2) then sprav(shape4,f);
 if  (shape5.tag=x2) then sprav(shape5,f);
 if  (shape6.tag=x2) then sprav(shape6,f);
 if  (shape7.tag=x2) then sprav(shape7,f);
 if  (shape8.tag=x2) then sprav(shape8,f);
 if  (shape9.tag=x2) then sprav(shape9,f);
 if  (shape10.tag=x2) then sprav(shape10,f);
 if  (shape11.tag=x2) then sprav(shape11,f);
 if  (shape12.tag=x2) then sprav(shape12,f);
 if  (shape13.tag=x2) then sprav(shape13,f);
 if  (shape14.tag=x2) then sprav(shape14,f);
 if  (shape15.tag=x2) then sprav(shape15,f);
 if  (shape16.tag=x2) then sprav(shape16,f);
 if  (shape17.tag=x2) then sprav(shape17,f);
 if  (shape18.tag=x2) then sprav(shape18,f);
 if  (shape19.tag=x2) then sprav(shape19,f);
 if  (shape20.tag=x2) then sprav(shape20,f);
  end;
if  not p then begin
 if  (shape21.tag=x2) then sprav(shape21,f);
 if  (shape22.tag=x2) then sprav(shape22,f);
 if  (shape23.tag=x2) then sprav(shape23,f);
 if  (shape24.tag=x2) then sprav(shape24,f);
 if  (shape25.tag=x2) then sprav(shape25,f);
 if  (shape26.tag=x2) then sprav(shape26,f);
 if  (shape27.tag=x2) then sprav(shape27,f);
 if  (shape28.tag=x2) then sprav(shape28,f);
 if  (shape29.tag=x2) then sprav(shape29,f);
 if  (shape30.tag=x2) then sprav(shape30,f);
 if  (shape31.tag=x2) then sprav(shape31,f);
 if  (shape32.tag=x2) then sprav(shape32,f);
 if  (shape33.tag=x2) then sprav(shape33,f);
 if  (shape34.tag=x2) then sprav(shape34,f);
 if  (shape35.tag=x2) then sprav(shape35,f);
 if  (shape36.tag=x2) then sprav(shape36,f);
 if  (shape37.tag=x2) then sprav(shape37,f);
 if  (shape38.tag=x2) then sprav(shape38,f);
 if  (shape39.tag=x2) then sprav(shape39,f);
 if  (shape40.tag=x2) then sprav(shape40,f);
   end;
 a1:=0;
 x1:=0;
end;

procedure TForm1.sprav(g:TShape;f:Tshape);
begin
 g.brush.color:=f.brush.color;
end;

procedure TForm1.koniec1Click(Sender: TObject);
begin
 halt;
end;

procedure TForm1.st1Click(Sender: TObject);
var i:integer;
begin
  ukaz;

end;
procedure TForm1.ukaz;
var i:integer;
begin
q:=true;
 n:=1;
  a1:=0;
  f.brush.color:=clScrollBar;
  for i:=1 to 40 do
  begin
   if i>20 then q:=false;
   urob(i,f,q);
  end;
  for i:=1 to 4 do
  c[i]:=0;
   randomize;
  c[1]:=random(6)+1;

  repeat
  i:=random(6)+1;
  until (c[1]<>i);
  c[2]:=i;

   repeat
  i:=random(6)+1;
  until (c[1]<>i) and (c[2]<>i);
  c[3]:=i;
   repeat
  i:=random(6)+1;
  until (c[1]<>i) and(c[2]<>i) and(c[3]<>i);
  c[4]:=i;
  q:=true;
  edit4.text:=inttostr(c[1])+' '+inttostr(c[2])+' '+inttostr(c[3])+' '+inttostr(c[4]);
end;
end.