unit sudokuUnit1_Solver;

interface  //enhanced and convert to maXbox , locs=496

{uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, jpeg, ExtCtrls, ComCtrls;    }

type TEntscheidungsfolge = array[1..81] of Record
        id:  integer;
        x:   integer;
        y:   integer;
        falsch: array[1..9] of integer;
      end;

type
  TForm1 = TForm;
  var
    StringGrid1: TStringGrid;
    StartBtn: TBitBtn;
    LoeseBtnIti: TBitBtn;
    ResetBtn: TBitBtn;
    LoeseBtn: TBitBtn;
    Label1: TLabel;
    Image1: TImage;
    StatusBar1: TStatusBar;
       procedure TForm1StartBtnClick(Sender: TObject);
       function TForm1Read(x,y:integer):string;
       procedure TForm1Write(x,y:integer;text:string);
       //function CheckZeile(var feld:sudokuFeld; Zeile,Wert:integer):boolean;
       function TForm1CheckZeile(Zeile,Wert:integer):boolean;
       function TForm1CheckSpalte(Spalte,Wert:integer):boolean;
       function TForm1CheckBlock(Spalte,Zeile,Wert:integer):boolean;
       procedure TForm1ResetBtnClick(Sender: TObject);
       function TForm1Check(Spalte,Zeile,Wert:integer):boolean;
       function TForm1komplett():boolean;
       procedure TForm1leer();
       procedure TForm1LoeseBtnClick(Sender: TObject);
       procedure TForm1loesen();
       procedure TForm1LoeseBtnItiClick(Sender: TObject);
       procedure TForm1FormCreate(Sender: TObject);
       function TForm1skomplett(nix:boolean):boolean;
       procedure TForm1allcheck();

  //private
    { Private-Deklarationen }
 // public
    { Public-Deklarationen }
  //end;

var
  Form1: TForm1;
  //sudokuFeld:array[1..9] of array[1..9] of TPoint;
  freifeld:TPoint;
  falschZahl: array[1..9] of integer;
  efnummer:integer;
  checkstop:boolean;

implementation

//{$R *.dfm}

procedure TForm1allcheck();
var i,j:integer;
begin
  for i:=0 to 8 do begin
    for j:=0 to 8 do begin
    if (StrToIntDef(TForm1Read(i,j),0)= 0) and (TForm1Read(i,j)<>'') then
     begin
      showmessage('Falsche Eingabe in '+IntToStr(i)+' | '+IntToStr(j)+' !');
      checkstop:=true;
     end;
    end;
  end;
end;

procedure TForm1loesen();
var Zeile, Spalte,Wert:integer;
begin
 TForm1leer();
 Spalte:=freifeld.X;
 Zeile:=freifeld.Y;
 if Zeile<>-1 then
 for Wert:=1 to 9 do
  if TForm1check(Spalte,Zeile,Wert)=true then begin
   TForm1Write(spalte,zeile,IntToStr(Wert));
   Application.ProcessMessages;
   TForm1Loesen();
  if TForm1komplett()=false then
   TForm1Write(spalte,zeile,'');
 end;
end;

procedure TForm1leer();
var i,j,zeile,spalte:integer;
begin
  i:=0;
  spalte:=0;
  Zeile:=0;
  while i<9 do begin
    j:=0;
    while j<9 do begin
      if (TForm1Read(i,j)='') or (TForm1Read(i,j)=' ') then begin
        spalte:=i;
        zeile:=j;
        end;
      j:=j+1;
    end;
    i:=i+1;
  end;
  //if spalte=0 then begin asm int 3 end; end;
  freifeld.X:=spalte;
  freifeld.y:=zeile;
end;

function TForm1CheckZeile(Zeile,Wert:integer):boolean;
var i:integer;
begin
  result:=true;
  i:=0;
  while i<9 do begin
   if StrToIntDef(TForm1Read(i,zeile),0)=wert then begin
      result:=false;
      exit;
    end;
    i:=i+1;
   end;
end;

function TForm1CheckSpalte(Spalte,Wert:integer):boolean;
var i:integer;
begin
  result:=true;
  i:=0;
  while i<9 do begin
   if StrToIntDef(TForm1Read(spalte,i),0)=wert then begin
      result:=false;
      exit;
    end;
    i:=i+1;
   end;
end;

function TForm1CheckBlock(Spalte,Zeile,Wert:integer):boolean;
var i,j:integer;
begin
  result:=true;
  i:=0;

  if (Spalte<3) and (Zeile<3) then begin Spalte:=0; Zeile:=0; end;                    //1
  if (Spalte>2) and (Spalte<6) and (Zeile<3) then begin Spalte:=3; Zeile:=0; end;     //2
  if (Spalte>5) and (Zeile<3) then begin Spalte:=6; Zeile:=0; end;                    //3
  if (Spalte<3) and (Zeile>2) and (Zeile<6) then begin Spalte:=0; Zeile:=3; end;      //2-1
  if (Spalte>2) and (Spalte<6) and (Zeile>2) and (Zeile<6) then begin Spalte:=3; 
                         Zeile:=3; end;           //2-2
  if (Spalte>5) and (Zeile>2) and (Zeile<6) then begin Spalte:=6; Zeile:=3; end;      //2-3
  if (Spalte<3) and (Zeile>5) then begin Spalte:=0; Zeile:=6; end;                    //3-1
  if (Spalte>2) and (Spalte<6) and (Zeile>5) then begin Spalte:=3; Zeile:=6; end;     //3-2
  if (Spalte>5) and (Zeile>5) then begin Spalte:=6; Zeile:=6; end;                    //3-3

  while i<3 do begin
   j:=0;
   while j<3 do begin
    if StrToIntDef(TForm1Read(Spalte+i, Zeile+j),0)=Wert then begin Result:=False; exit; end;
    j:=j+1;
   end;
   i:=i+1;
  end;
  end;

function TForm1Check(Spalte,Zeile,Wert:integer):boolean;
begin
  result:=false;
   if (TForm1CheckSpalte(Spalte,Wert)=true)
   and (TForm1CheckZeile(Zeile,Wert)=true)
   and (TForm1CheckBlock(Spalte,Zeile,Wert)=true) then result:=true;
end;

function TForm1komplett():boolean;
var i,j:integer;
begin
  result:=true;
  i:=0;
  while i<9 do begin
    j:=0;
    while j<9 do begin
     if StrToIntDef(TForm1Read(i,j),0)=0 then begin result:=false; exit; end;
     j:=j+1;
    end;
   i:=i+1;
   end;
end;

function TForm1Read(x,y:integer):string;
begin
  result:=StringGrid1.Cells[x,y];
  
  //showmessage(result);
end;

var
  ColorSel : array[0..1] of TColor; // = (clWhite, clBlack);

procedure TForm1FormCreateCellColor(Sender: TObject);
var
  r, c: Integer;
begin
  StringGrid1.RowCount := 10;
  StringGrid1.ColCount := 6;
  for c := 1 to StringGrid1.ColCount - 1 do
    for r := 1 to StringGrid1.RowCount - 1 do begin
      StringGrid1.Cells[c, r] := Format('C: %d R: %d', [c, r]);
      //StringGrid1.Objects[c, r] := TObject(ColorSel[Odd(c)]);
    end;
end;

procedure TForm1StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;  
                     Rect: TRect; State: TGridDrawState);
begin
  if (ACol = 3) and (ARow = 2) then
    with TStringGrid(Sender) do begin
      //paint the background Green
      Canvas.Brush.Color := clGreen;
      Canvas.FillRect(Rect);
      Canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol, ARow]);
    end;
end;



procedure StringGrid1DrawCell4(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
i:integer;  
begin
  //with (Sender as TStringGrid) do
  with TStringGrid(sender) do begin
        Canvas.FillRect(Rect);
        DrawText (Canvas.Handle,
            PChar(Cells[ACol, ARow]),
            Length(Cells[ACol, ARow]),
            Rect, DT_WORDBREAK or DT_EXPANDTABS or DT_CENTER);
    end;
    for i:=2 to  StringGrid1.RowCount - 1 do
    if StringGrid1.Cells[3,i]='' then begin
        StringGrid1.Canvas.Brush.Color:=clRed;
          if ((ACol=3)and(ARow=i)) then begin
              StringGrid1.Canvas.FillRect(Rect);

            end;
      end;
end;


procedure TForm1Write(x,y:integer; text:string);
begin
  StringGrid1.font.color:=clred;
  StringGrid1.Cells[x,y]:=text;
  //StringGrid1.font.color:=clblack;
end;

procedure TForm1StartBtnClick(Sender: TObject);
var i,j,x,y:Integer;
begin
   for i:=1 to 12 do begin
        randomize;
        sleep(1);
        j:=1+random(8);
        x:=random(9);
        y:=random(9);
        //showmessage(IntToStr(j)+' X'+IntToStr(x)+' Y'+IntToStr(y));
        if TForm1Check(x,y,j)=true then TForm1Write(x,y,IntToStr(j));
      end;

//StringGrid1.Cells[1,2]:='alpha';
end;

procedure TForm1ResetBtnClick(Sender: TObject);
var i,j:integer;
begin
 i:=8;
 while i>-1 do begin
  j:=8;
  while j>-1 do begin
    TForm1Write(i,j,'');
    j:=j-1;
  end;
  i:=i-1;
 end;
end;

procedure TForm1LoeseBtnClick(Sender: TObject);
var zeit:integer;
begin
   zeit:=GetTickCount();
   checkstop:=false;
   TForm1allcheck();
   if checkstop=false then
   TForm1loesen();
   zeit:=GetTickCount()-zeit;
   Label1.Caption:=IntToStr(zeit)+' ms';
   StatusBar1.Panels[0].Text:= 'Solved in: '+IntToStr(zeit)+' ms';
end;

procedure TForm1LoeseBtnItiClick(Sender: TObject);
var i,r,k,f1,x,y,j:integer;
    ef:TEntscheidungsfolge;
    found:boolean;
begin
    i:=0;
    r:=0;
    k:=0;
     while i<1000 do begin
      found:=false;
      TForm1leer;
      x:= Freifeld.X;
      y:= Freifeld.Y;
      j:=1;
      while j<10 do begin
       if TForm1Check(x,y,j)=true then begin
        if j<>ef[efnummer].falsch[j] then begin
         TForm1Write(x,y,IntToStr(j));
         efnummer:=efnummer+1;
         ef[efnummer].Id:=j;
         ef[efnummer].X:=x;
         ef[efnummer].Y:=y;
         found:=true;
         break;
         end;
         end;
          while r<9 do begin
            if r=ef[efnummer].falsch[r] then k:=k+1;
            r:=r+1;
          end;
          if k>7 then begin
           efnummer:=efnummer-1;
           f1:=ef[efnummer].id;
           ef[efnummer].falsch[f1]:=f1;
           TForm1Write(ef[efnummer].x,ef[efnummer].y,'');
           showmessage('Done, master max');
           found:=true;
          end;

       j:=j+1;
       end;
      if found=false then begin
        efnummer:=efnummer;
        ef[efnummer].falsch[j]:=j;
      end;
     i:=i+1;
     end;
end;

procedure TForm1FormCreate(Sender: TObject);
begin
  efnummer:=0;
  writeln('form create call')
end;

function TForm1skomplett(nix:boolean):boolean;
var i,j:integer;
begin
 i:=0;
 result:=true;
  while i<9 do begin
     j:=0;
     while j<9 do begin
      if StrToIntDef(TForm1Read(i,j),0)= 0 then result:=false;
      end;
     end;
end;

procedure loadSudokuForm;
begin
Form1:= TForm1.create(self)
with form1 do begin
  setBounds(211, 131, 463, 447)
  Caption := 'Sudoku Solver Revolver'
  Color := clActiveCaption
  Font.Charset := DEFAULT_CHARSET
  Font.Color := clWindowText
  Font.Height := -11
  Font.Name := 'MS Sans Serif'
  Font.Style := []
  OldCreateOrder := False
  OnCreate := @Tform1FormCreate ;
  PixelsPerInch := 96
  //TextHeight := 13
  end;
  Label1:= TLabel.create(form1)
  with label1 do begin
  parent:= form1;
  SetBounds(336, 216, 3, 13)
  end;
  Image1:= TImage.create(form1)
  with image1 do begin
  parent:= form1;
    Left := 17
    Top := 17
    Width := 434
    Height := 390
    //Picture.bitmap.Data := {
    Picture.bitmap.loadfromres(Hinstance, 'TCHECKERS');
    end;
  StringGrid1:= TStringGrid.create(form1)
  with stringgrid1 do begin
  parent:= form1
    Left := 16
    Top := 80
    Width := 301
    Height := 301
    ColCount := 9
    font.size:= 15;
    DefaultColWidth := 32
    DefaultRowHeight := 32
    FixedCols := 0
    RowCount := 9
    FixedRows := 0
    Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, 
        goRangeSelect, goEditing, gorangeselect]
    //TabOrder := 0
  end;
  StartBtn:= TBitBtn.create(self)
  with startbtn do begin
  parent:= form1
    Left := 336
    Top := 88
    Width := 95
    Height := 25
    Caption := 'Startvalues'
    TabOrder := 1
    OnClick := @TForm1StartBtnClick;
    glyph.loadfromres(Hinstance, 'TCHECKERS');
  end;
  LoeseBtnIti:= TBitBtn.create(form1)
  with loesebtniti do begin
  parent:= form1
    Left := 336
    Top := 304
    Width := 95
    Height := 25
    //Caption := 'L'#246'senIti'
    Caption := 'SolverITI'
    TabOrder := 2
    Visible := False
    OnClick := @TForm1LoeseBtnItiClick;
  end;
  //object ResetBtn: TBitBtn
  resetbtn:= TBitBtn.create(form1)
  with resetbtn do begin
  parent:= form1
  glyph.loadfromres(Hinstance, 'TROTATETOOL');
    Left := 336
    Top := 168
    Width := 95
    Height := 25
    Caption := 'Reset_'
    TabOrder := 3
    OnClick := @TForm1ResetBtnClick
  end;
  //object LoeseBtn: TButton
   loesebtn:= TBitBtn.create(form1)
   with loesebtn do begin
   parent:= form1
    Left := 336
    Top := 128
    Width := 95
    Height := 25
    //Caption := 'L'#246'sen'
    Caption := 'Solve...'
    TabOrder := 4
    glyph.loadfromres(Hinstance, 'TSELECTORTOOL');
    OnClick := @TForm1LoeseBtnClick;
  end;
  StatusBar1:= TStatusBar.create(form1)
  with statusbar1 do begin
  parent:= form1;
    Left := 0
    Top := 390
    Width := 427
    Height := 19
    Panels.Add;
    //Panels := <>
  end;
  Form1.Show;
  TForm1FormCreate(self)
end;


begin //@main

  writeln('sudoku solver...')
  loadSudokuForm;
  StatusBar1.Panels[0].Text:= 'Today is: '+ FormatDateTime('dd/mm/yyyy hh:nn:ss', Now);

end.