uses
  CRT;

const
  N=9;
  M=3;

type
  tCell=0..N;
  tBoard=array[1..N,1..N] of tCell;
  tList=set of tCell;

var
  Board:tBoard;
  List:tList;
  a,b,c, i,j,k,l, Total:byte;
  Ok,Done:boolean;

procedure ShowBoard(k,l:tCell);
var
  i,j,Bac:integer;
begin
  for i:=0 to N+1 do begin
    for j:=0 to N+1 do begin
      if i*j*(i-N-1)*(j-N-1)=0 then begin
        TextBackGround(7);Write('  ')
      end
      else begin
        if Odd(Pred(i) div M+Pred(j) div M) then Bac:=0 else Bac:=1;
        TextColor(7);TextBackGround(Bac);
        if Board[i,j]=0 then Write('  ') else begin
          Write(' ');
          if (i=k)and(j=l) then begin
            TextColor(15);TextBackGround(5);Write(Board[i,j]);
          end
          else Write(Board[i,j])
        end
      end
    end;
    TextBackGround(0);
    WriteLn
  end;
  WriteLn;
  If ReadKey=#27 then Halt
end;

procedure FillList(Cell:tCell);
begin
  if not (Cell in List) then begin
    List:=List+[Cell];
    Inc(Total);
    if Total=9 then begin
      WriteLn('No way!  ',i,'  ',j);
    end
  end
end;

procedure ReadBoard(Name:string);
var
  s:string;
  f:text;
begin
  Assign(f,Name);ReSet(f);
  for i:=1 to N do begin
    ReadLn(f,s);
    for j:=1 to N do if j<=Length(s) then case s[j] of
      '0'..'9':Board[i,j]:=Byte(s[j])-48;
      else Board[i,j]:=0
    end
    else Board[i,j]:=0
  end;
  Close(f)
end;

begin

  ReadBoard('sudoku.dat');
  ShowBoard(0,0);
  repeat
    Ok:=false;
    Done:=true;
    for i:=1 to N do for j:=1 to N do if Board[i,j]=0 then begin
      Done:=false;
      a:=Pred(i) div M*M;
      b:=Pred(j) div M*M;
      Total:=0;
      List:=[0];
      for k:=1 to N do begin
        FillList(Board[k,j]);
        FillList(Board[i,k]);
      end;
      for k:=Succ(a) to a+M do for l:=Succ(b) to b+M do FillList(Board[k,l]);
      if Total=8 then begin
        c:=1;
        while c in List do Incİ;
        Board[i,j]:=c;
        Ok:=true;
        ShowBoard(i,j)
      end
    end;
    if Done then WriteLn('Done!')
  until not Ok or Done;
  if not Done then WriteLn('Multiple choce')
end.