Unit U_SlidingCoins3;
 {Copyright 2000, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

{Slide a Dime/Quarter or Quarter/Dime pair to get from initial to goal
 positions.  Can be done in 4 moves}
{Program is mainly an illustration of drag-drop with images}


{***$DEFINE DEBUG}  {remove *** to turn on debugging}

interface

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

const
  {coordinates}
  QHeight=60; {Size of Quarter}
  DHeight=30; {Size of Dime}
  YCenter=200; {center of coins}
  Halfw=(Qheight+Dheight) div 2;
  startleft=10;
  clCoincolor=ClBlue;
  clDraggedColor=ClAqua;

type
  TCoinval=(D,Q,E); {dime,quarter, empty}

  TCoin= class(Tshape)
  public
    cval:TCoinVal; {coin value}
    index:integer; {left to right index - to help identify clicks}
    function LogicalLeft:integer; {return the left edge for index if all were quarters}
    constructor create(Aowner:TComponent); override;
    procedure assign(Source:TCoin);  reintroduce;
    procedure makeEmpty; {set empty coin values}
    function GetDragImages:TDragImageList; override;

  end;

  TForm1 = class(TForm)
    ResetBtn: TButton;
    MoveEdt: TEdit;
    Label1: TLabel;
    SolveBtn: TButton;
    Panel1: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
                          State: TDragState; var Accept: Boolean);
    procedure ResetBtnClick(Sender: TObject);
    procedure CoinDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure SolveBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  public
    coins:array[1..13] of TCoin;
    dragindex:integer;
    DragImages:TDragImageList; {coin images while dragging}
    moves:integer;
    {$IFDEF DEBUG}
      lastdebugmsg:string;
    {$ENDIF}
    procedure CoinMouseDown(Sender: TObject; Button: TMouseButton;
           Shift: TShiftState; X, Y: Integer);
    procedure CoinStartDrag(Sender: TObject;
              var DragObject: TDragObject);
    Procedure makemove(p:TPoint);
    procedure refresh;
    procedure DragEnded(Sender, Target: TObject; X, Y: Integer);
    procedure showsolved;
    function dropslot(x,y:integer):integer;
    procedure makecaption(leftSide, Rightside:string);
    {$IFDEF DEBUG}
    procedure debug(msg:string);
    {$ENDIF}
 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

constructor TCoin.create;
begin
  inherited;
  ControlStyle := ControlStyle + [csDisplayDragImage];
  makeempty;
end;

{**************** TCoin.Assign ***************}
procedure TCoin.Assign(Source:TCoin);
{assign properties of source to self}
begin
  left:=source.left;
  top:=source.top;
  height:=Source.height;
  width:=Source.width;
  brush.color:=Source.Brush.color;
  shape:=source.shape;
  cval:=source.cval;
end;

{***************** TCoin.MakeEmpty *************}
procedure TCoin.MakeEmpty;
{set properties unique to an empty coin slot}
begin
  cval:=E;
  Height:=6;
  shape:=Strectangle;
  If width=qheight then brush.color:=clblack
  else brush.color:=clyellow;
  top:=ycenter+Qheight div 2 -height;
end;

{****************** TCoin.GetDragImages **********}
function TCoin.GetDragImages:TDragImageList;
 begin  result:=form1.DragImages; end;

{*************** TCoin.LogicalLeft **********}
function TCoin.LogicalLeft:integer;
begin  result:=(index-1)*qheight+startleft; end;


{*****************************************************}
{************** Form Methods **************************}
{*****************************************************}

{$IFDEF DEBUG}
procedure tform1.debug(msg:string);
begin
  with memo1, lines do
  if msg<>lastdebugmsg then lines.add(msg);
  lastdebugmsg:=msg;
end;
{$ENDIF}


{********************* TForm1.MakeCaption ******************}
procedure TForm1.makecaption(leftSide, Rightside:string);
var
  Metrics:NonClientMetrics;
  captionarea,spacewidth,nbrspaces:integer;
  b:TBitmap;
begin
  b:=TBitmap.create;  {to get a canvas}
  metrics.cbsize:=sizeof(Metrics);
  if SystemParametersInfo(SPI_GetNonCLientMetrics, sizeof(Metrics),@metrics,0)
  then  with metrics   do
  begin
    b.canvas.font.name:=Pchar(@metrics.LFCaptionFont.LfFaceName);
    with metrics.LFCaptionFont, b.canvas.font do
    begin
      height:=LFHeight;
      if lfweight=700 then style:=[fsbold];
      if lfitalic<>0 then style:=style+[fsitalic];
    end;
    {subtract 3 buttons + Icon + some border space}
    captionarea:=clientwidth-4*iCaptionwidth-4*iBorderWidth;;
    {n = # of spaces to insert}
    spacewidth:=b.canvas.textwidth(' ');
    nbrspaces:=(captionarea-b.canvas.textwidth(Leftside + Rightside)) div spacewidth;
    if nbrspaces>3 then caption:=LeftSide+stringofchar(' ',nbrspaces)+RightSide
    else caption:=LeftSide+' '+RightSide;
  end;
  b.free;
end;

{***************** TForm1.FormCreate ***************}
procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
  b:TBitmap;
begin
  {required for form to show drag images}
  ControlStyle := ControlStyle + [csDisplayDragImage];
  for i:=low(coins) to high(coins) do  coins[i]:=tCoin.create(self);
  resetBtnClick(sender); {make initial images}
  doublebuffered:=true;

  {make drag images}
  DragImages:=TDragIMageList.create(self);
  DragImages.width:=dheight+qheight;
  DragImages.height:=qheight;
  b:=tBitmap.create; {dime+ quarter}
  b.width:=dheight+qheight;
  b.height:=qheight;

  with b.canvas do
  begin
    ellipse(0,(Qheight-dheight) div 2,dheight,Halfw);
    ellipse(dheight,0, dheight+qheight,Qheight);
  end;
  DragImages.Add(b,nil);

  b:=TBitmap.create;  {quarter+dime}
  b.width:=dheight+qheight;
  b.height:=qheight;
  with b.canvas do
  begin
    ellipse(0,0,qheight,qheight);
    ellipse(qheight,(Qheight-dheight) div 2,
            dheight+qheight,halfw);
  end;
  DragImages.Add(b,nil);
end;

{********************* TForm1.DropSlot ************}
function Tform1.DropSlot(x,y:integer):integer;
  var
    tempx,n:integer;
    m,max:integer;

    function closest(x:integer):integer;
    var i:integer;
    begin
      i:=0;
      repeat
        inc(i);
        if i=1 then m:=0 else m:=coins[i].left-coins[i-1].width div 2;
        max:=coins[i].left+coins[i].width div 2;
      until (x>=m) and (x<=max);
      result:=i
    end;

  begin
    tempx:=x-halfw; {set x to left side of dragimage}
    n:= closest(tempx);
    if ((coins[n].cval=E) and (coins[n+1].cval=E))
    or ((n=dragindex+1) and (coins[n+1].cval=E))
    or ((n=dragindex-1) and (n>1) and (coins[n].cval=E))
    then result:=n
    else result:=-1;
  end;

{****************** TForm1.CoinMouseDown *****************}
procedure TForm1.CoinMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{Get ready to drag a pair of coins}
var
  leftmost,closest:integer;
begin
  If sender is TCoin then
  with sender as tcoin do
  begin
    If cval=E then exit;
    {find closest adjoining coin}
    leftmost:=index;
    if (x<width div 2) {it was on the left hand side}
        and (index>low(coins)) {and not first}
    then leftmost:=index-1;
    If (leftmost=high(coins))
    or ((coins[leftmost+1].cval=E) and (leftmost>low(coins)))
    then  dec(leftmost);
    closest:=leftmost+1;
    {make sure a valid coin pair has been selected}
    If (coins[leftmost].cval<>coins[closest].cval) and
       (coins[leftmost].Cval<>E) and (coins[closest].Cval<>E)
    then
    begin
      coins[leftmost].brush.color:=clDraggedColor;
      coins[closest].brush.color:=clDraggedColor;
      {update those images before showing drag image}
      application.processmessages;

      {move the cursor to the top center of the coin pair - the hotspot}
      mouse.cursorpos:=point(coins[leftmost].left+self.left+halfw,
                             self.top+ycenter-qheight div 2);

      coins[leftmost].begindrag(true,0);
      {$IFDEF DEBUG} debug('Mousedown begin drag '+inttostr(leftmost)); {$ENDIF}
    end;
  end;

end;

{******************* TForm1.CoinStartDrag ***************}
procedure TForm1.CoinStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  hotx,hoty:integer;
begin
  hotx:=halfw;
  hoty:=0;
  if TCoin(Sender).width=dheight {dime is on left}
  then DragImages.setdragimage(0,hotx,hoty)
  {else quarter is on left}
  else DragImages.setdragimage(1,hotx,hoty);
  dragindex:=TCoin(sender).index;
  {$IFDEF DEBUG} debug('Startdrag , dragindex='+inttostr(dragindex)); {$ENDIF}
end;

{**************** TForm1.FormDragOver *****************}
procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);

var tempx:integer;
    r:integer;
begin
  if sender=source then accept:=false
  else
  begin
   {since we're using the same exit for dragging over coins or the form,
    we need to adjust coin X coordinate to look like form X coordinate}
   {If sender is TCoin then tempx:=x+TCoin(sender).left
   else} tempx:=x;
   r:=dropslot(tempx,y);
   accept:=r>=0;
   {$IFDEF DEBUG}
   debug('Dragover, x='+inttostr(tempx)+ ',Dindex='+inttostr(dragindex)+', Dslot='+inttostr(r));
   {$ENDIF}
   mouse.cursorpos:=point(tempx,self.top+ycenter-Qheight div 2);
  end;
end;

{*********************** TForm1.CoinDragDrop *************}
procedure TForm1.CoinDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  t:integer;
  i, L1:integer;
  tempx:integer;
  check:string;
begin
  If sender is TCoin then tempx:=x+TCoin(sender).left
  else tempx:=x;
  t:=dropslot(tempx,y);
  {$IFDEF DEBUG} debug('DragDrop, x='+inttostr(tempx)+', dropslot='+inttostr(t));
  {$ENDIF}
  if (t>0) then
  begin
    if t=dragindex+1 then {overlapped, move it first}
    with TCoin(source) do
    begin
      coins[t+1].assign(coins[dragindex+1]);
      coins[t+1].index:=t+1;
      coins[t+1].left:=coins[t].left+coins[dragindex].width;
      coins[t+1].brush.color:=clCoinColor;
      L1:=coins[t].left;
      coins[t].assign(coins[dragindex]);
      coins[t].left:=L1;
      coins[t].index:=t;
      coins[t].brush.color:=clCoinColor;
    end
    else
    begin
      L1:=coins[t].left;
      coins[t].assign(coins[dragindex]);
      coins[t].left:=L1;
      coins[t].index:=t;
      coins[t].brush.color:=clCoinColor;
      coins[t+1].assign(coins[dragindex+1]);
      coins[t+1].index:=t+1;
      coins[t+1].left:=coins[t].left+coins[t].width;
      coins[t+1].brush.color:=clCoinColor;
    end;
    if (dragindex<>t) and (dragindex<>t+1) then coins[dragindex].makeempty;
    if (dragindex<>t-1) and (dragindex<>t) then coins[dragindex+1].makeempty;
    {We might have moved a small/big over  small/small empty slots,
    so readjust left coordinates in case}
    for i:=t+2 to high(coins) do
    begin
      coins[i].left:=coins[i-1].left+coins[i-1].width;
    end;
  end;
  refresh;
  {check if solved {look for DDDQQ}
  check:='';
  for i:= low(coins) to high(coins) do
  begin
    case coins[i].cval of
      D: check:=check+'D';
      Q: check:=check+'Q';
    end;
  end;
  if (check='QQDDD') or (check='DDDQQ') then showsolved;
end;

{***************** TForm1.refresh ****************}
procedure TForm1.refresh;
{re-sort coins array by left to right and renumber}
var
  i:integer;
begin
  for i:=2 to high(coins) do
  begin
    if (coins[i-1].cval=E) and (coins[i].cval=E) then
    begin
      if coins[i-1].width=dheight
      then coins[i].width:=qheight
      else coins[i].width:=dheight;
      coins[i].makeempty;
    end;
    coins[i].left:=coins[i-1].left+coins[i-1].width;
  end;
  inc(moves);
  MoveEdt.text:=inttostr(moves);
end;

{*************** TForm1.MakeMove **********************}
Procedure TForm1.makemove(p:TPoint);
{Auto-move coins p.x  and p.x+1 to p.y and p.y+1 locations}
var
  i:integer;
  start1,start2:integer;
begin
  start1:=coins[p.x].left;  {save location to put empties back here later}
  start2:=coins[p.x+1].left;

  {move down}
  for i:= 0 to qheight do
  begin
    with coins[p.x] do top:=top-1;
    with coins[p.x+1] do top :=top-1;
    {no need to process message for every loop - too slow}
    if i mod 2=0 then application.processmessages;
  end;
  {move left or right}
  if p.y>p.x then {right}
  for i:= coins[p.x].left+1 to coins[p.y].left do
  begin
    coins[p.x].left:=i;
    coins[p.x+1].left:=i+coins[p.x].width;
    if i mod 2=0 then application.processmessages;
  end
  else {left}
  for i:= coins[p.x].left+1 downto coins[p.y].left do
  begin
    coins[p.x].left:=i;
    coins[p.x+1].left:=i+coins[p.x].width;
    if i mod 2=0 then application.processmessages;
  end;
  {move up}
  for i:= 0 to qheight do
  begin
    coins[p.x].top:=coins[p.x].top+1;
    coins[p.x+1].top:=coins[p.x+1].top+1;
    if i mod 2=0 then application.processmessages;
  end;
  {put coin info in new place}
  coins[p.y].assign(coins[p.x]);
  coins[p.y+1].assign(coins[p.x+1]);
  coins[p.x].makeempty;
  coins[p.x].left:=start1;
  coins[p.x+1].makeempty;
  coins[p.x+1].left:=start2;
  refresh; {renumber and resort coin array}
end;

{******************* TForm1.ResetBtnClick ****************}
procedure TForm1.ResetBtnClick(Sender: TObject);
{Reset coins to initial configuration}
var
  nextleft,i,n:integer;
begin
  nextleft:=startleft;
  for i:=low(coins) to high(coins) do
  with coins[i] do
  begin
    parent:=self;
    left:=nextleft;
    index:=i;
    onMouseDown:=coinMouseDown;
    onstartdrag:=CoinStartDrag;
    (*
    OnDragOver:= FormDragOver;
    OnDragDrop:=CoinDragDrop;
    *)
    OnEndDrag:=DragEnded;
    if (i>5) then
    begin
      if i mod 2 =1 then
      width:=Dheight
      else width:=qheight;
      MakeEmpty;
    end
    else
    begin
      brush.color:=clCoinColor;
      shape:=stcircle;
      case i mod 2 of
      1: begin
           top:=ycenter-DHeight div 2;
           width:=DHeight;
            height:=DHeight;
            cval:=D;
         end;
      0: begin
          top:=ycenter-QHeight div 2;
          width:=qHeight;
          height:=qHeight;
          cval:=Q;
        end;
      end; {case}
    end;
    nextleft:=nextleft+width;
  end;
  moves:=0;   {reset moves}
  moveEdt.text:='0';
  n:=startleft;
  with canvas do
  begin
    pen.width:=1;
    pen.color:=clblack;
    while n<coins[high(coins)].left+qheight do
    begin
      moveto(n,ycenter+10+dheight);
      lineto(n,ycenter+dheight+20);
      n:=n+dheight;
    end;
  end;
  memo1.clear;
end;

(********************* TForm1.ShowSolved *****************)
procedure TForm1.Showsolved;
  begin
    If moves>4
    then application.messagebox('(It can be done in fewer moves though)','Solved!',
                               mb_OK+MB_IconExclamation)
    else if moves=4 then application.messagebox('Yes - you are good','Solved!',
                               mb_OK+MB_IconExclamation)
    else showmessage('Cheating again?');
  end;

{****************** TForm1.SolveBtnClick **********}
procedure TForm1.SolveBtnClick(Sender: TObject);
var
  sol:array [0..1] of array [1..5] of tpoint;
  i,j:integer;
begin
  {set up solutions}
  sol[0,1]:=point(1,6); sol[0,2]:=point(3,8);  sol[0,3]:=point(6,10);
  sol[0,4]:=point(9,6);  sol[0,5]:=point(5,9);
  sol[1,1]:=point(3,6); sol[1,2]:=point(1,8);  sol[1,3]:=point(6,10);
  sol[1,4]:=point(9,6);  sol[1,5]:=point(5,9);
  resetbtnclick(sender);
  sleep(500);
  j:=random(2); {pick a solution to display}
  for i:= 1 to 5 do  MakeMove(sol[j,i]);
  Showsolved;
end;
{4-move solution: (1,8),(3,10),(9,6),(5,9)}

{************* TForm1.DragEnded ******************}
 procedure TForm1.DragEnded(Sender, Target: TObject; X, Y: Integer);
 begin
   If (target=nil) then {drag failed, restore images}
   begin
      coins[dragindex].brush.color:=clCoinColor;
      Coins[dragindex+1].brush.color:=clCoinColor;
      dragindex:=0;
   end;
end;

{***************** TForm1.ForActivate **************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  windowstate:=wsmaximized;
  makecaption('Sliding Coins Puzzle', #169+'2001 G. Darby, www.DelphiForFun.com');
  application.processmessages;
  {$IFDEF DEBUG} memo1.visible:=true; {$ENDIF}
  resetbtnclick(sender);
end;


(*
procedure TForm1.Button1Click(Sender: TObject);
{Generate and save bmp images of start and end configurations}
var
  b:TBitmap;
  fpath:string;
  x,i:integer;
begin

  fpath:=extractfilepath(application.exename);
  b:=TBitmap.create;
  b.height:=70;
  b.width:=230;
  b.pixelformat:=pf24bit;
  x:=10;
  b.canvas.brush.color:=clblue;
  for i:=1 to 5 do
  begin
    if i mod 2 =1 then
    begin
      b.canvas.ellipse(x,20,x+30,50);
      x:=x+30;
    end
    else
    begin
      b.canvas.ellipse(x,5,x+60,65);
      x:=x+60;
    end
  end;
  b.savetofile(fpath+'StartImage.bmp');
  b.free;


  b:=TBitmap.create;
  b.height:=70;
  b.width:=230;
  b.pixelformat:=pf24bit;
  x:=10;
  b.canvas.brush.color:=clblue;
  for i:=1 to 5 do
  begin
    if i <=3 then
    begin
      b.canvas.ellipse(x,20,x+30,50);
      x:=x+30;
    end
    else
    begin
      b.canvas.ellipse(x,5,x+60,65);
      x:=x+60;
    end
  end;
   b.savetofile(fpath+'EndImage.bmp');
end;
*)


end.