unit umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TSudoku = array[1..9,1..9] of 0..9;
type
TForm1 = class(TForm)
Button1: TButton;
cmbMode: TComboBox;
grpAns: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure EditKeyPress(Sender: TObject; var Key: Char);
procedure ReadInSud;
procedure Button1Click(Sender: TObject);
procedure cmbModeChange(Sender: TObject);
procedure sudFill(s:TSudoku);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Sud:TSudoku;
Ans:array of TSudoku;
CEdits:array[1..9,1..9] of TEdit;
var
Form1: TForm1;
cmbMode:TComboBox;
mlen:integer; // необходимое количество решений
implementation
{$R *.dfm}
function sudInLine(s:TSudoku;p:TPoint;v:integer):boolean;
var
i:1..9;
begin
Result:=True;
for i:=1 to 9 do
if p.y<>i then
if s[p.X,i]=v then Exit;
Result:=False;
end;
function sudInRow(s:TSudoku;p:TPoint;v:integer):boolean;
var
i:1..9;
begin
Result:=True;
for i:=1 to 9 do
if p.x<>i then
if s[i,p.Y]=v then Exit;
Result:=False;
end;
function sudInSq(s:TSudoku;p:TPoint;v:integer):boolean;
var
ix,iy:0..8;
lx,ly:0..8;
begin
lx:=0; ly:=0;
if p.x in [1,2,3] then lx:=1;
if p.x in [4,5,6] then lx:=4;
if p.x in [7,8,9] then lx:=7;
lx:=lx-1;
if p.y in [1,2,3] then ly:=1;
if p.y in [4,5,6] then ly:=4;
if p.y in [7,8,9] then ly:=7;
ly:=ly-1;
Result:=True;
for ix:=1 to 3 do
for iy:=1 to 3 do
if (p.x<>lx+ix) and (p.y<>ly+iy) then
if s[lx+ix,ly+iy]=v then Exit;
Result:=False;
end;
function sudInAny(s:TSudoku;p:TPoint;v:integer):boolean;
begin
Result:=sudInLine(s,p,v) or sudInRow(s,p,v) or sudInSq(s,p,v);
end;
function IsNextUnknown(s:TSudoku;var p:TPoint):boolean;
var
ix,iy:1..9;
begin
Result:=False;
for ix:=1 to 9 do
for iy:=1 to 9 do
if s[ix,iy]=0 then begin
Result:=True;
p.X:=ix;
p.Y:=iy;
Exit;
end; // if
end;
function sudMod(s:TSudoku;p:TPoint;v:integer):TSudoku;
var
st:TSudoku;
begin
st:=s;
st[p.x,p.y]:=v;
Result:=st;
end;
procedure sudAddAns(s:TSudoku);
var
l:integer;
begin
l:=Length(ans);
SetLength(ans,l+1);
ans[l]:=s;
end;
function DoRec(s:TSudoku):boolean;
var
i:integer;
p:TPoint;
begin
Result:=True;
if IsNextUnknown(s,p) then begin // запуск рекурсий
for i:=1 to 9 do
if not sudInAny(s,p,i) then
if DoRec(sudMod(s,p,i)) then
Exit;
end else begin // сохранение результата
sudAddAns(s);
end;
if Length(ans)<mlen then // не хватает результатов
Result:=False;
end; // DoRec
procedure TForm1.ReadInSud;
var
ix,iy:integer;
CEdit:TEdit;
begin
for iy:=1 to 9 do
for ix:=1 to 9 do begin
CEdit:=CEdits[ix,iy];
if CEdit.Text = '' then
Sud[ix,iy]:= 0
else
Sud[ix,iy]:=StrToInt(CEdit.Text);
end; // for
end;
function IsValidSudoku(s:TSudoku):boolean;
var
ix,iy:integer;
p:TPoint;
begin
for ix:=1 to 9 do
for iy:=1 to 9 do begin
p.X:=ix;
p.Y:=iy;
if s[ix,iy] <> 0 then
if sudInAny(s,p,s[ix,iy]) then begin
Result:=False;
Exit;
end; // if
end; // for
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ix,iy:integer;
begin
for iy:=1 to 9 do
for ix:=1 to 9 do begin
CEdits[ix,iy]:=TEdit.Create(self);
with CEdits[ix,iy] do begin
Parent:=self;
Left:= (ix - 1) * 30 + 5;
Top:= (iy - 1) * 30 + 5;
Width:= 25;
Color:= self.Color;
MaxLength:= 1;
Ctl3D:= False;
OnKeyPress:=EditKeyPress;
end; // with
end; // for, ix
end;
procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
var
ci:integer;
ix,iy:integer;
CEdit:TEdit;
begin
for iy:=1 to 9 do
for ix:=1 to 9 do
if Sender is TEdit then
if (Sender as TEdit)=CEdits[ix,iy] then
CEdit:=CEdits[ix,iy];
if (Sender as TEdit)=CEdits[9,9] then
Exit;
if Pos(Key,'0123456789'#8) = 0 then
Key:= #0;
if Key <> #8 then begin
ci:=CEdit.ComponentIndex;
(self.Components[ci+1] as TEdit).SetFocus;
end; // if
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
l:integer;
begin
ans:=nil;
ReadInSud;
if not IsValidSudoku(sud) then begin
ShowMessage('повторение в исходном');
Exit;
end; // if
if grpAns.ItemIndex = 0 then
mlen:=1
else
mlen:=1000;
DoRec(sud);
l:=length(ans);
showmessage('решений: '+IntToStr(l));
cmbMode.Clear;
cmbMode.Items.Add('исходное');
for i:=1 to l do
cmbMode.Items.Add('решение '+IntToStr(i));
cmbMode.ItemIndex:=0;
end;
procedure TForm1.sudFill(s:TSudoku);
var
ix,iy:integer;
begin
for iy:=1 to 9 do
for ix:=1 to 9 do
CEdits[ix,iy].Text:=IntToStr(S[ix,iy]);
end;
procedure TForm1.cmbModeChange(Sender: TObject);
begin
if cmbMode.ItemIndex = 0 then
SudFill(sud)
else
SudFill(ans[cmbMode.ItemIndex-1]);
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Pen.Width:=3;
Canvas.MoveTo(2,2);
Canvas.LineTo(272,2);
Canvas.LineTo(272,266);
Canvas.LineTo(2,266);
Canvas.LineTo(2,2);
Canvas.Pen.Width:=2;
Canvas.MoveTo(2,88+2);
Canvas.LineTo(272,88+2);
Canvas.MoveTo(2,88*2+2);
Canvas.LineTo(272,88*2+2);
Canvas.MoveTo(90+2,2);
Canvas.LineTo(90+2,266);
Canvas.MoveTo(90*2+2,2);
Canvas.LineTo(90*2+2,266);
end;
end.