unit U_SafeCracker;
{Copyright 2002, 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
 }
{ Unlock the safe by clicking all squares in order from first to last,
   Last square is marked  "LAST".  It is up to you to find the first square.

   Each square except the last, has a number for the distance to move
   and a direction letter (U=Up, D=Down, L=Left, R=Right). }


interface

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

type
TForm1 = class(TForm)
    MakeBtn: TButton;
    UnlockBtn: TButton;
    Image1: TImage;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ColEdt: TEdit;
    ColUD: TUpDown;
    Label2: TLabel;
    RowEdt: TEdit;
    RowUD: TUpDown;
    ClearBtn: TButton;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    SavePicBtn: TButton;
procedure MakeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure UnlockBtnClick(Sender: TObject);
procedure EdtChange(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure ClearBtnClick(Sender: TObject);
procedure SavePicBtnClick(Sender: TObject);
public
grid:array of array of string;
    path:array of TPoint;
    pathcount:integer;
    xincr,yincr:integer;
    cols,rows:integer;
    offsetx,offsety:integer;  {pixel offsets in cell to center text}
offsetxlast,offsetylast:integer;
    bordersize:integer;
    maxdist:integer;  {maximum distance to move}
procedure initialize;
procedure drawboard;
procedure drawpath(pathcount,sleepval:integer);
function MakeValidMove(prevcell:TPoint; var newdir:char;
var newdist:Integer):boolean;
function IsTarget(x,y, px,py:integer):boolean;
function GetNext(cellin:TPoint):TPoint;
function GetPrev(cellin:TPoint):TPoint;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
dirarray:array[0..3] of char=('U','D','L','R');

{******************* MakeValidMove ****************}
function TForm1.MakeValidMove(prevcell:TPoint; var newdir:char;
var newdist:Integer):boolean;
{Create a new valid move, used while generating a board}
var  count,n,d:integer;
begin
result:=false;
  count:=0;
while (result=false) and (count<1000) do
begin
n:=random(4);
    d:=random(maxdist)+1; {limit distance to smaller of rows-1, cols-1}
case n of
0: {up} if     (prevcell.y+d<rows)
and (grid[prevcell.x,prevcell.y+d]='')
then result:=true;
      1: {down} if (prevcell.y-d>=0)
and (grid[prevcell.x,prevcell.y-d]='')
then result:=true;
      2: {left} if (prevcell.x+d<cols)
and (grid[prevcell.x+d,prevcell.y]='')
then result:=true;
      3: {right} if (prevcell.x-d>=0)
and (grid[prevcell.x-d,prevcell.y]='')
then result:=true;
end;
    inc(count);
if result=true then
begin
newdir:=dirarray[n];
      newdist:=d;
end;
end;
end;

{******************** DrawBoard **********}
procedure tform1.drawboard;
var   i,j:integer;
begin
if (cols=0) or (rows=0) then exit;
  setlength(grid,cols,rows);
  bordersize:=4;
with image1, canvas do
begin
brush.color:=clwindow;
    xincr:=width div cols;
    yincr:=height div rows;
    width:=xincr*cols;
    height:=yincr*rows;
    picture.bitmap.width:=width;
    picture.bitmap.height:=height;
    pen.width:=bordersize;
    pen.color:=clgray;
    rectangle(clientrect);
for i:=1 to cols do
begin
moveto(i*xincr,0);
      lineto(i*xincr,height);
end;
for j:=1 to rows do
begin
moveto(0,j*yincr);
      lineto(width,j*yincr);
end;
    offsetx:=(xincr-bordersize-textwidth('XX')) div 2;
    offsety:=(yincr-bordersize-textheight('XX')) div 2+5;
    offsetxlast:=(xincr-bordersize-textwidth('LAST')) div 2;
    offsetylast:=(yincr-bordersize-textheight('LAST')) div 2+5;
if (rows<8) then font.size:=12 else font.size:=8;
    font.style:=[fsbold];
for i:=0 to cols-1 do
for j:=0 to rows-1 do
If grid[i,j]='LAST'
then textout(i*xincr+offsetxlast,j*yincr+offsetylast,grid[i,j])
else textout(i*xincr+offsetx,j*yincr+offsety,grid[i,j]);
    update;
end;
end;


{***************** DrawPath *********}
procedure Tform1.DrawPath(pathcount, sleepval:integer);
{Show the partial or full path}
var
i:integer;
  nx,ny:integer;
begin
{Add small step #'s in  corner of cell}
with image1, canvas do
begin
font.size:=8;
    brush.color:=clgreen;
for i:= 0 to pathcount {high(path)} do
begin
nx:=path[i].x;
      ny:=path[i].y;
if trim(grid[nx,ny])='LAST' then brush.color:=clred
else if i=0 then brush.color:=clgreen
else brush.color:=clsilver;
      fillrect(rect(nx*xincr+bordersize,ny*yincr+bordersize,
                    nx*xincr+xincr-bordersize,
                    ny*yincr+yincr-bordersize));
      font.size:=8;
      textout(nx*xincr+bordersize,ny*yincr+bordersize,inttostr(i+1));
      font.size:=12;
if grid[nx,ny]='LAST'
then textout(nx*xincr+offsetxlast,ny*yincr+offsetylast,grid[nx,ny])
else textout(nx*xincr+offsetx,ny*yincr+offsety,grid[nx,ny]);
if sleepval>0 then
begin
sleep(sleepval);
        update;
end;
end;
end;
end;


{******************** MakeBtnClick *************}
procedure TForm1.MakeBtnClick(Sender: TObject);
{Fill the grid with moves by trial and error}
var
FCol, FRow:integer;
  prevcell:TPoint;
  prevdir, dir:char;
  dist, count:integer;
  i,j:integer;
  filledcells:integer;
begin
screen.cursor:=crHourGlass;
  initialize;
  count:=-1;
repeat
filledcells:=1;
for i:=0 to cols-1 do for j:= 0 to rows-1 do grid[i,j]:='';
    Fcol:=random(cols);
    FRow:=random(rows);
    grid[FCol,FRow]:='LAST';
    prevcell:=point(FCol,Frow);
    prevdir:=' ';
while MakeValidMove(prevcell,dir,dist) do
begin
case dir of
'U': prevcell.y:=prevcell.y+dist;
'D': prevcell.y:=prevcell.y-dist;
'L': prevcell.x:=prevcell.x+dist;
'R': prevcell.x:=prevcell.x-dist;
end;
      grid[prevcell.x,prevcell.y]:=inttostr(dist)+dir;
      inc(filledcells);
      prevdir:=dir;
end;
    inc(count);
if count mod  256 = 0 then
{draw the board once in a while, just to prove that the program is busy}
begin
drawboard;
        count:=0;
end;
until filledcells=rows*cols;
  screen.cursor:=crdefault;
  clearbtnclick(sender);
  drawboard;
end;

{************** FormActivate *************}
procedure TForm1.FormActivate(Sender: TObject);
begin
randomize;
  doublebuffered:=true;
  cols:=colUD.position;
  rows:=rowUD.position;
if cols>rows then maxdist:=rows-1 else maxdist:=cols-1;
  Makebtnclick(sender);
  Clearbtnclick(sender);
  drawboard;
with statusbar1.Panels[0] do text:=#169+' '+text;
end;

{****************** IsTarget ****************}
function TForm1.IsTarget(x,y,px,py:integer):boolean;
{Return true if grid[px,py] is the destination of the move specified
 at grid[x,y]}
var d:integer;
begin
result:=false;
if (length(grid[x,y])=2) and (grid[x,y][1] in ['1'..'9']) then
begin
d:=strtoint(grid[x,y][1]);
case grid[x,y][2] of
'U': result:=py=y-d;
'D': result:=py=y+d;
'L': result:= px=x-d;
'R': result:=px=x+d;
end;
end;
end;

{*************** GetNext *******************}
function TForm1.GetNext(cellin:TPoint):TPoint;
{Given a cell, return the "moveto"  cell}
var  d:integer;
begin
result:=cellin;
with cellin do
if (length(grid[x,y])=2) and (grid[x,y][1] in ['1'..'9']) then
begin
d:=strtoint(grid[x,y][1]);
case grid[x,y][2] of
'U': result.y:=y-d;
'D': result.y:=y+d;
'L': result.x:=x-d;
'R': result.x:=x+d;
end;
end
else result.x:=-1; {must be "F" cell, make sure no valid cell is returned};
end;

{*************** GetPrev *******************}
function TForm1.GetPrev(cellin:TPoint):TPoint;
{Given a cell, return the "movefrom"  cell}
var  c,r:integer;
     nextcell:TPoint;
begin
result:=cellin;
for c:=0 to cols-1 do
for r:=0 to rows-1 do
begin
nextcell:=getnext(point(c,r));
if (nextcell.x=cellin.x) and (nextcell.y=cellin.y) then
begin
result.x:=c;
      result.y:=r;
      exit;
end;
end;
end;

{****************** UnlockBtnClick *************}
procedure TForm1.UnlockBtnClick(Sender: TObject);
{Find the solution}
var
px,py:integer;
  movenbr:integer;
  cell:TPoint;
begin
{Solve it backwards
    first find the Last cell then find the cell that would move to Last,
    then the cell that would move us to that cell, etc. }
{1. Find the "Last" cell;}
for px:=0 to cols-1 do
for py:=0 to rows-1 do
if trim(grid[px,py])='LAST'  then
begin
{2. Trace path backward from there}
setlength(path,cols*rows);
    movenbr:=high(path);
    path[movenbr]:=point(px,py);
repeat  {filling in path info in reverse order}
cell:=getprev(path[movenbr]);
      dec(movenbr);
      path[movenbr]:=cell;
until movenbr=0;
    break;
end;
  drawboard;
  drawpath(high(path), 500); {draw path with 1/2 second delay between moves}
end;

procedure TForm1.Initialize;
{Clear the board and path info}
begin

setlength(grid,0,0); {clear the board}
setlength(grid,cols,rows);
   setlength(path,0);
   setlength(path,rows*cols);
   pathcount:=-1;
   drawboard;
end;

{**************** ColEdtChange *********}
procedure TForm1.EdtChange(Sender: TObject);
{Row or column count changed}
begin
if sender = coledt then cols:=colUD.position
else if sender = rowedt then rows:=RowUD.position;
if cols>rows then maxdist:=rows-1 else maxdist:=cols-1;
  initialize;
end;

{************ Image1MouseDown ************}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{detect mouse click on board and add square to the path if it's valid}
var
cellx,celly:integer;
  nextcell:Tpoint;
begin
if length(path)=0 then exit; {user clicked without any numbers displayed}
cellx:=x div xincr;
  celly:=y div yincr;
if (cellx<cols) and (celly<rows) then
begin
if pathcount<0 then  {first move}
begin
path[0]:=point(cellx,celly);
      inc(pathcount);
      drawpath(pathcount,0);
end
else
begin  {find the next valid square}
nextcell:=getnext(path[pathcount]);
{if that's the one the user clicked, then}
if (nextcell.x=cellx) and (nextcell.y=celly) then
begin  {add it ot the path}
inc(pathcount);
        path[pathcount]:=point(cellx,celly);
        drawpath(pathcount,0);
if pathcount=cols*rows-1   {if we're done and all sqaure were filled}
then showmessage('Excellent work!'
+#13+'But remember to use your safecracking skills '
+ 'only for good, '+#13+ 'never for evil')
else if trim(grid[cellx,celly])='LAST'  {at end but not all filled}
then
begin
showmessage('Not bad, but not perfect - '
+' try to start at the beginning this time!');
          ClearBtnclick(sender);
end;
end
else beep;
end;
end;
end;

{************* ClearBtnClick *************}
procedure TForm1.ClearBtnClick(Sender: TObject);
{Clear any existing path info}
begin
setlength(path,0);
  setlength(path,rows*cols);
  pathcount:=-1;
  drawboard;
end;

procedure TForm1.SavePicBtnClick(Sender: TObject);
begin
image1.picture.bitmap.pixelformat:=pf24bit;
  image1.picture.savetofile(extractfilepath(application.exename)+'safecracker.bmp')
end;

end.