unit U_DurersSquare;
{Copyright  © 2003, Gary Darby,  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
 }

{Durer's Magic Square is from a famous copper engraving, Melancholia, created in
 1514 by German artist Albrecht Durer.

 There are 86 different combinations of 4 numbers from the square that sum to
 it's magic number, 34.  How many can you find?
}

interface

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

type
  TForm1 = class(TForm)
    Grid1: TStringGrid;
    ShowBtn: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    ListBox1: TListBox;
    Msglbl: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure ShowBtnClick(Sender: TObject);
    procedure Grid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Grid1Click(Sender: TObject);
  public
    s:array[1..4] of string; {string representations of 4 cells that sum to 34}
    n:array[1..4] of integer;
    nbrcount:integer;
    procedure display(msg:string);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  {Durer's magic square data}
  data:array[0..3, 0..3] of integer=((16,3,2,13),(5,10,11,8),(9,6,7,12),(4,15,14,1));

{************* FormActivate ********}
procedure TForm1.FormActivate(Sender: TObject);
{Draw initial magic square}
var i,j:integer;
begin
   For i:=0 to 3 do
   for j:=0 to 3 do
   grid1.cells[i,j]:=inttostr(data[j,i]);
   nbrcount:=0; {count of cells manually selected}
   for i:=1 to 4 do s[i]:=''; {values of selected cells}
end;

{**************** ShowBtnClick ********}
procedure TForm1.ShowBtnClick(Sender: TObject);
{Generate all 86 solutions}
var i1,i2,i3,i4:integer;
    n1,n2,n3,n4:integer;
    count:integer;
    i:integer;
begin
  nbrcount:=0;
  if showbtn.caption='Stop' then
  begin
    tag:=1;
    showbtn.caption:='Show me';
    grid1.onclick:=grid1click;
    for i:=1 to 4 do s[i]:='';
    label1.caption:='';
    exit;
  end;
  showbtn.caption:='Stop';
  grid1.onclick:=nil;  {ignore user clicks while we're working}
  count:=0;
  tag:=0;  {use tag field as a stop flag}
  {generate all permutations of 4 numbers selected from 0-15}
  with grid1 do
  for i1:= 0 to 12 do
  begin
    s[1]:=cells[i1 div 4, i1 mod 4]; {convert number to column & row & get cell}
    n1:=strtoint(s[1]);              {save cell as a number}
    for i2:=i1+1 to 13 do
    begin
      s[2]:=cells[i2 div 4, i2 mod 4]; {convert number to column & row & get cell}
      n2:=strtoint(s[2]);              {save cell as a number}
      for i3:=i2+1 to 14 do
      begin
        s[3]:=cells[i3 div 4, i3 mod 4]; {convert number to column & row & get cell}
        n3:=strtoint(s[3]);              {save cell as a number}
        for i4:=i3+1 to 15 do
        begin
          s[4]:=cells[i4 div 4, i4 mod 4]; {convert number to column & row & get cell}
          n4:=strtoint(s[4]);              {save cell as a number}
          if n1+n2+n3+n4=34 then  {does sum of these four cells = 34?}
          begin
            grid1.invalidate; {force magic square to be redrawn}
            inc(count);
            label1.caption:='#'+inttostr(count);
            application.processmessages;  {update screen }
            if self.tag=1 then exit  {stop if flag is set}
            else sleep(1000); {wait a second}
          end;
        end;
      end;
    end;
  end;
  Showbtn.caption:='Show me';
  grid1.onclick:=grid1click;
  for i:=1 to 4 do s[i]:='';
  label1.caption:='';
end;

{*************** StringGridDrawCell ***************}
procedure TForm1.Grid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
{Highlight preselectedc cells this iteration of drawing the square}
begin
  with Sender as Tstringgrid , canvas do
  begin
    if (cells[acol,arow]=s[1]) or  (cells[acol,arow]=s[2])
      or (cells[acol,arow]=s[3])  or (cells[acol,arow]=s[4])
    then
    begin
      font.color:=clred;
      brush.color:=clLime;
    end
    else
    begin
      font.color:=clblack;
      brush.color:=clwhite;
    end;
    font.style:=[fsbold];
    fillRect(Rect);
    textout(rect.left+6, rect.top+6,cells[acol,arow]);
  end;
end;

{************* FormCloseQuery **************}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{User wants to exit - set stop flag in case solutions are being drawn}
begin
   tag:=1;
   canclose:=true;
end;

procedure Tform1.display(msg:string);
{show a message for 2 seconds}
var  s:string;
begin
  s:=msglbl.caption;
  msglbl.caption:=msg;
  screen.cursor:=crhourglass;
  msglbl.update; {make sure it displays}
  sleep(1500);
  msglbl.caption:=s; {restore label}
  screen.cursor:=crdefault;
end;

procedure TForm1.Grid1Click(Sender: TObject);
{user clicked a cell}
var
  i,j,k,sum:integer;
  str:string;
begin
  if nbrcount=0 then for i:=1 to 4 do s[i]:=''; {1st cell, clear all prev selected}
  inc(nbrcount);
  with grid1 do
  begin
    n[nbrcount]:=strtoint(cells[col,row]); {save value}
    s[nbrcount]:=cells[col,row]; {& save cell string}
  end;
  grid1.invalidate; {force redraw}
  if nbrcount=4 then {4 cells selected - check sum and add if a new solution}
  begin
    sum:=n[1]+n[2]+n[3]+n[4];
    if sum = 34 then
    begin
      {we need to sort the four numbers before adding them to the list so that
       we can recognize the same solution if user select it again, even in a
       different sequence}
      for i:=1 to 3 do {sort}
      for j:=i+1 to 4 do
      if n[j]<n[i] then begin k:=n[i]; n[i]:=n[j]; n[j]:=k; end; {swap}
      {make the key to add to list, make digits 2 characters long}
      str:=format('%2d,%2d,%2d,%2d',[n[1],n[2],n[3],n[4]]);
      i:=listbox1.items.indexof(str); {solution already found?}
      if i>=0 then  display('Solution '+str+' already found')
      else {new solution}
      begin
        listbox1.items.add(str); {add it to lst}
        listbox1.itemindex:=listbox1.items.count-1; {keep last addition in view}

        if listbox1.items.count=1 then str:=' user solution found.'
        else str:=' user solutions found.';  {just for he sake of good grammar}

        msglbl.caption:=inttostr(listbox1.items.count)+str;
        {make computer search button visible after 20 solutions have been found}
        if listbox1.items.count>=20 then  showbtn.visible:=true;
      end;
    end
    {else four #s were selected, but sum wasn't 34}
    else display(format('Sorry, %2d+%2d+%2d+%2d = %d',[n[1],n[2],n[3],n[4],sum]));
    nbrcount:=0;
  end;
end;

end.