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:

type
  TBWMap = array [1..3] of array [1..3] of boolean;

var
  done: boolean;

procedure Switch(var map: TBWMap; x, y: byte);
begin
  if (x < 1) or (x > 3) then
    exit;
  if (y < 1) or (y > 3) then
    exit;
  map[x, y] := not map[x, y];
  if (x > 1) then
    map[x - 1, y] := not map[x - 1, y];
  if (x < 3) then
    map[x + 1, y] := not map[x + 1, y];
  if (y > 1) then
    map[x, y - 1] := not map[x, y - 1];
  if (y < 3) then
    map[x, y + 1] := not map[x, y + 1];
end;

function WinCheck(map: TBWMap): boolean;
var
  X, Y, Z: byte;
begin
  Z := 0;
  for X := 1 to 3 do
    for Y := 1 to 3 do
      Z := Z + byte(Map[X, Y]);
  Result := (Z = 0) or (Z = 9);
end;

function Search(map: TBWMap; var iterations: integer): string;
  procedure RecSearch(map: TBWMap; x, y: byte; astr: string; var iterations: integer);
   begin
     inc(iterations);
     if iterations > 0 then
       astr := astr + '[' + inttostr(x) + '|' + inttostr(y) + ']';
     if (not wincheck(map)) and (not done) then
     begin
       astr := astr + '; ';
       Switch(map, x, y);
       if (x <> 1) and (y <> 1) then
         RecSearch(map, 1, 1, astr, iterations);
       if (x <> 1) and (y <> 2) then
         RecSearch(map, 1, 2, astr, iterations);
       if (x <> 1) and (y <> 3) then
         RecSearch(map, 1, 3, astr, iterations);
       if (x <> 2) and (y <> 1) then
         RecSearch(map, 2, 1, astr, iterations);
       if (x <> 2) and (y <> 2) then
         RecSearch(map, 2, 2, astr, iterations);
       if (x <> 2) and (y <> 3) then
         RecSearch(map, 2, 3, astr, iterations);
       if (x <> 3) and (y <> 1) then
         RecSearch(map, 3, 1, astr, iterations);
       if (x <> 3) and (y <> 2) then
         RecSearch(map, 3, 2, astr, iterations);
       if (x <> 3) and (y <> 3) then         
         RecSearch(map, 3, 3, astr, iterations);
     end else
       done := true;
   end;
var
  astr: string;
begin
  astr := '';
  done := false;
  RecSearch(map, 2, 2, astr, iterations);
  result :=  astr;
end;					

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

procedure TMainForm.Button1Click(Sender: TObject);
var
  iterations: integer;
begin
  iterations := 0;
  showmessage(Search(map, iterations) + ' nach ' + inttostr(iterations) + ' Iterationen');
end;					

1:
2:

Form1.Memo1.lines.Add(astr); 
sleep(500);