unit Kar1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N2: TMenuItem;
    Image2: TImage;
    Procedure LoadQuestion;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
  PQues = ^TQues;

  TQues = Record
    Num: Byte;
    NameQ, NameA, Title: String[80];
    Next, Prev: PQues;
  End;

  TChips = Record
    X, Y: Integer;
    Pic: TBitmap;
  End;

var
  Form1: TForm1;
  FQues, CurQues: PQues;
  Ques, Ans, Fld, Back: TBitmap;
  Chips: Array[0..5] of TChips;
  UnderChips: Array[0..5] of TBitmap;
  Pnts: Array[0..13{15}] of Integer;
  kHW: Real;
  NumQues, Step, MayMove, MayUp, NumChip, ChipH, ChipW,
      XDn, YDn, CurX, CurY, CurDx, CurDy, Defl: Integer;


implementation

{$R *.DFM}

Function Min(A, B: Real): Real;
Begin
  If A<B Then Min:=A Else Min:=B;
End;

Function Max(A, B: Real): Real;
Begin
  If A>B Then Max:=A Else Max:=B;
End;

procedure TForm1.FormCreate(Sender: TObject);
Var
  F: TextFile;
  Pr, Cur: PQues;
  St: String;
  a: Integer;
  Rect: TRect;
Label End_;
begin
  kHW:=Screen.Height/536;
  Height:=Screen.Height;
  Width:=Round(Width*kHW);
  AssignFile(F,'Karapuz.ini');
  ReSet(F);
  ReadLn(F,St);
  ReadLn(F,NumQues);
  If NumQues<1 Then Goto End_;
  Pr:=Nil;
  For a:=1 to NumQues do
    Begin
      New(Cur);
      If Cur=NIL Then
        Begin
          NumQues:=0;
          Goto End_;
        End;
      ReadLn(F,St);
      Cur^.Num:=1;
      Cur^.Title:=St;
      Cur^.Prev:=Pr;
      ReadLn(F,St);
      Cur^.NameQ:=St;
      ReadLn(F,St);
      Cur^.NameA:=St;
      If Pr<>Nil Then Pr^.Next:=Cur;
      If a=1 Then FQues:=Cur;
      Pr:=Cur;
    End;
  Cur^.Next:=FQues;
  FQues^.Prev:=Cur;
  Ques:=TBitmap.Create;
  Ans:=TBitmap.Create;
  Fld:=TBitmap.Create;
  Back:=TBitmap.Create;
  ReadLn(F,St);
  ReadLn(F,St);
  Image2.Visible:=False;
  Image2.Picture.LoadFromFile(St);
  Fld.Height:=ClientHeight;
  Fld.Width:=ClientWidth;
  Image1.Height:=Fld.Height;
  Image1.Width:=Fld.Width;
  Rect:=Bounds(0,0,Fld.Width,Fld.Height);
  Fld.Canvas.StretchDraw(Rect,Image2.Picture.Graphic);
  Ques.Palette:=Fld.Palette;
  Ans.Palette:=Fld.Palette;
  Back.Palette:=Fld.Palette;
  Back.Width:=Fld.Width;
  Back.Height:=Fld.Height;
  For a:=0 to 5{14} do
    Begin
      Read(F,Pnts[a]);
      Pnts[a]:=Round(Pnts[a]*kHW);
    End;
  ReadLn(F,Pnts[6]);
  Pnts[6]:=Round(Pnts[6]*kHW);
  ReadLn(F,St);
  Image2.Transparent:=True;
  Image2.Picture.Bitmap.Palette:=Fld.Palette;
  Rect:=Bounds(0,0,Round(46*kHW),Round(37*kHW));
  For a:=0 to 5 do
    Begin
      ReadLn(F,St);
      Chips[a].Pic:=TBitmap.Create;
      UnderChips[a]:=TBitmap.Create;
      Chips[a].Pic.Palette:=Fld.Palette;
      UnderChips[a].Palette:=Fld.Palette;
      Image2.Picture.LoadFromFile(St);
      Image2.Picture.Bitmap.TransparentColor:=Image2.Picture.Bitmap.Canvas.Pixels[0,0];
      Chips[a].Pic.Height:=Round(37*kHW);
      Chips[a].Pic.Width:=Round(46*kHW);
      Chips[a].Pic.Canvas.StretchDraw(Rect,Image2.Picture.Graphic);
      UnderChips[a].Width:=Chips[a].Pic.Width;
      UnderChips[a].Height:=Chips[a].Pic.Height;
      Chips[a].Pic.Transparent:=True;
      Chips[a].Pic.TransparentColor:=Chips[a].Pic.Canvas.Pixels[0,0];
    End;
  ChipH:=Chips[0].Pic.Height;
  ChipW:=Chips[0].Pic.Width;
  Image2.Transparent:=False;
  For a:=7 to 12 do
    Begin
      Read(F,Pnts[a]);
      Pnts[a]:=Round(Pnts[a]*kHW);
    End;
  ReadLn(F,Pnts[13]);
  Pnts[13]:=Round(Pnts[13]*kHW);
  ReadLn(F,St);
  ReadLn(F,Defl);
  Defl:=Round(Defl*kHW);

End_:
  CloseFile(F);

  If NumQues<1 Then
    Begin
      N1.Enabled:=False;
    End;

  Step:=0;
  MayMove:=-1;
  MayUp:=0;
  NumChip:=-1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
Var
  Cur, Nx: PQues;
  a: Integer;
begin
  Nx:=FQues;
  For a:=1 to NumQues do
    Begin
      Cur:=Nx;
      Nx:=Cur^.Next;
      Dispose(Cur);
    End;
  Ques.Free;
  Ans.Free;
  Fld.Free;
  Back.Free;
  For a:=0 to 5 do
    Begin
      Chips[a].Pic.Free;
      UnderChips[a].Free;
    End;
end;

Procedure TForm1.LoadQuestion;
Var
  a: Integer;
  RectD, RectS: TRect;
Begin
  If Step=1 Then
    Begin
      CurQues:=FQues^.Prev;
      Image1.Visible:=True;
    End;
  {Image1}Back.Canvas.Draw(0,0,Fld);
  If Step mod 2 = 1 Then
    Begin
      CurQues:=CurQues^.Next;
      Caption:='Карапуз - '+CurQues^.Title;      
      MayMove:=0;
      Image2.Picture.LoadFromFile(CurQues^.NameQ);
      RectD:=Bounds(0,0,Round(300*kHW),Round(390*kHW));
      {Ques}Back.Canvas.StretchDraw(RectD,Image2.Picture.Graphic);
      {Image1Back.Canvas.Draw(0,0,Ques);}
    End Else
    Begin
      MayMove:=-1;
      Image2.Picture.LoadFromFile(CurQues^.NameA);
      RectD:=Bounds(0,0,Round(300*kHW),Round(390*kHW));
      {Ans}Back.Canvas.StretchDraw(RectD,Image2.Picture.Graphic);
      {Image1Back.Canvas.Draw(0,0,Ans);}
    End;
  Image1.Canvas.Draw(0,0,Back);
  For a:=0 to 5 do
    Begin
      If Step mod 2=1 Then
        Begin
          Chips[a].X:=Pnts[a+1+7];
          Chips[a].Y:=Pnts[7];
        End;
      RectS:=Bounds(Chips[a].X - ChipW div 2,
                    Chips[a].Y - ChipH div 2, ChipW, ChipH);
      RectD:=Bounds(0,0,ChipW,ChipH);
      UnderChips[a].Canvas.CopyRect(RectD,{Fld}Back.Canvas,RectS);
      Image1.Canvas.Draw(RectS.Left,RectS.Top,Chips[a].Pic);
    End;
End;

procedure TForm1.N1Click(Sender: TObject);
begin
  N2.Enabled:=True;
  N1.Enabled:=False;
  Step:=1;
  LoadQuestion;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  If Step<2*NumQues Then
    Begin
      Inc(Step);
      LoadQuestion;
    End Else
    Begin
      Step:=-1;
      NumChip:=-1;
      MayMove:=-1;
      N1.Enabled:=True;
      N2.Enabled:=False;
      Image1.Visible:=False;
      Caption:='Карапуз';
    End;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
  a: Integer;
  XY: TPoint;
begin
  If (MayMove=0) and (Button=mbLeft) Then
    Begin
      For a:=0 to 5 do
        Begin
          If (X>=Chips[a].X - ChipW div 2) and
             (X<=Chips[a].X + ChipW div 2) and
             (Y>=Chips[a].Y - ChipH div 2) and
             (Y<=Chips[a].Y + ChipH div 2) Then
               Begin
                 NumChip:=a;
                 XDn:=X;
                 YDn:=Y;
                 CurX:=Chips[a].X;
                 CurY:=Chips[a].Y;
                 MayMove:=1;
                 MayUp:=1;
                 Screen.Cursor:=crNone;
                 GetCursorPos(XY);
                 CurDx:=XY.X-(X+Left);
                 CurDy:=XY.Y-(Y+Top);
                 Break;
               End;
        End;
    End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If (MayMove<>0) and (Button=mbLeft) and (MayMove<>-1) and
     (MayUp=0) Then
    Begin
      Chips[NumChip].X:=CurX;
      Chips[NumChip].Y:=CurY;
      NumChip:=-1;
      MayMove:=0;
      Screen.Cursor:=crDefault;
    End;
  If MayUp=1 Then MayUp:=0;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var
  a, b, c, n, Chck, Xold, Yold, Dx, Dy: Integer;
  RectS, RectD: TRect;
begin
  If (MayMove=1) Then
    Begin
      Image1.Canvas.Draw(CurX-ChipW div 2,CurY-ChipH div 2,UnderChips[NumChip]);
      Xold:=CurX;
      Yold:=CurY;
      Dx:=X-XDn;
      Dy:=Y-YDn;
      b:=Round(Max(Abs(Dx),Abs(Dy)));

      Chck:=0;
      For c:=1 to b do
      If (Chck<>1) and (b<>0) Then
        Begin
          Chck:=0;
          n:=c;
          CurX:=Round(Xold+Dx*c/b);
          CurY:=Round(Yold+Dy*c/b);
{          For a:=1 to 6 do
            Begin
              If Not ((CurX>=Pnts[a]-Defl) and (CurX<=Pnts[a]+Defl) and
                     (CurY>=Pnts[7]-Defl) and (CurY<=Pnts[0]+Defl)) Then
                  Begin
                    Inc(Chck);
                  End Else Break;
            End;

          If Chck=6 Then
            Begin
              If Not ((CurX>=Pnts[1]-Defl) and (CurX<=Pnts[8]+Defl) and
                     (CurY>=Pnts[7]-Defl) and (CurY<=Pnts[7]+Defl)) Then
                  Begin
                    Inc(Chck);
                  End;
            End;

          If Chck=7 Then
            Begin
              If Not ((CurX>=Pnts[8]-Defl) and (CurX<=Pnts[8]+Defl) and
                     (CurY>=Pnts[10]-Defl) and (CurY<=Pnts[7]+Defl)) Then
                  Begin
                    Inc(Chck);
                  End;
            End;

          If Chck=8 Then
            For a:=10 to 15 do
              Begin
                If Not ((CurX>=Pnts[9]-Defl) and (CurX<=Pnts[8]+Defl) and
                       (CurY>=Pnts[a]-Defl) and (CurY<=Pnts[a]+Defl)) Then
                    Begin
                      Inc(Chck);
                    End Else Break;
              End;}
          If Chck<>1 Then
            For a:=0 to 5 do
              Begin
                If (a<>NumChip) and (Chck<>1) Then
                  If
                     (( ((CurX-ChipW div 2>=Chips[a].X-ChipW div 2) and
                        (CurX-ChipW div 2<=Chips[a].X+ChipW div 2) and
                        (CurY-ChipH div 2>=Chips[a].Y-ChipH div 2) and
                        (CurY-ChipH div 2<=Chips[a].Y+ChipH div 2)) or

                        ((CurX-ChipW div 2>=Chips[a].X-ChipW div 2) and
                        (CurX-ChipW div 2<=Chips[a].X+ChipW div 2) and
                        (CurY+ChipH div 2>=Chips[a].Y-ChipH div 2) and
                        (CurY+ChipH div 2<=Chips[a].Y+ChipH div 2)) or

                        ((CurX+ChipW div 2>=Chips[a].X-ChipW div 2) and
                        (CurX+ChipW div 2<=Chips[a].X+ChipW div 2) and
                        (CurY-ChipH div 2>=Chips[a].Y-ChipH div 2) and
                        (CurY-ChipH div 2<=Chips[a].Y+ChipH div 2)) or

                        ((CurX+ChipW div 2>=Chips[a].X-ChipW div 2) and
                        (CurX+ChipW div 2<=Chips[a].X+ChipW div 2) and
                        (CurY+ChipH div 2>=Chips[a].Y-ChipH div 2) and
                        (CurY+ChipH div 2<=Chips[a].Y+ChipH div 2)) or
                        (CurX+ChipW div 2>=Image1.Width) or
                        (CurX-ChipW div 2<=0) or
                        (CurY+ChipH div 2>=Image1.Height) or
                        (CurY-ChipH div 2<=0) )) Then
                  Begin
                    Chck:=1;
                  End;
              End;
        End;
      If b<>0 Then
        Begin
          CurX:=Round(Xold+Dx*(n-1)/b);
          CurY:=Round(Yold+Dy*(n-1)/b);
        End Else
        Begin
          CurX:=Xold;
          CurY:=Yold;
        End;
      XDn:=XDn+CurX-Xold;
      YDn:=YDn+CurY-Yold;
      If (XDn<>X) or (YDn<>Y) Then MayMove:=2;
      RectS:=Bounds(CurX-ChipW div 2,CurY-ChipH div 2,ChipW,ChipH);
      RectD:=Bounds(0,0,ChipW,ChipH);
      UnderChips[NumChip].Canvas.CopyRect(RectD,{Fld}Back.Canvas,RectS);
      Image1.Canvas.Draw(CurX-ChipW div 2,CurY-ChipH div 2,Chips[NumChip].Pic);
      If MayMove=2 Then SetCursorPos(XDn+Left+CurDx,YDn+Top+CurDy);
    End Else If MayMove=2 Then
      Begin
        MayMove:=1;
      End;
end;

end.