type
tarr=array [0..8,0..8,0..8] of integer;
var
arr:tarr;
i,j,k,t,l,p:integer;
s:string;
procedure mat3(var i,j,p:integer);
begin
if j<3 then
begin
if i<3 then
p:=1
else if i>5 then
p:=3
else
p:=2;
end;
if (j>2) and (j<6) then
begin
if i<3 then
p:=4
else if i>5 then
p:=6
else
p:=5;
end;
if j>5 then
begin
if i<3 then
p:=7
else if i>5 then
p:=9
else
p:=8;
end;
end;
begin
for i:=0 to 8 do
for j:=0 to 8 do
if gr.Cells[i,j][1]='0' then
gr.Cells[i,j]:=inttostr(0);
gr.Font.size:=4;
p:=0;
for i:=0 to 8 do
for j:=0 to 8 do
for k:=0 to 8 do
arr[i,j,k]:=k+1;
for i:=0 to 8 do
for j:=0 to 8 do
if (strtoint(gr.Cells[i,j][1])<>0) then
begin
mat3(i,j,p);
case p of
1:begin
for t:=0 to 2 do
for l:=0 to 2 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
2:begin
for t:=3 to 5 do
for l:=0 to 2 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
3:begin
for t:=6 to 8 do
for l:=0 to 2 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
4:begin
for t:=0 to 2 do
for l:=3 to 5 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
5:begin
for t:=3 to 5 do
for l:=3 to 5 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
6:begin
for t:=6 to 8 do
for l:=3 to 5 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
7:begin
for t:=0 to 2 do
for l:=6 to 8 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
8:begin
for t:=3 to 5 do
for l:=6 to 8 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
9:begin
for t:=6 to 8 do
for l:=6 to 8 do
arr[t,l,strtoint(gr.Cells[i,j])-1]:=0;
end;
end;
for t:=0 to 8 do
begin
arr[i,t,strtoint(gr.Cells[i,j])-1]:=0;
arr[t,j,strtoint(gr.Cells[i,j])-1]:=0;
end;
end;
for i:=0 to 8 do
for j:=0 to 7 do
if length(gr.cells[i,j])=3 then
begin
s:=gr.cells[i,j];
for k:=j+1 to 8 do
if (gr.cells[i,k]=s) then
for t:=0 to 8 do
begin
arr[i,t,strtoint(s[2])-1]:=0;
arr[i,t,strtoint(s[3])-1]:=0;
end;
end;
for i:=0 to 8 do
for j:=0 to 8 do
for k:=0 to 8 do
begin
if (strtoint(gr.Cells[i,j][1])=0) and (arr[i,j,k]<>0) then
begin
gr.Cells[i,j]:=gr.Cells[i,j]+inttostr(arr[i,j,k]);
end;
end;
for i:=0 to 8 do
for j:=0 to 8 do
if length(gr.cells[i,j])=2 then
gr.Cells[i,j]:=gr.Cells[i,j][2];
for i:=0 to 8 do
for j:=0 to 7 do
if length(gr.cells[i,j])=3 then
begin
s:=gr.cells[i,j];
for k:=j+1 to 8 do
if (gr.cells[i,k]=s) then
for t:=0 to 8 do
begin
arr[i,t,strtoint(s[2])-1]:=0;
arr[i,t,strtoint(s[3])-1]:=0;
end;
end;