unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg;
  const d=70; n=5;
type
  TForm1 = class(TForm)
    imback: TImage;
    game: TImage;
    Button1: TButton;
    Image1: TImage;
    RadioGroup2: TRadioGroup;
    Timer1: TTimer;
    Memo1: TMemo;
    procedure showmass;
    procedure initmass;
    procedure showback;
    procedure sbros;
    procedure Button1Click(Sender: TObject);
    procedure klubok(k:integer);
     procedure Puzzle(var PicSource:TBitMap;  left,top,right,bottom, up: integer );
    procedure imbackMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);

    procedure RadioGroup2Click(Sender: TObject);
    procedure gameClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    



  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  type TKletka=record nom:integer;//число клетки
                         pic: TBitMap; //фрагмент картинки
  end;
  TPole=array [1..n, 1..n] of TKletka;
  var Pole: TPole;
implementation

{$R *.dfm}

function winner:boolean;
var i, j: integer;
begin
result:=true;
for i:=1 to n-1 do
   for j:=1 to n-1 do
     if (pole[i,j].nom)<>((i-1)*(n-1)+j) then result:=false;

end;

procedure tform1.Sbros;
var  i, j: integer;
begin
 for i:=1 to n do
   for j:=1 to n do pole[i,j].nom:=0;

end;

procedure TForm1.Puzzle(var PicSource:TBitMap; left,top,right,bottom, up: integer );
var x,y,i,j: integer;
    MidColor, mc1,mc2,mc3, mc4: TColor;
    step: real;
    red, green, blue: integer;
begin
 
 for i:=0 to up-1 do
      for j:= top+i+1 to bottom-i do
            begin
              step:=i/up;
              x:=left+i;
              y:=j;
              MidColor:=PicSource.Canvas.Pixels[x,y];
              red:= round(step*GetRValue( MidColor));

              green:=round(step*GetGValue( MidColor));
              blue:= round(step*GetBValue( MidColor));
              PicSource.Canvas.Pixels[x,y]:= rgb(red, green, blue);
            end;

  for i:=0 to up-1 do
  begin
      for j:= left+i+1 to right-i do
            begin
              step:=i/up;
              y:=bottom-i;
              x:=j;
              MidColor:=PicSource.Canvas.Pixels[x,y];
              red:= round((step)*GetRValue( MidColor));

              green:= round(step*GetGValue( MidColor));
              blue:=  round(step*GetBValue( MidColor));
              PicSource.Canvas.Pixels[x,y]:= rgb(red, green, blue);

            end;
            ;
            end;

 for i:=0 to up-1 do
      for j:= left+i+1 to right-i do
            begin
             step:=(up-i)/up;
              y:=top+i;
              x:=j;

             MidColor:=PicSource.Canvas.Pixels[x,y];
              red:= round(GetRValue( MidColor)+step*(255-GetRValue( MidColor)));

              green:= round(GetGValue( MidColor)+step*(255-GetGValue( MidColor)));
              blue:=  round(GetBValue( MidColor)+step*(255-GetBValue( MidColor)));
              PicSource.Canvas.Pixels[x,y]:= rgb(red, green, blue);
            end;

 for i:=1 to up do
      for j:= top+i+1 to bottom-i-1 do
            begin
              y:=j;
              x:=right-i;
              step:=(up-i)/up;
              MidColor:=PicSource.Canvas.Pixels[x,y];
              red:= round(GetRValue( MidColor)+step*(255-GetRValue( MidColor)));

              green:= round(GetGValue( MidColor)+step*(255-GetGValue( MidColor)));
              blue:=  round(GetBValue( MidColor)+step*(255-GetBValue( MidColor)));
              PicSource.Canvas.Pixels[x,y]:= rgb(red, green, blue);

            end;

 for i:=1 to up do
  begin
    mc1:=PicSource.Canvas.Pixels[i,i];
    mc2:=PicSource.Canvas.Pixels[i+1,i];
    mc3:=PicSource.Canvas.Pixels[i,i+1];
    mc4:=PicSource.Canvas.Pixels[i,i];
    red:= (GetRValue( mc1)+ GetRValue( mc2) + GetRValue( mc3)  + GetRValue( mc4)) div 4;
    blue:= (GetBValue( mc1)+ GetBValue( mc2) + GetBValue( mc3)  + GetBValue( mc4)) div 4;

    green:= (GetGValue( mc1)+ GetGValue( mc2) + GetGValue( mc3)  + GetGValue( mc4)) div 4;
              PicSource.Canvas.Pixels[i,i]:= rgb(red, green, blue);
    end;

end;


procedure tform1.klubok(k:integer);
var i1, j1, i2, j2, t:integer; x:tkletka;
begin
randomize;
for t:=1 to k do
begin
i1:=random(4)+1;
j1:=random(4)+1;
i2:=random(4)+1;
j2:=random(4)+1;
x:=pole[i1,j1];
pole[i1,j1]:=pole[i2,j2];
pole[i2,j2]:=x;
end;

end;


procedure tform1.InitMass;
var  i, j: integer; pic:TBitMap;  r5,r4,rectpic, rectish:trect;

begin

rectpic:=bounds(0,0,d,d);
r4:=bounds(0,0,d*4,d*4);
pic:=TBitMap.Create;
pic.Width:=d*4;
pic.Height:=d*4;
//pic.stretch:=true;

//game.Canvas.CopyRect(r4,pic.Canvas);

if RadioGroup2.ItemIndex=0 then pic.LoadFromFile('шляпник.bmp')
else if RadioGroup2.ItemIndex=1 then pic.LoadFromFile('королева.bmp')
else if RadioGroup2.ItemIndex=2 then pic.LoadFromFile('белая королева.bmp')
else if RadioGroup2.ItemIndex=3 then pic.LoadFromFile('Алиса.bmp')
else if RadioGroup2.ItemIndex=4 then pic.LoadFromFile('чешир.bmp')
else if RadioGroup2.ItemIndex=5 then pic.LoadFromFile('кролик.bmp');

r5:=bounds(0,0,pic.Width,pic.Height);
game.Width:=d*5;
game.Height:=d*5;
game.Canvas.Rectangle(0,0,d*5,d*5);
game.Canvas.CopyRect(r4,pic.Canvas,r5);
for i:=1 to n do
   for j:=1 to n do
   begin
   rectish:=bounds((j-1)*d, (i-1)*d, d, d);
    pole[i,j].pic:=TBitMap.Create;
    pole[i,j].pic.Width:=d;
    pole[i,j].pic.Height:=d;
    pole[i,j].pic.Canvas.CopyRect(rectpic, game.canvas, rectish);
    Puzzle(pole[i,j].pic, 0,0,d,d,4);

    if  (i=n) or (j=n) then pole[i,j].nom:=0 else  pole[i,j].nom:=(i-1)*(n-1)+j;


   end;
  klubok(16);
end;



procedure tform1.ShowBack;
var  i, j: integer; x1,  y1: integer;
picdown, picup, picleft, picright :tbitmap;
piccherv, picpiki, picbub, pickrest:tbitmap;
begin

x1:=1; y1:=1;
piccherv:=tbitmap.Create;
piccherv.LoadFromFile('червы.bmp');
imback.Canvas.Draw(x1, y1, piccherv);

x1:=1; y1:=d*(n+1);
pickrest:=tbitmap.Create;
pickrest.LoadFromFile('крест.bmp');
imback.Canvas.Draw(x1, y1, pickrest);

x1:=d*(n+1); y1:=1;
picpiki:=tbitmap.Create;
picpiki.LoadFromFile('пик.bmp');
imback.Canvas.Draw(x1, y1, picpiki);

x1:=d*(n+1); y1:=d*(n+1);;
picbub:=tbitmap.Create;
picbub.LoadFromFile('буб.bmp');
imback.Canvas.Draw(x1, y1, picbub);

picdown:=tbitmap.Create;
picup:= tbitmap.Create;
picleft:=tbitmap.Create;
picright:=tbitmap.Create;
picdown.LoadFromFile('вниз.bmp');
picup.LoadFromFile('вверх.bmp');
picright.LoadFromFile('вправо.bmp');
picleft.LoadFromFile('влево.bmp');

if RadioGroup2.ItemIndex=0 then
begin
image1.Picture.LoadFromFile('шляпник.bmp');
Memo1.Lines.LoadFromFile('шляпник.txt');
end
else if RadioGroup2.ItemIndex=1 then
begin
image1.Picture.LoadFromFile('королева.bmp');
Memo1.Lines.LoadFromFile('королева.txt');
end
else if RadioGroup2.ItemIndex=2 then
begin
image1.Picture.LoadFromFile('белая королева.bmp');
Memo1.Lines.LoadFromFile('белая королева.txt');
end
else if RadioGroup2.ItemIndex=3 then
begin
image1.Picture.LoadFromFile('Алиса.bmp');
Memo1.Lines.LoadFromFile('Алиса.txt');
end
else if RadioGroup2.ItemIndex=4 then
begin
image1.Picture.LoadFromFile('чешир.bmp');
Memo1.Lines.LoadFromFile('чешир.txt');
end
else if RadioGroup2.ItemIndex=5 then
begin
image1.Picture.LoadFromFile('кролик.bmp');
Memo1.Lines.LoadFromFile('кролик.txt');
end;


x1:=1;
for i:= 1 to 7 do
       begin
        y1:=d*(i-1);
        //imback.Canvas.Rectangle();
        if i in [2..6]  then
        //imback.Canvas.TextOut(x1, y1, 'right');
         imback.Canvas.Draw(x1, y1,picright);
        end;

y1:=1;
for j:=1 to 7 do
begin
        x1:=d*(j-1);
        //imback.Canvas.Rectangle(x1, y1, x1+d, y1+d);
        if j in [2..6]  then   imback.Canvas.Draw(x1, y1,picdown);
       // imback.Canvas.TextOut(x1, y1, 'down');
       

end;

x1:=d*(i-1)-d;
for i:= 2 to 7 do
begin
        y1:=d*(i-1);
        //imback.Canvas.Rectangle(x1, y1, x1+d, y1+d);
        if i in [2..6]  then imback.Canvas.Draw(x1, y1,picleft);
        //imback.Canvas.TextOut(x1, y1, 'left');

end;

y1:=d*(j-1)-d;
for j:=2 to 7 do
begin
        x1:=d*(j-1);
        //imback.Canvas.Rectangle(x1, y1, x1+d, y1+d);
        if j in [2..6]  then imback.Canvas.Draw(x1, y1,picup);
        //imback.Canvas.TextOut(x1, y1, 'up');
        end;
end;

procedure tform1.ShowMass;
var  i, j: integer;
    x1, x2, y1, y2: integer;
    Pic:TBitMap;
begin

if winner then
begin
Pic:=TBitmap.Create;
      pic.Width:=(n)*d;
      pic.Height:=(n)*d;
      game.Canvas.Rectangle(0,0,350,350);
case RadioGroup2.ItemIndex  of
   0: begin
      pic.LoadFromFile('шляпник.bmp');
      memo1.Lines.LoadFromFile('shlyapnic.txt');
      end;
   1: begin
      pic.LoadFromFile('королева.bmp')  ;
      memo1.Lines.LoadFromFile('koroleva.txt') ;
      end;
   2: begin
      pic.LoadFromFile('белая королева.bmp');
      memo1.Lines.LoadFromFile('belayakoroleva.txt') ;
      end;
   3: begin
      pic.LoadFromFile('Алиса.bmp');
      memo1.Lines.LoadFromFile('Alica.txt') ;
      end;
   4: begin
      pic.LoadFromFile('чешир.bmp') ;
      memo1.Lines.LoadFromFile('ответ.txt');
      end;
   5: begin
      pic.LoadFromFile('кролик.bmp');
      memo1.Lines.LoadFromFile('krolic.txt');
      end;
end;
      game.Canvas.Draw(0,0,pic);
end
else


for i:=1 to n do
begin

   for j:=1 to n do
      begin
      x1:= d*(j-1);
      y1:=d*(i-1);
      x2:=x1+d;
      y2:=y1+d;
       game.Canvas.Brush.Style:=bsSolid;

  game.Canvas.rectangle(x1, y1, x2, y2) ;
    if pole[i,j].nom<>0 then
    begin
    game.Canvas.draw(x1, y1, pole[i,j].pic);
    end;
end;

end;



end;


procedure right(stroka:integer);
var j, d:integer; t:integer; x:tkletka;
begin
 d:=0;
 t:=0;
for j:=1 to n do if pole[stroka, j].nom<>0 then begin t:=j; break; end;


for j:=t to n do if pole[stroka, j].nom=0 then begin d:=j; break; end;



for j:= d downto t do
if d in [1..5] then if (Pole[stroka, j].nom>0) and(Pole[stroka,j+1].nom=0) then
                   begin
                   x:= Pole[stroka,j+1];
                   Pole[stroka,j+1]:=Pole[stroka,j];
                   Pole[stroka,j]:=x
                   end
                   else  else break;
end;

procedure lefts(stroka:integer);
var  j, d, t: integer;  x:tkletka;
begin
d:=-4;
 t:=-5;
for j:=n downto 1 do if pole[stroka, j].nom<>0 then begin t:=j; break; end;


for j:=t downto 1 do if pole[stroka, j].nom=0 then begin d:=j; break; end;


if d in [1..5] then
begin
    for j:=d to t do
    Pole[stroka,j]:=Pole[stroka,j+1]  ;
    pole[stroka,t].nom:=0;
end;


end;

procedure down(stolb:integer);
var t: integer; i, j, d, k: integer;x:tkletka;
begin
 d:=0;
 t:=0;
for i:=1 to n do
if Pole[i, stolb].nom<>0 then begin t:=i; break; end;

for i:= t to n do
if Pole[i, stolb].nom=0 then begin d:=i; break; end;
if  (d<=n) and (d>0) and (t>0) then
   begin
    for i:=d downto t do
    Pole[i,stolb]:=Pole[i-1,stolb]  ;
    pole[t,stolb].nom:=0;

   end;

end;


procedure up(stolb:integer);
var t: integer; i, j, d, k: integer; x:tkletka;
begin
  d:=0;
 t:=0;
for i:= n downto 1 do
 if Pole[i, stolb].nom<>0 then begin t:=i; break; end;

for i:= t downto 1 do
if Pole[i, stolb].nom=0 then begin d:=i; break; end;
if  (d<=n) and (d>0) and (t>0) then
begin
for i:= d to t do
Pole[i, stolb]:=Pole[i+1, stolb];
Pole[t, stolb].nom:=0;
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var Pic: TBitMap;
var x,y,i,j,d:integer;
begin
sbros;
showback;
initmass;
showmass;
memo1.Visible:=true

end;


procedure TForm1.imbackMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var k, i, j: integer;
begin
form1.Caption:=inttostr(game.Width);
i:= y div d+1;
j:= x div d+1;

if (i in [2..6]) and (j=1) then
                           begin

                           right(i-1);
                           showMass;
                           end;
if (j in [2..6]) and (i=1)
                           then
                           begin

                           down(j-1);
                           showMass;
                           end;

if (i in [2..6]) and (j=7) then
                           begin

                           lefts(i-1);
                           showMass;
                           end;

if (j in [2..6]) and (i=7) then
                           begin

                           up(j-1);
                           showMass;
                           end;


end;
procedure TForm1.FormCreate(Sender: TObject);
begin
   game.Width:=n*d;
   game.Height:=n*d;
   game.Left:=d;
   game.Top:=d;

   imback.Width:=(n+2)*d;
   imback.Height:=(n+2)*d;
   imback.left:=0;
   imback.top:=0;

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  showmass;
end;


procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
if RadioGroup2.ItemIndex>=0 then Button1.Visible:=true else
       Button1.Visible:=false;
end;

procedure TForm1.gameClick(Sender: TObject);
var x:integer;
begin
x:=2;
   //hhhh
end;

procedure TForm1.Button2Click(Sender: TObject);
var x:integer;
begin
x:=2;

end;


end.
