1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:

type
  TField = record
    FNum: Integer;
    FGroup: TPoint;
    FUsed: Boolean;
  end;

  TGrid = Array [0..8, 0..8] of TField;

var
  Form1: TForm1;
  Grid: TGrid; //Zahlengitter
  Level: Integer; //Tiefe der Rekursion
  Done: Boolean;

//Prüft ob eine Zahl in einer Zeile steht
function TForm1.NumInRow(GetGrid: TGrid; Row: Integer; Num: Integer): Boolean;
var
  x: Integer;
begin
  Result := false;
  for x := 0 to 8 do
    if GetGrid[x, Row].FNum = Num then
    begin
      Result := true;
      Exit;
    end;
end;

//Prüft ob eine Zahl in einer Spalte steht
function TForm1.NumInCol(GetGrid: TGrid; Col: Integer; Num: Integer): Boolean;
var
  y: Integer;
begin
  Result := false;
  for y := 0 to 8 do
    if GetGrid[Col, y].FNum = Num then
    begin
      Result := true;
      Exit;
    end;
end;

//Prüft ob eine Zahl in einer Gruppe/4x4-Quadrat steht
function TForm1.NumInGroup(GetGrid: TGrid; Group: TPoint; Num: Integer): Boolean;
var
  x, y: Integer;
begin
  Result := false;
  for x := 0 to 2 do
    for y := 0 to 2 do
    if GetGrid[Group.X * 3 + x, Group.Y * 3 + y].FNum = Num then
    begin
      Result := true;
      Exit;
    end;
end;

//Gibt zurück wie oft eine Zahl im Gitter steht
function TForm1.NumInGrid(GetGrid: TGrid; Num: Integer): Integer;
var
  x, y: Integer;
begin
  Result := 0;
  for x := 0 to 8 do
    for y := 0 to 8 do
    if GetGrid[x, y].FNum = Num then
      inc(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x, y: Integer;
begin
  for x := 0 to 5 do
    for y := 0 to 5 do
    begin
      Grid[x,y].FNum := 0;
      Grid[x,y].FGroup := Point(x div 3, y div 3);
      Grid[x,y].FUsed := false;
    end;

  Label1.Caption := TimeToStr(Now);
  Label1.Refresh;

  Level := 0;
  Done := false;
  SetNum(Grid, 1);

  Label2.Caption := TimeToStr(Now);
end;

procedure TForm1.SetNum(GetGrid: TGrid; Num: Integer);
var
  RecGrid: TGrid;
  x, y: Integer;
  i: Integer;
  IndexList: array of TPoint;
begin
  RecGrid := GetGrid; //Grid kopieren

  if Num > 9 then
    Num := 1;

  for x := 0 to 8 do
    for y := 0 to 8 do
      RecGrid[x,y].FUsed := false;

  inc(Level); //Level erhöhn

  //Beenden wenn alle Zahlen gesetzt sind
  if Level = 81 then
  begin
    Grid := RecGrid;
    Done := true;
    Exit;
  end;

  //So oft wiederholen wie noch Zahlen benutzt werden können
  repeat
    SetLength(IndexList, 0);
    for x := 0 to 8 do
      for y := 0 to 8 do
        if (RecGrid[x,y].FNum = 0) and //Position ist leer
           (not RecGrid[x,y].FUsed) and //Zahl wurde noch nicht benutzt
           (not NumInRow(RecGrid, y, Num)) and //Zahl steht nicht in Reihe
           (not NumInCol(RecGrid, x, Num)) and //Zahl steht nicht in Spalte
           (not NumInGroup(RecGrid, Point(x div 3, y div 3), Num)) and //Zahl steht nicht in Gruppe
           ((NumInGrid(RecGrid, Num) = 0) or //Zahl steht noch nicht im Grid
            //Zahl steht senk- oder waagerecht zu einer Gruppe mit gleicher Zahl
            (NumInGroup(RecGrid, Point(x div 3, 0), Num)) or
            (NumInGroup(RecGrid, Point(x div 3, 1), Num)) or
            (NumInGroup(RecGrid, Point(x div 3, 2), Num)) or
            (NumInGroup(RecGrid, Point(0, y div 3), Num)) or
            (NumInGroup(RecGrid, Point(1, y div 3), Num)) or
            (NumInGroup(RecGrid, Point(2, y div 3), Num))) then
        begin
          //Position zu IndexList hinzufügen
          SetLength(IndexList, Length(IndexList)+1);
          IndexList[Length(IndexList)-1] := Point(x,y);
        end;

    //Abbrechen wenn keine Zahl gefunden wurde
    if Length(IndexList) = 0 then
      break;

    //Eine Zahl zufällig raussuchen
    Randomize;
    i := Random(Length(IndexList)-1);

    //Zagl ins StringGrid und RecGrid schreiben
    StringGrid.Cells[IndexList[i].X,IndexList[i].Y] := IntToStr(Num);
    StringGrid.Refresh;
    RecGrid[IndexList[i].X,IndexList[i].Y].FNum := Num;

    SetNum(RecGrid, Num+1); //Nächste Zahl setzen

    if Done then //Abbrechen wenn fertig
      Exit;

    //Zahl aus dem StringGrid und RecGrid entfernen
    RecGrid[IndexList[i].X,IndexList[i].Y].FNum := 0;
    StringGrid.Cells[IndexList[i].X,IndexList[i].Y] := '';
    StringGrid.Refresh;

    //Zahl als benutzt markieren
    RecGrid[IndexList[i].X,IndexList[i].Y].FUsed := true;

  until Length(IndexList) <= 1;

  dec(Level); //Level verringern
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

1|5| |7| | |6| |8
8|2|7|6| |4|9|1|3
4|6| |3|9| | |2|
-----|-----|-----
2|7|6|4|3| | | |
 |8|3| |2|1|5| |9
 |1|5|9|7|6|3|8|2
-----|-----|-----
 | |8| |4|7|2|3|6
5| | |1| |9| |4|
 |4|1| | |3| |5|