1:

MainForm.ParanoiaLabel1.Caption := 'Test1 (' + IntToStr(col) + '/' + IntToStr(row) + ')';                    

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

procedure TSudoku.Solve(SolutionList: TSolutionList;Anzahl:integer);
(* Schreibt maximal Anzahl Lösungsmöglichkeiten des Sudoku in eine Liste *)
var
  S: TSudoku;
  P: TPossibility;
  col, row, i: integer;
begin
  IF SolutionList.Count >= Anzahl then
    exit;
....                    

1:
2:
3:
4:
5:
6:
7:
8:

{Zeile 374..}
For ...
  S:=TSudoku.Create;
  S.CopyFrom(self);
  S.FCells[col, row]:=$001 ShL i;{Einfuege neuen Probe Wert}
  minDepth:=S.Solve(Solutions, maxDepth-1, FindMulti)+1;
>>>freeAndNil(S);// Hau weg den .....
  if (minDepth > 0) and (minDepth < Result) then Result:=minDepth;Deine                    

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:

  procedure Wirbeln(var outW:tArrValue);
    var
    n_Fak,i : Cardinal;
    j,Pos,hilf : Tvalue;
    begin
    n_Fak := 1;
    For i := 0 to 8 do
      begin
      n_Fak := n_Fak*i;
      outW[i] := i+1;  //[1,2,3,4,5,6,7,8,9]
      end;
    (* Eine Kombination aus n! waehlen *)
    i := Random(n_Fak);
    (* Kombination erstellen *)
    For j := high(TValue) downto 1 do
      begin
      Pos := i mod j;
      i := i div j;
      If Pos<> j then
        begin
        hilf := outW[Pos];
        outW[Pos] := outW[j];
        outW[j] := hilf;
        end;
      end;                    

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

{consqr= 3;
ConSide = consqr*consqr;}
   i := 0;
   repeat
     Pos := 0;
     Wirbeln(WirbelFeld);
     for col := i to i+conSqr-1 do
       for row := i to i+conSqr-1 do
         begin
         inc(pos);
         InsertValAt(WirbelFeld[pos],col,row);
         end;
     inc(i,conSqr);
   until i = ConSide;                    

1:
2:
3:
4:
5:
6:
7:

Pos := random(2);
while Pos < 81 do 
  begin
  Sudoku.Fcells[Pos Div 9,Pos mod 9]=$000;
  inc(pos,random(2)+1);
  end;
{Streicht etwa 52 Stellen)                    

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:

procedure Perm3x();
var
  i,j,block : Byte;
  x         : String;
  tmp       : Integer;
  tmpS      : String;
begin
  // wählt drei unabhängige Blöcke aus (dafür existieren 6 Möglichkeiten):
  // (Die obere Grenze von RandomRange ist entgegen der DOH nicht inklusive.)
  block := RandomRange(0,6);
  x := nthPerm('147', block);

  // Schreibt 3 zufällige Permutationen der Ziffernfolge 1..9 in
  // die drei oben ausgewählten Blöcke:
  for i := 1 to 3 do
  begin
    tmp := RandomRange(0, 362800);
    tmpS := nthPerm('123456789', tmp);
    for j := 0 to 8 do
    begin
      doneAr[StrToInt(x[i])+(j mod 3),(i*3)-2+(j div 3)] := StrToInt(tmpS[j+1]);
    end;
  end;
end;

procedure BTsolve(var xxAr: TdoneAr);
var
  ex2 : Boolean;

  procedure BTsolveInt(xAr: TdoneAr; y, count: Integer);
  var
    i,j,k,p,q : Byte;
    x         : Word;
    ex        : Boolean;
  begin
    inc(count);
    Form1.ProgressBar1.Position := count;
    for i:=y to 9 do
      for j:=1 to 9 do
        if xAr[i,j]=0 then
        begin
          // CheckPossible gibt die möglichen Belegungen eines Feldes in 
          // Form gesetzter Bits in einem Word-Wert zurück:
          x := CheckPossible(i,j,xAr);
          for k:=1 to 9 do
            if not (x and (1 shl k) = 0) then
            begin
              ex := false;
              if ex2 then exit;
              if count < 55 then
              begin
                xAr[i,j] := k;
                doneAr[i,j] := k;
                // CheckConsistent überprüft ob es an der angegebenen 
                // Stelle Widersprüche im Sudoku gibt:
                for p:=1 to 9 do
                  for q:=1 to 9 do
                    if not CheckConsistent(p,q,xAr) then ex:=true;
                if not ex then
                  BTsolveInt(xAr, i, count);
              end else ex2 := true;
            end else if k=9 then exit;
        end else if (i=9) and (j=9) then ex2 := true;
  end;

begin
  ex2 := false;
  BTsolveInt(xxAr, 1, 0);
end;                    

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:

000 060 128
001 000 094
003 001 000

200 400 060
706 000 903
030 006 002

300 200 456
852 600 700
164 050 200  


einzige Lösung:

475 963 128
681 725 394
923 841 675

218 439 567
746 582 913
539 176 842

397 218 456
852 694 731
164 357 289