path: root/SlitherlinkUnit.pas

unit SlitherlinkUnit;

{$DEFINE norandomize}
{$DEFINE preSchleifenTest}
{$DEFINE vorLoesen}
{$DEFINE SchleifenFrueherkennung}

interface

uses
{$IFDEF debug}
Dialogs,
{$ENDIF}
ExtCtrls, Controls, Sysutils, Math, Graphics, Classes, ComCtrls, Types,
RaetselFileUnit;

type
  TPerm = array of Integer;
  TOptionen = class
              private
               function rA: integer;
               function rKantenfarbe(Kante: integer; SKante,lokOK,OK: boolean): TColor;
              public
               Schriftgroesse:   integer;
               errFarbe,OKFarbe,
               sFarbe:           array[boolean] of TColor;
               KFarbe:           array[-1..1] of TColor;
               property A: integer read rA;
               property Kantenfarbe[Kante: integer; SKante,lokOK,OK: boolean]: TColor read rKantenfarbe;
               constructor create;
               destructor destroy; override;
              end;
  TFeld = class
          private
           {$IFDEF debug}
           zaehler,tiefe:          Integer;
           ErzeugungsVersuche:     Integer;
           t0,t1,t2,t3,t4:         extended;
           {$IFDEF vorLoesen}
           tvorloesen,tnachloesen: extended;
           {$ENDIF}
           {$ENDIF}
           _Schleife:      Boolean;
           Wohin:          TImage;
           _oben,_links:   integer;
           lmx,lmy:        integer;
           _Breite,_Hoehe: integer;                // in Feldern
           _Parent:        TWinControl;
           _rlSchritt,                             // Knoten->Knoten
           _rlKante,                               // Knoten->Kante
           _rlFeld,                                // Knoten->Feld
           _rlFKante:      array[0..3] of Integer; // Feld->Kante   (für rekursivLoesen)
           _KantenPerm,
           _FelderPerm:    TPerm;
           Geschichte:     array of TPoint;
           {$IFDEF preSchleifenTest}
           Zusammenhang:   array of integer;       // Zusammenhangskomponentenzugehörigkeit der Kanten   (für rekursivLoesen)
           {$ENDIF}
           {$IFDEF vorLoesen}
           _vlKanten:      array of integer;       // Kantenmerker für vorLoesen (und nachLoesen)
           {$ENDIF}
           procedure wOben(O: integer);
           procedure wLinks(L: integer);
           procedure wBreite(B: integer);
           procedure wHoehe(H: integer);
           function zBreite: integer;
           function zHoehe: integer;
           procedure FKinitialisieren;
           procedure WohinMouseUp(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
           procedure WohinMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
           function ersteFreieKante: integer;
           procedure LoesungInitialisieren;
           {$IFDEF preSchleifenTest}
           procedure ZusammenhangInitialisieren;
           {$ENDIF}
           function rekursivLoesen(Knoten: integer; LoesungBehalten,EndeBeiEins,warKante: boolean): integer;
           function allesOkay: boolean;
           function FelderOkay: boolean;
           function FeldOkay(i: integer): boolean;
           function KanteOkay(i: integer): boolean;
           procedure PermErzeugen(n: integer; var Perm: TPerm);
           procedure kantenPermErzeugen;
           procedure felderPermErzeugen;           // verwendet Magie
           function rKannRueckGaengig: boolean;
           function Schlaufe: Integer; // 0 = nein, 1 = ja, 2 = schön
           {$IFDEF preSchleifenTest}
           function inZusammenhangKomp(Knoten: Integer): integer;  // In welcher Zshg.-Komponente liegt der Knoten?
           {$ENDIF}
           {$IFDEF vorLoesen}
           procedure vorLoesen(var sKn,SRtg: integer);
           procedure nachLoesen;
           {$ENDIF}
           procedure wSchleife(S: boolean);
           function FesteKante(I: Integer): integer; // 0=nein; 1=fest weg; 2=fest da
           function festesFeld(I: Integer): boolean;
           procedure inDieserSituationTutMan(I: Integer);
          public
           Felder:       array of Integer; // -1 = leer
           Kanten:       array of Integer; // -1 = leer, 0 = weg, 1 = da
           SKanten:      array of Boolean;
           Lerndatei:    String;
           Optionen:     TOptionen;
           property Breite: Integer read _Breite
                                    write wBreite;
           property Hoehe: Integer read _Hoehe
                                   write wHoehe;
           property oben: Integer read _oben
                                  write wOben;
           property links: Integer read _links
                                   write wLinks;
           property Schleife: Boolean read _Schleife
                                      write wSchleife;
           property kannRueckGaengig: boolean read rKannRueckGaengig;
           constructor create(Parent: TWinControl);
           destructor destroy; override;
           procedure Loesen;
           function LoesungsAnzahl: longint;
           procedure FelderErzeugen;
           procedure Leeren(PB: TProgressbar); overload;
           procedure Leeren(PB: TProgressbar; Anzahl: longint); overload;
           procedure Leeren(PB: TProgressbar; Anzahl: longint; nullenExtra: boolean); overload;
           procedure Erzeugen(PB: TProgressbar); overload;
           procedure Erzeugen(PB: TProgressbar; vorheriges_lassen: boolean); overload;
           procedure Zeichnen(hacked: boolean); overload;
           procedure Zeichnen;                  overload;
           function  printto(C: TCanvas): TPoint;                  overload;
           function  printto(C: TCanvas; hacked: boolean): TPoint; overload;
           procedure SaveToFile(Filename: String);
           function  LoadFromFile(Filename: String): boolean;
           procedure LoadFromFeld(F: TFeld);
           procedure RueckGaengig;
           procedure HackIt;
           procedure OnKeyPress(Sender: TObject; var Key: Char);
          end;
  TGenerierungsthread = class(TThread)
  private
  public
    Fertig:    Integer;
    Feld:      TFeld;
    Starttime: extended;
    PB:        TProgressbar;
    constructor create(breite, hoehe: integer; Progressbar: TProgressbar; Parent: TWinControl; Schleife: boolean);
    destructor destroy;   override;
    procedure execute;    override;
  end;

implementation

constructor TOptionen.create;
begin
 inherited create;
 Schriftgroesse:=15;
 OKFarbe[false]:=$FFFFFF;
 OKFarbe[true]:=$008000;
 errFarbe[false]:=$DFDFFF;
 errFarbe[true]:=$000080;
 sFarbe[false]:=$FFD0D0;
 sFarbe[true]:=$800000;
 KFarbe[-1]:=$D0D0D0;
 KFarbe[0]:=$FFFFFF;
 KFarbe[1]:=$000000;
end;

destructor TOptionen.destroy;
begin
 inherited destroy;
end;

function TOptionen.rKantenfarbe(Kante: integer; SKante,lokOK,OK: boolean): TColor;
begin
 if Kante=-1 then
  begin
   Result:=KFarbe[Max(Min(1,Kante),-1)];
   exit;
  end;
 if OK then
  begin
   result:=OKFarbe[Kante=1];
   exit;
  end;
 if not lokOK then
  begin
   result:=errFarbe[Kante=1];
   exit;
  end;
 if SKante then
  begin
   result:=sFarbe[Kante=1];
   exit;
  end;
 Result:=KFarbe[Max(Min(1,Kante),-1)];
end;

function TOptionen.rA: Integer;
begin
 result:=round(2.5*schriftgroesse);
end;

// ****************************************************************************

constructor TFeld.create(Parent: TWinControl);
begin
 inherited create;
 Lerndatei:='';
 Wohin:=TImage.create(Parent);
 Wohin.Parent:=Parent;
 Wohin.OnMouseUp:=@WohinMouseUp;
 Wohin.OnMouseMove:=@WohinMouseMove;
 _Parent:=Parent;
 Optionen:=TOptionen.create;
 Setlength(Geschichte,0);
 Links:=0;
 Oben:=0;
 Breite:=5;
 Hoehe:=5;
end;

destructor TFeld.destroy;
begin
 Optionen.destroy;
 inherited destroy;
end;

procedure TFeld.wOben(O: integer);
begin
 _oben:=O;
 Wohin.Top:=O;
end;

procedure TFeld.wLinks(L: integer);
begin
 _links:=L;
 Wohin.Left:=L;
end;

procedure TFeld.wBreite(B: integer);
begin
 if _Breite=B+byte(not _Schleife) then exit;
 _Breite:=B+byte(not _Schleife);
 FKinitialisieren;
end;

procedure TFeld.wHoehe(H: integer);
begin
 if _Hoehe=H+byte(not _Schleife) then exit;
 _Hoehe:=H+byte(not _Schleife);
 FKinitialisieren;
end;

function TFeld.zBreite: integer;
begin
 result:=Breite-byte(not Schleife);
end;

function TFeld.zHoehe: integer;
begin
 result:=Hoehe-byte(not Schleife);
end;

procedure TFeld.FKinitialisieren;
var I: Integer;
begin
 Setlength(Felder,max(0,Hoehe*(Breite+1)-1));
 Setlength(Kanten,2*(length(Felder)-1)+2*Breite+4);
 Setlength(SKanten,length(Kanten));
 For I:=0 to length(Felder)-1 do
  if (I+1) mod (Breite+1) <> 0 then Felder[I]:=-1
                               else Felder[I]:=-2;
 For I:=0 to length(Kanten)-1 do
  begin
   if (odd(I+1) and (I<2*Hoehe*(Breite+1))) or
      (odd(I) and ((I+1) mod (2*(Breite+1))<>0)) then
    Kanten[I]:=-1
     else
    Kanten[I]:=-2;
   SKanten[I]:=festeKante(I)>=0;
   if SKanten[I] then
    Kanten[I]:=festeKante(I);
  end;
 Setlength(Geschichte,0);
end;

procedure TFeld.Zeichnen;
begin
 Zeichnen(false);
end;

function  TFeld.printto(C: TCanvas): TPoint;
begin
 Result:=printto(C,false);
end;

function  TFeld.printto(C: TCanvas; hacked: boolean): TPoint;
var I: Integer;
begin
 Result.X:=(zBreite+2)*Optionen.A+1;
 Result.Y:=(zHoehe+2)*Optionen.A+1;
 C.Font.Size:=Optionen.Schriftgroesse;
 For I:=0 to length(Felder)-1 do
  if (Felder[I]>=0) and not festesFeld(I) then
   begin
    C.Font.Color:=Optionen.KantenFarbe[1,false,FeldOkay(I),AllesOkay];
    C.TextOut(
      round((I mod (Breite+1) + 1.5)*Optionen.A - 0.5*C.TextWidth(inttostr(Felder[I]))),
      round((I div (Breite+1) - byte(not Schleife) + 1.5)*Optionen.A - 0.5*C.TextHeight(inttostr(Felder[I]))),
      inttostr(Felder[I]));
   end;
 C.Pen.Width:=3;
 For I:=0 to length(Kanten)-1 do
  if (Kanten[I]<>-2) and (festeKante(I)<0) then
   begin
    C.Pen.Color:= Optionen.KantenFarbe[Kanten[I],SKanten[I],KanteOkay(I),AllesOkay];
    if odd(I) then
     begin
      C.MoveTo(
       ((I div 2) mod (Breite+1) +1)*Optionen.A,
       ((I div 2) div (Breite+1) - byte(not Schleife) +1)*Optionen.A);
      C.LineTo(
       ((I div 2) mod (Breite+1) +2)*Optionen.A,
       ((I div 2) div (Breite+1) - byte(not Schleife) +1)*Optionen.A);
{$IFDEF PreSchleifenTest}
      if Hacked then
       C.TextOut(
        round(((I div 2) mod (Breite+1) +1.5)*Optionen.A),
        ((I div 2) div (Breite+1) - byte(not Schleife) +1)*Optionen.A,
        inttostr(Zusammenhang[I]));
{$ENDIF}
     end
      else
     begin
      C.MoveTo(
       ((I div 2) mod (Breite+1) +1)*Optionen.A,
       ((I div 2) div (Breite+1) - byte(not Schleife) +1)*Optionen.A);
      C.LineTo(
       ((I div 2) mod (Breite+1) +1)*Optionen.A,
       ((I div 2) div (Breite+1) - byte(not Schleife) +2)*Optionen.A);
{$IFDEF PreSchleifenTest}
      if Hacked then
       C.TextOut(
        ((I div 2) mod (Breite+1) +1)*Optionen.A,
        round(((I div 2) div (Breite+1) - byte(not Schleife) +1.5)*Optionen.A),
        inttostr(Zusammenhang[I]));
{$ENDIF}
     end;
  end;
 if not schleife then
  begin
   C.Pen.Color:=$000000;
   C.Ellipse(Optionen.A-3,Optionen.A-3,Optionen.A+4,Optionen.A+4);
   C.Ellipse(Breite*Optionen.A-3,Hoehe*Optionen.A-3,Breite*Optionen.A+4,Hoehe*Optionen.A+4);
  end;
end;

procedure TFeld.Zeichnen(hacked: boolean);
begin
 Wohin.Destroy;
 Wohin:=TImage.Create(_Parent);
 Wohin.Parent:=_Parent;
 Wohin.OnMouseUp:=@WohinMouseUp;
 Wohin.OnMouseMove:=@WohinMouseMove;
 Wohin.Left:=_Links;
 Wohin.Top:=_Oben;
 Wohin.Width:=(zBreite+2)*Optionen.A+1;
 Wohin.Height:=(zHoehe+2)*Optionen.A+1;
 Wohin.Canvas.Rectangle(-10,-10,Wohin.Width+10,Wohin.Height+10);
 printto(Wohin.Canvas,hacked);
end;

procedure TFeld.WohinMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var I: Integer;
const neuWert: array[-1..1,boolean] of integer = ((0,1),(0,-1),(-1,1));
begin
 Y:=Y+Optionen.A*Byte(not Schleife);
 if (2*X<Optionen.A) or
    (2*Y<Optionen.A) or
    (2*X>(2*Breite+3)*Optionen.A) or
    (2*Y>(2*Hoehe+3)*Optionen.A) then
  exit;
 I:=2*((X div Optionen.A-1)+(Y div Optionen.A-1)*(Breite+1));
 X:=X mod Optionen.A;
 Y:=Y mod Optionen.A;
 case 2*Byte(X+Y<Optionen.A) + Byte(X-Y<0) of
  0: I:=I+2;
  1: I:=I+2*Breite+3;
  2: I:=I+1;
  3: ;
 end{of Case};
 if ((I+1) mod (2*(Breite+1))=0) or
    ((not odd(I)) and (I>=2*Hoehe*(Breite+1))) then
  exit;
 if (I>=0) and (I<length(Kanten)) and (not SKanten[I]) and (neuWert[Kanten[I],Button=mbLeft]<>Kanten[I]) then
  begin
   setlength(Geschichte,length(Geschichte)+1);
   Geschichte[length(Geschichte)-1].x:=I;
   Geschichte[length(Geschichte)-1].y:=Kanten[I];
   if neuWert[Kanten[I],Button=mbLeft]>=0 then
     inDieserSituationTutMan(I);
   Kanten[I]:=neuWert[Kanten[I],Button=mbLeft];
  end;
 Zeichnen;
end;

procedure TFeld.FelderErzeugen;
var I: Integer;
begin
 For I:=0 to length(Felder)-1 do
  if Felder[I]<>-2 then
   Felder[I]:=byte(Kanten[2*I]=1)+
              byte(Kanten[2*I+1]=1)+
              byte(Kanten[2*I+2]=1)+
              byte(Kanten[2*I+2*Breite+3]=1);
end;

function TFeld.Schlaufe: Integer;
var I,J,N:  Integer;
    Rtg:    Integer; // *pi/2
begin
 N:=0;
 For I:=0 to length(Kanten)-1 do
  if ((I+1) mod (2*(Breite+1))<>0) and
     ((odd(I)) or (I<2*Hoehe*(Breite+1))) and
     (Kanten[I]=1) then
   inc(N);
 if N=0 then
  begin
   Result:=1;
   exit;
  end;
 For I:=0 to length(Kanten) div 2 do
  begin
   J:=0;
   if 2*I-2*Breite-2>=0 then J:=J + Byte(1=Kanten[2*I-2*Breite-2]);
   if 2*I-1>=0 then J:=J + Byte(1=Kanten[2*I-1]);
   if 2*I<length(Kanten) then J:=J + Byte(1=Kanten[2*I]);
   if 2*I+1<length(Kanten) then J:=J + Byte(1=Kanten[2*I+1]);
   if not (J in [0,2]) then
    begin
     Result:=0;
     exit;
    end;
  end;
 J:=-1;
 Rtg:=0;
 For I:=0 to length(Kanten)-1 do
  if ((I+1) mod (2*(Breite+1))<>0) and
     ((odd(I)) or (I<2*Hoehe*(Breite+1))) and
     (Kanten[I]=1) then
   begin
    Rtg:=(I+1) mod 2 + 2;
    J:=I div 2;
    break;
   end;
 I:=J;
 repeat
  dec(N);
  case Rtg of
   0: J:=J+1;
   1: J:=J-Breite-1;
   2: J:=J-1;
   3: J:=J+Breite+1;
  end{of Case};
  if (2*J+1<length(Kanten)) and
     (Kanten[2*J+1]=1) and
     (Rtg <> 2) then
    begin
     Rtg:=0;
     Continue;
    end;
  if (2*J-2*Breite-2>=0) and
     (Kanten[2*J-2*Breite-2]=1) and
     (Rtg <> 3) then
    begin
     Rtg:=1;
     Continue;
    end;
  if (2*J-1>=0) and
     (Kanten[2*J-1]=1) and
     (Rtg <> 0) then
    begin
     Rtg:=2;
     Continue;
    end;
  if (2*J<length(Kanten)) and
     (Kanten[2*J]=1) and
     (Rtg <> 1) then
    begin
     Rtg:=3;
     Continue;
    end;
  Result:=-1;
  exit;
 until I=J;
 Result:=Byte(N=0)*2;
 if Result=2 then
  begin
   J:=1;
   For I:=0 to Breite-1 do
    if Kanten[2*I+1]=1 then J:=2;
   Result:=(Result+J) div 2;
   J:=1;
   For I:=0 to Breite-1 do
    if Kanten[2*I+1+2*Hoehe*(Breite+1)]=1 then J:=2;
   Result:=(Result+J) div 2;
   J:=1;
   For I:=0 to Hoehe-1 do
    if Kanten[2*I*(Breite+1)]=1 then J:=2;
   Result:=(Result+J) div 2;
   J:=1;
   For I:=0 to Hoehe-1 do
    if Kanten[2*I*(Breite+1)+2*Breite]=1 then J:=2;
   Result:=(Result+J) div 2;
  end;
end;

function TFeld.ersteFreieKante: integer;
var I: Integer;
begin
 Result:=-1;
 For I:=0 to length(Kanten)-1 do
  if ((_KantenPerm[I]+1) mod (2*(Breite+1))<>0) and
     ((odd(_KantenPerm[I])) or (_KantenPerm[I]<2*Hoehe*(Breite+1))) and
     (Kanten[_KantenPerm[I]]=-1) then
   begin
    Result:=_KantenPerm[I];
    exit;
   end;
end;

{$IFDEF preSchleifenTest}
procedure TFeld.ZusammenhangInitialisieren;
var I,J,K,M,Rtg,V: Integer;
    Ks:          array[0..1] of Integer;
begin
 setlength(Zusammenhang,length(Kanten));
 M:=-1;
 For I:=0 to length(Kanten)-1 do
  case Kanten[I] of
   -2,-1,0: Zusammenhang[I]:=-1;
   else
    begin
     inc(M);
     Zusammenhang[I]:=M;
    end;
  end{of Case};
 For I:=0 to length(Zusammenhang)-1 do
  if Zusammenhang[I]<>-1 then
   begin
    Ks[0]:=I div 2;
    Ks[1]:=Ks[0] + _rlSchritt[3*((I+1) mod 2)];
    For K:=0 to 1 do
     For Rtg:=0 to 3 do
      if (2*Ks[K]+_rlKante[Rtg] >= 0) and
         (2*Ks[K]+_rlKante[Rtg] < length(Kanten)) and                    // nicht ins leere
         (Zusammenhang[2*Ks[K]+_rlKante[Rtg]] >= 0) and                  // wenn Kante vorhanden
         (Zusammenhang[2*Ks[K]+_rlKante[Rtg]] <> Zusammenhang[I]) then   // und etwas zu tun
       begin
        V:=Zusammenhang[2*Ks[K]+_rlKante[Rtg]];
        For J:=0 to length(Zusammenhang)-1 do
         begin
          if Zusammenhang[J]=V then Zusammenhang[J]:=Zusammenhang[I];
          if Zusammenhang[J]=M then Zusammenhang[J]:=V;
         end;
        dec(M);
       end;
   end;
end;
{$ENDIF}

procedure TFeld.LoesungInitialisieren;
begin
 _rlSchritt[0]:=1;
 _rlSchritt[1]:=-Breite-1;
 _rlSchritt[2]:=-1;
 _rlSchritt[3]:=Breite+1;
 _rlKante[0]:=1;
 _rlKante[1]:=-2*Breite-2;
 _rlKante[2]:=-1;
 _rlKante[3]:=0;
 _rlFeld[0]:=-Breite-1;
 _rlFeld[1]:=-Breite-2;
 _rlFeld[2]:=-1;
 _rlFeld[3]:=0;
 _rlFKante[0]:=2;
 _rlFKante[1]:=1;
 _rlFKante[2]:=0;
 _rlFKante[3]:=2*Breite+3;
 {$IFDEF debug}
 Zaehler:=0;
 Tiefe:=0;
 {$ENDIF}
end;

procedure TFeld.Loesen;
begin
 kantenPermErzeugen;
 {$IFDEF preSchleifenTest}
 ZusammenhangInitialisieren;
 {$ENDIF}
 LoesungInitialisieren;
 if ersteFreieKante=-1 then exit;
 rekursivLoesen(ersteFreieKante div 2,true,true,false);
  // (ersteFreieKante+1) mod 2 + 2,
end;

function TFeld.LoesungsAnzahl: longint;
begin
 kantenPermErzeugen;
 {$IFDEF preSchleifenTest}
 ZusammenhangInitialisieren;
 {$ENDIF}
 LoesungInitialisieren;
 if ersteFreieKante=-1 then
  result:=byte(felderOkay)
 else
  result:=rekursivLoesen(ersteFreieKante div 2,false,true,false);
end;

function TFeld.rekursivLoesen(Knoten: integer; LoesungBehalten,EndeBeiEins,warKante: boolean): integer;
var I,J,K,L,Ma,Mi: integer;
{$IFDEF preSchleifenTest}
    Zsave:         array of integer;
    ZusHlok:       Integer;
{$ENDIF}
    Perm,save:     array[0..3] of Integer;
begin
 {$IFDEF debug}
 inc(Zaehler);
 inc(Tiefe);
 {$ENDIF}
 Result:=0;

 For I:=0 to 3 do // Test der umliegenden Felder auf Korrektheit
  if (Knoten+_rlFeld[I]>=0) and
     (Knoten+_rlFeld[I]<length(Felder)) and
     (Felder[Knoten+_rlFeld[I]]>=0) then
  begin
   Mi:=0;
   Ma:=0;
   For J:=0 to 3 do
    if (2*(Knoten+_rlFeld[I])+_rlFKante[J]>=0) and
       (2*(Knoten+_rlFeld[I])+_rlFKante[J]<length(Kanten)) then
     case Kanten[2*(Knoten+_rlFeld[I])+_rlFKante[J]] of
      -1: inc(Ma);
      1:
       begin
        inc(Ma);
        inc(Mi);
       end;
     end{of Case};
   if (Mi>Felder[Knoten+_rlFeld[I]]) or
      (Ma<Felder[Knoten+_rlFeld[I]]) then
    exit;
  end;

 Mi:=0;
 Ma:=0;
 For I:=0 to 3 do
  if (2*Knoten + _rlKante[I] >= 0) and
     (2*Knoten + _rlKante[I] < length(Kanten)) then
   case Kanten[2*Knoten + _rlKante[I]] of
    -1: inc(Ma);
    1:
     begin
      inc(Mi);
      inc(Ma);
     end;
   end{of Case};
 if (Mi>2) or
    ((Ma=Mi) and odd(Ma)) then
  begin
   {$IFDEF debug}
   dec(Tiefe);
   {$ENDIF}
   exit; // so geht's nicht!
  end;
 {$IFDEF preSchleifenTest}
 if (Mi=2) and warKante then  // evtl. Schleife geschlossen
  begin
   K:=-1;
   L:=-1;
   For I:=0 to 3 do
    if (2*Knoten+_rlKante[I]>=0) and
       (2*Knoten+_rlKante[I]<length(Kanten)) and
       (Kanten[2*Knoten+_rlKante[I]]=1) then
     begin
      K:=L;
      L:=Zusammenhang[2*Knoten+_rlKante[I]];
     end;
   if (K<>-1) then
    begin
     if K=L then Result:=Byte(FelderOkay)  // Schlaufe gebildet
       else
      begin                                // oder eben noch nicht
       if L>K then                         
        begin
         I:=L;
         L:=K;
         K:=I;
        end;
       For I:=0 to 3 do  // vorheriges in save speichern
        if (2*Knoten + _rlKante[I]>=0) and (2*Knoten + _rlKante[I]<length(Kanten)) then
         save[I]:=Kanten[2*Knoten + _rlKante[I]]
          else
         save[I]:=-2;
       setlength(Zsave,length(Zusammenhang));
       For I:=0 to length(Zusammenhang)-1 do // bzw. in Zsave
        begin
         Zsave[I]:=Zusammenhang[I];
         if Zusammenhang[I]=K then Zusammenhang[I]:=L;
         if Zusammenhang[I]>K then dec(Zusammenhang[I]);
        end;
       For I:=0 to 3 do                      // 2+x sind x zu viel
        if (save[I]<>-2) and                 
           (Kanten[2*Knoten+_rlKante[I]]=-1) then
         Kanten[2*Knoten+_rlKante[I]]:=0;
       if ersteFreieKante=-1 then
        Result:=Byte(FelderOkay)             // sollte eigentlich nicht gelöst sein
         else
        Result:=rekursivLoesen(ersteFreieKante div 2,LoesungBehalten,EndeBeiEins,false);
          //(ersteFreieKante+1) mod 2 + 2,
       if (not LoesungBehalten) or (Result=0) then
        begin
         For I:=0 to length(Zsave)-1 do
          Zusammenhang[I]:=Zsave[I];
         For I:=0 to 3 do
          if save[I]<>-2 then
           Kanten[2*Knoten+_rlKante[I]]:=save[I];
        end;
      end;
     {$IFDEF debug}
     dec(Tiefe);
     {$ENDIF}
     exit;
    end;
  end;
 {$ENDIF}
 if Ma=Mi then // hier bereits alles geklärt
  begin
   if ersteFreieKante=-1 then
    Result:=Byte(FelderOkay)
     else
    Result:=rekursivLoesen(ersteFreieKante div 2,LoesungBehalten,EndeBeiEins,false);
      //(ersteFreieKante+1) mod 2 + 2,
   {$IFDEF debug}
   dec(Tiefe);
   {$ENDIF}
   exit;
  end;
 For I:=0 to 3 do  // vorheriges in save speichern
  if (2*Knoten + _rlKante[I]>=0) and (2*Knoten + _rlKante[I]<length(Kanten)) then
   save[I]:=Kanten[2*Knoten + _rlKante[I]]
    else
   save[I]:=-2;
 if (Ma<2) or (Mi=2) then // keine neuen Kanten
  begin
   For I:=0 to 3 do
    if (save[I]<>-2) and
       (Kanten[2*Knoten+_rlKante[I]]=-1) then
     Kanten[2*Knoten+_rlKante[I]]:=0;
   if ersteFreieKante=-1 then
    Result:=Byte(FelderOkay)
     else
    Result:=rekursivLoesen(ersteFreieKante div 2,LoesungBehalten,EndeBeiEins,false);
      //(ersteFreieKante+1) mod 2 + 2,
   if (not LoesungBehalten) or (Result=0) then
    For I:=0 to 3 do
     if save[I]<>-2 then
      Kanten[2*Knoten+_rlKante[I]]:=save[I];
   {$IFDEF debug}
   dec(Tiefe);
   {$ENDIF}
   exit;
  end;
 Perm[0]:=random(4);
 Perm[1]:=random(3);
  Perm[1]:=Perm[1]+Byte(Perm[1]>=Perm[0]);
 Perm[2]:=random(2);
  Perm[2]:=Perm[2]+Byte(Perm[2]>=Min(Perm[0],Perm[1]));
  Perm[2]:=Perm[2]+Byte(Perm[2]>=Max(Perm[0],Perm[1]));
 Perm[3]:=0;
 For I:=1 to 3 do
  if (Perm[0]<>I) and (Perm[1]<>I) and (Perm[2]<>I) then Perm[3]:=I;
 if Mi=0 then
  begin // keine oder zwei neue Kanten
   L:=Byte(Random>0.5);
   repeat
    if L in [1,2] then    // vielleicht zwei?
     For I:=0 to 3 do
      if (save[Perm[I]] <> -2) and
         (Kanten[2*Knoten + _rlKante[Perm[I]]]=-1) then
       For J:=I+1 to 3 do
        if (save[Perm[J]]<>-2) and
           (Kanten[2*Knoten + _rlKante[Perm[J]]]=-1) then
         begin
          {$IFDEF preSchleifenTest}
          Setlength(Zsave,length(Zusammenhang));
          For K:=0 to length(ZSave)-1 do
           ZSave[K]:=Zusammenhang[K];
          ZusHlok:=inZusammenhangKomp(Knoten + _rlSchritt[Perm[J]]);
          if ZusHlok=-1 then           // der "Start" ist frei
           For K:=0 to length(Zusammenhang)-1 do
            ZusHlok:=max(ZusHlok,Zusammenhang[K]+1);
          Zusammenhang[2*Knoten + _rlKante[Perm[I]]]:=ZusHlok;
          Zusammenhang[2*Knoten + _rlKante[Perm[J]]]:=ZusHlok;
          {$ENDIF}
          For K:=0 to 3 do
           if Save[K]<>-2 then
            Kanten[2*Knoten + _rlKante[K]]:=0;
          Kanten[2*Knoten + _rlKante[Perm[I]]]:=1;
          Kanten[2*Knoten + _rlKante[Perm[J]]]:=1;
          Result:=Result+rekursivLoesen(Knoten + _rlSchritt[Perm[I]],LoesungBehalten,EndeBeiEins,true);
            // Perm[I],
          if (Result>1) or ((Result>0) and EndeBeiEins) then
           begin
            if not LoesungBehalten then
             begin
              For K:=0 to 3 do
               if Save[K]<>-2 then
                Kanten[2*Knoten + _rlKante[K]]:=save[K];
              {$IFDEF preSchleifenTest}
              For K:=0 to length(ZSave)-1 do
               Zusammenhang[K]:=ZSave[K];
              {$ENDIF}
             end;
            {$IFDEF debug}
            dec(Tiefe);
            {$ENDIF}
            exit;
           end;
          For K:=0 to 3 do
           if Save[K]<>-2 then
            Kanten[2*Knoten + _rlKante[K]]:=save[K];
          {$IFDEF preSchleifenTest}
          For K:=0 to length(ZSave)-1 do
           Zusammenhang[K]:=ZSave[K];
          {$ENDIF}
         end;
    if L in [0,3] then    // vielleicht keine?
     begin
      For I:=0 to 3 do
       if (save[Perm[I]] <> -2) then
        Kanten[2*Knoten + _rlKante[Perm[I]]]:=0;
      if ersteFreieKante=-1 then
       Result:=Result+Byte(FelderOkay)
        else
       Result:=Result+rekursivLoesen(ersteFreieKante div 2,LoesungBehalten,EndeBeiEins,false);
         //(ersteFreieKante+1) mod 2 + 2,
      if (Result>1) or ((Result>0) and EndeBeiEins) then
       begin
        if not LoesungBehalten then
         For K:=0 to 3 do
          if Save[K]<>-2 then
           Kanten[2*Knoten + _rlKante[K]]:=save[K];
        {$IFDEF debug}
        dec(Tiefe);
        {$ENDIF}
        exit;
       end;
      For I:=0 to 3 do
       if save[I]<>-2 then
        Kanten[2*Knoten+_rlKante[I]]:=save[I];
     end;
    inc(L,2);
   until L>3;
  end
   else
  begin // genau eine neue Kante
   {$IFDEF preSchleifenTest}
   ZusHlok:=inZusammenhangKomp(Knoten);
   if ZusHlok=-1 then    // "Start" ist frei
    For I:=0 to length(Zusammenhang)-1 do
     ZusHlok:=max(ZusHlok,Zusammenhang[I]+1);
   {$ENDIF}
   For I:=0 to 3 do
    if (save[Perm[I]]<>-2) and
       (Kanten[2*Knoten + _rlKante[Perm[I]]]=-1) then
     begin
      For K:=0 to 3 do
       if (save[K]<>-2) and
          (Kanten[2*Knoten + _rlKante[K]]=-1) then
        Kanten[2*Knoten + _rlKante[K]]:=0;
      {$IFDEF preSchleifenTest}
      Zusammenhang[2*Knoten + _rlKante[Perm[I]]]:=ZusHlok;
      {$ENDIF}
      Kanten[2*Knoten + _rlKante[Perm[I]]]:=1;
      result:=result+rekursivLoesen(Knoten + _rlSchritt[Perm[I]],LoesungBehalten,EndeBeiEins,true);
        //Perm[I],
      if (Result>1) or ((Result>0) and EndeBeiEins) then
       begin
        if not LoesungBehalten then
         begin
          For K:=0 to 3 do
           if Save[K]<>-2 then
            Kanten[2*Knoten + _rlKante[K]]:=save[K];
          {$IFDEF preSchleifenTest}
          Zusammenhang[2*Knoten + _rlKante[Perm[I]]]:=-1;
          {$ENDIF}
         end;
        {$IFDEF debug}
        dec(Tiefe);
        {$ENDIF}
        exit;
       end;
      For K:=0 to 3 do
       if (save[K]<>-2) then
        Kanten[2*Knoten + _rlKante[K]]:=save[K];
      {$IFDEF preSchleifenTest}
      Zusammenhang[2*Knoten + _rlKante[Perm[I]]]:=-1;
      {$ENDIF}
     end;
  end;
 {$IFDEF debug}
 dec(Tiefe);
 {$ENDIF}
end;

procedure TFeld.Leeren(PB: TProgressbar);
begin
  Leeren(PB,-1);
end;

procedure TFeld.Leeren(PB: TProgressbar; Anzahl: longint);
begin
  Leeren(PB,Anzahl,true);
end;

procedure TFeld.Leeren(PB: TProgressbar; Anzahl: longint; nullenExtra: boolean);
var I,J:           Integer;
    save:          Integer;
    geht:          boolean;
    {$IFDEF vorLoesen}
    Startknoten,
    Startrichtung: integer;
    {$IFDEF debug}
    tstart:        extended;
    {$ENDIF}
    {$ENDIF}
begin
 {$IFDEF vorLoesen}
 {$IFDEF debug}
 tvorloesen:=0;
 tnachloesen:=0;
 {$ENDIF}
 {$ENDIF}
 kantenPermErzeugen;
 felderPermErzeugen;
 if not Schleife then // feste Felder entfernen
  begin
   For I:=0 to length(Felder)-1 do
    if festesFeld(I) then
     Felder[I]:=-1;
  end;
 if Assigned(PB) then
  begin
   PB.Visible:=true;
   PB.Min:=0;
   PB.Position:=0;
   PB.Step:=1;
   PB.Max:=length(Kanten);
  end;
 For I:=0 to length(Kanten)-1 do  // zuerst Kanten entfernen
  begin
   if Assigned(PB) then PB.StepIt;
   if (Kanten[_KantenPerm[I]]<>-2) and
      (Kanten[_KantenPerm[I]]<>-1) and
      (Schleife or (festeKante(_KantenPerm[I])<0)) then
    begin
     save:=Kanten[_KantenPerm[I]];
     Kanten[_KantenPerm[I]]:=-1;
     LoesungInitialisieren;
     Startknoten:=-1;
     Startrichtung:=0;
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tstart:=now;
     {$ENDIF}
     vorLoesen(Startknoten,Startrichtung);
     {$IFDEF debug}
     tvorloesen:=tvorloesen+now-tstart;
     {$ENDIF}
     {$ENDIF}
     if Startknoten=-1 then
      begin
       Startknoten:=ersteFreieKante;
       Startrichtung:=(Startknoten + 1) mod 2 + 2;
       Startknoten:=Startknoten div 2;
      end;
     {$IFDEF preSchleifenTest}
     ZusammenhangInitialisieren;
     {$ENDIF}
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tstart:=now;
     {$ENDIF}
     {$ENDIF}
     geht:=rekursivLoesen(Startknoten,false,false,false)=1;
       //Startrichtung,
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tnachloesen:=tnachloesen+now-tstart;
     tstart:=now;
     {$ENDIF}
     nachLoesen;
     {$IFDEF debug}
     tvorloesen:=tvorloesen+now-tstart;
     {$ENDIF}
     {$ENDIF}
     if not geht then
      Kanten[_KantenPerm[I]]:=save;
    end;
  end;
 {$IFDEF debug}
 t3:=now;
 {$ENDIF}
 if Assigned(PB) then
  begin
   PB.Position:=0;
   PB.Max:=length(_FelderPerm);
  end; 
 For J:=0 to byte(nullenExtra) do
  For I:=0 to length(_FelderPerm)-1 do
   if (not nullenExtra) or
      ((Felder[_FelderPerm[I]]=0) xor (J=1)) then
    begin
     if Assigned(PB) then PB.StepIt;
     if Felder[_FelderPerm[I]]=-1 then
      continue;
     save:=Felder[_FelderPerm[I]];
     Felder[_FelderPerm[I]]:=-1;
     LoesungInitialisieren;
     Startknoten:=-1;
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tstart:=now;
     {$ENDIF}
     vorLoesen(Startknoten,Startrichtung);
     {$IFDEF debug}
     tvorloesen:=tvorloesen+now-tstart;
     {$ENDIF}
     {$ENDIF}
     if Startknoten=-1 then
      begin
       Startknoten:=ersteFreieKante;
       Startrichtung:=(Startknoten + 1) mod 2 + 2;
       Startknoten:=Startknoten div 2;
      end;
     {$IFDEF preSchleifenTest}
     ZusammenhangInitialisieren;
     {$ENDIF}
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tstart:=now;
     {$ENDIF}
     {$ENDIF}
     geht:=rekursivLoesen(Startknoten,false,false,false)=1;
       //Startrichtung,
     {$IFDEF vorLoesen}
     {$IFDEF debug}
     tnachloesen:=tnachloesen+now-tstart;
     tstart:=now;
     {$ENDIF}
     nachLoesen;
     {$IFDEF debug}
     tvorloesen:=tvorloesen+now-tstart;
     {$ENDIF}
     {$ENDIF}
     if geht then begin
      dec(Anzahl);
      if Anzahl=0 then exit;
     end
     else
      Felder[_FelderPerm[I]]:=save;
    end;
 if Assigned(PB) then PB.Visible:=false;
end;

procedure TFeld.Erzeugen(PB: TProgressbar);
begin
 Erzeugen(PB,false);
end;

procedure TFeld.Erzeugen(PB: TProgressbar; vorheriges_lassen: boolean); 
var I:           Integer;
begin
 {$IFDEF debug}
 erzeugungsVersuche:=0;
 t0:=now;
 {$ENDIF}
 if (not vorheriges_lassen) or (Schlaufe<>2) then
  Repeat
   FKinitialisieren;
   Loesen;
   {$IFDEF debug}
   inc(erzeugungsVersuche);
   {$ENDIF}
  until Schlaufe=2;
 {$IFDEF debug}
 t1:=now;
 {$ENDIF}
 FelderErzeugen;
 {$IFDEF debug}
 t2:=now;
 {$ENDIF}
 Leeren(PB);
 For I:=0 to length(Kanten)-1 do
  SKanten[I]:=Kanten[I] in [0,1];
 Setlength(Geschichte,0);
 {$IFDEF debug}
 t4:=now;
 Messagedlg(inttostr(erzeugungsversuche)+' Versuche -> '+floattostr((t1-t0)*24*60*60)+' sec'#13#10+
            'Felder erzeugen: '+floattostr((t2-t1)*24*60*60)+' sec'#13#10+
            'Leeren, insgesamt: '+floattostr((t4-t2)*24*60*60)+' sec'#13#10+
            ' - davon Kanten: '+floattostr((t3-t2)*24*60*60)+' sec'#13#10+
            '   und Felder:   '+floattostr((t4-t3)*24*60*60)+' sec'
 {$IFDEF vorLoesen}
     +#13#10' - davon Vorlösen: '+floattostr(tvorloesen*24*60*60)+' sec'#13#10+
            '   und Lösen:      '+floattostr(tnachloesen*24*60*60)+' sec'
 {$ENDIF}
            ,mtinformation,[mbOK],0);
 {$ENDIF}
end;

function TFeld.allesOkay: boolean;
var I: Integer;
begin
 Result:=FelderOkay;
 For I:=0 to length(Kanten)-1 do
//  Result:=Result and (Kanten[I]<>-1);
end;

function TFeld.FelderOkay: boolean;
var I: Integer;
begin
 Result:=Schlaufe>=1;
 For I:=0 to length(Felder)-1 do
  if Felder[I]>=0 then
   Result:=Result and (Felder[I]=byte(Kanten[2*I]=1)+
                                 byte(Kanten[2*I+1]=1)+
                                 byte(Kanten[2*I+2]=1)+
                                 byte(Kanten[2*I+2*Breite+3]=1));
end;

procedure TFeld.PermErzeugen(n: integer; var Perm: TPerm);
var I,J,K,L,R: integer;
begin
 Setlength(Perm,n);
 For I:=0 to n-1 do
  begin
   R:=random(n-I);
   K:=0;
   L:=0;
   repeat
    K:=max(K,L);
    L:=0;
    For J:=0 to I-1 do
     if Perm[J]<=R+K then
      inc(L);
   until K=L;
   Perm[I]:=R+K;
  end;
end;

procedure TFeld.kantenPermErzeugen;
begin
 PermErzeugen(length(Kanten),_KantenPerm);
end;

procedure TFeld.felderPermErzeugen;
var I,J: integer;
begin
 PermErzeugen(length(Felder),_FelderPerm);
 I:=length(Felder);
 while I>0 do
  begin
   dec(I);
   if Felder[_FelderPerm[I]]=-2 then
    begin
     For J:=I+1 to length(_FelderPerm)-1 do
      _FelderPerm[J-1]:=_FelderPerm[J];
     Setlength(_FelderPerm,length(_FelderPerm)-1);
    end;
  end;
end;

function TFeld.FeldOkay(i: integer): boolean;
var J,Mi,Ma: integer;
begin
 LoesungInitialisieren;
 Mi:=0;
 Ma:=0;
 For J:=0 to 3 do
  case Kanten[2*i + _rlFKante[J]] of
   -1: inc(Ma);
   1:
    begin
     inc(Ma);
     inc(Mi);
    end;
  end{of Case};
 Result:=(Felder[i]<0) or ((Ma>=Felder[i]) and (Mi<=Felder[i]));
end;

function TFeld.KanteOkay(i: integer): boolean;
var J,K,Mi,Ma: integer;
begin
 LoesungInitialisieren;
 Ma:=0;
 Mi:=0;
 K:=i div 2;
 For J:=0 to 3 do
  if (2*K+_rlKante[J] >= 0) and
     (2*K+_rlKante[J] < length(Kanten)) then
   case Kanten[2*K+_rlKante[J]] of
    -1: inc(Ma);
    1:
     begin
      inc(Ma);
      inc(Mi);
     end;
   end{of Case};
 Result:=(Mi<=2) and ((Mi<>Ma) or not odd(Ma));
 Ma:=0;
 Mi:=0;
 K:=K + _rlSchritt[3*Byte(not odd(i))];
 For J:=0 to 3 do
  if (2*K+_rlKante[J] >= 0) and
     (2*K+_rlKante[J] < length(Kanten)) then
   case Kanten[2*K+_rlKante[J]] of
    -1: inc(Ma);
    1:
     begin
      inc(Ma);
      inc(Mi);
     end;
   end{of Case};
 Result:=Result and (Mi<=2) and ((Mi<>Ma) or not odd(Ma));
end;

function TFeld.rKannRueckGaengig: boolean;
begin
 Result:=length(Geschichte)>0;
end;

procedure TFeld.RueckGaengig;
begin
 if not kannRueckGaengig then exit;
 Kanten[Geschichte[length(Geschichte)-1].x]:=Geschichte[length(Geschichte)-1].y;
 setlength(Geschichte,length(Geschichte)-1);
end;

procedure TFeld.HackIt;
begin
 {$IFDEF preSchleifenTest}
// ZusammenhangInitialisieren;
 {$ENDIF}
 Zeichnen(true);
end;

{$IFDEF preSchleifenTest}
function TFeld.inZusammenhangKomp(Knoten: Integer): integer;  // In welcher Zshg.-Komponente liegt der Knoten?
var I: Integer;
begin
 Result:=-1;
 For I:=0 to 3 do
  if (2*Knoten+_rlKante[I]>=0) and
     (2*Knoten+_rlKante[I]<length(Kanten)) and
     (Zusammenhang[2*Knoten+_rlKante[I]]>=0) then
   begin
    Result:=Zusammenhang[2*Knoten+_rlKante[I]];
    exit;
   end;
end;
{$ENDIF}

{$IFDEF vorLoesen}
procedure TFeld.vorLoesen(var sKn,SRtg: integer);
var I,J,K,Mi,Ma: integer;
    weiter:      boolean;
begin
 setlength(_vlKanten,length(Kanten));
 for I:=0 to length(Kanten)-1 do
  _vlKanten[I]:=Kanten[I];
 for I:=0 to length(Felder)-1 do
  case Felder[I] of // spezielle Kombinationen suchen
   3:
    for J:=0 to 1 do
     begin
      if (I+_rlSchritt[J]>=0) and                  // zwei 3en nebeneinander ?
         (I+_rlSchritt[J]<length(Felder)) and
         (Felder[I+_rlSchritt[J]]=3) then
       For K:=-1 to 1 do
        Kanten[2*(I+K*_rlSchritt[J])+_rlFKante[J]]:=1;
      if (I+_rlSchritt[J]+_rlSchritt[(J+1) mod 4]>=0) and     // zwei 3en diagonal ?
         (I+_rlSchritt[J]+_rlSchritt[(J+1) mod 4]<length(Felder)) and
         (Felder[I+_rlSchritt[J]+_rlSchritt[(J+1) mod 4]]=3) then
       begin
        Kanten[2*(I+_rlSchritt[J]+_rlSchritt[(J+1) mod 4])+_rlFKante[J]]:=1;
        Kanten[2*(I+_rlSchritt[J]+_rlSchritt[(J+1) mod 4])+_rlFKante[(J+1) mod 4]]:=1;
        Kanten[2*(I-_rlSchritt[J])+_rlFKante[J]]:=1;
        Kanten[2*(I-_rlSchritt[(J+1) mod 4])+_rlFKante[(J+1) mod 4]]:=1;
       end;
     end;
  end{of Case};
 repeat
  weiter:=false;
  for I:=0 to length(Felder)-1 do
   if Felder[I] >= 0 then // "normale" min-max-Suche
    begin
     Mi:=0;
     Ma:=0;
     for J:=0 to 3 do
      begin
       Mi:=Mi+Byte(Kanten[2*I+_rlFKante[J]]=1);
       Ma:=Ma+Byte(abs(Kanten[2*I+_rlFKante[J]])=1);
      end;
     weiter:=weiter or ((Ma<>Mi) and ((Felder[I]=Ma) or (Felder[I]=Mi)));
     if (Ma<>Mi) and (Felder[I]=Mi) then  // alles andere muss leer sein
      For J:=0 to 3 do
       if Kanten[2*I+_rlFKante[J]]=-1 then
        Kanten[2*I+_rlFKante[J]]:=0;
     if (Ma<>Mi) and (Felder[I]=Ma) then  // alles andere muss gefüllt sein
      For J:=0 to 3 do
       if Kanten[2*I+_rlFKante[J]]=-1 then
        Kanten[2*I+_rlFKante[J]]:=1;
    end;
  for I:=0 to length(Kanten) div 2 do
   begin
    Mi:=0;
    Ma:=0;
    For J:=0 to 3 do
     if (2*I+_rlKante[J] >= 0) and
        (2*I+_rlKante[J] < length(Kanten)) then
      begin
       Mi:=Mi + Byte(Kanten[2*I+_rlKante[J]]=1);
       Ma:=Ma + Byte(abs(Kanten[2*I+_rlKante[J]])=1);
      end;
    if (Mi=2) or (Ma<2) then
     begin
      for J:=0 to 3 do
       if (2*I+_rlKante[J] >= 0) and
          (2*I+_rlKante[J] < length(Kanten)) and
          (Kanten[2*I+_rlKante[J]] = -1) then
        begin
         weiter:=true;
         Kanten[2*I+_rlKante[J]]:=0;
        end;
      continue;
     end;
    if (Ma=2) and (Mi>0) then
     begin
      for J:=0 to 3 do
       if (2*I+_rlKante[J] >= 0) and
          (2*I+_rlKante[J] < length(Kanten)) and
          (Kanten[2*I+_rlKante[J]] = -1) then
        begin
         weiter:=true;
         Kanten[2*I+_rlKante[J]]:=1;
        end;
      continue;
     end;
   end;
 until not weiter;
 For I:=0 to length(Kanten) div 2 do
  begin
   K:=0;
   For J:=0 to 3 do
    if (2*I+_rlKante[J] >= 0) and
       (2*I+_rlKante[J] < length(Kanten)) and
       (Kanten[2*I+_rlKante[J]]=1) then
     inc(K);
   if K=1 then
    begin
     sKn:=I;
     For J:=0 to 3 do
      if (2*I+_rlKante[J] >= 0) and
         (2*I+_rlKante[J] < length(Kanten)) and
         (Kanten[2*I+_rlKante[J]]=1) then
       sRtg:=(J+2) mod 4;
    end;
  end;
end;

procedure TFeld.nachLoesen;
var I: integer;
begin
 for I:=0 to length(Kanten)-1 do
  Kanten[I]:=_vlKanten[I];
end;
{$ENDIF}

procedure TFeld.wSchleife(S: boolean);
begin
 if S=_Schleife then exit;
 _Schleife:=S;
 Breite:=Breite-Byte(S);
 Hoehe:=Hoehe-Byte(S);
 FKInitialisieren;
end;

function TFeld.FesteKante(I: Integer): integer;
begin
 result:=-1;
 if Schleife then exit;
 if (I<2*Breite) or ((I+3) mod (2*Breite+2) <= 1) then result:=0;
 if result=0 then
  begin
   if (odd(I) and (I<2*Breite)) or
      (I=0) or ((I+2) mod (2*Breite+2) = 0) or
      (I=2*(Breite+1)*(Hoehe+1)-3) then result:=1;
  end;
end;

function TFeld.festesFeld(I: Integer): boolean;
begin
 result:=
  not (Schleife or
    not ((I<Breite) or
         ((I+2) mod (Breite+1) = 0)));
end;

procedure TFeld.SaveToFile(Filename: String);
var F: TRaetselFile;
    C: Cardinal;
begin
 F:=TRaetselFile.Create;
 F.Kennung:='Slither';
 F.FAssignfile(Filename);
 F.FRewrite;
 C:=Breite;
 F.FBlockWrite(C,4);
 C:=Hoehe;
 F.FBlockWrite(C,4);
 C:=Byte(Schleife);
 F.FBlockWrite(C,4);
 C:=length(Geschichte);
 F.FBlockWrite(C,4);
 if length(Kanten)>0 then
  F.FBlockWrite(Kanten[0],length(Kanten)*SizeOf(Kanten[0]));
 if length(SKanten)>0 then
  F.FBlockWrite(SKanten[0],length(SKanten)*SizeOf(SKanten[0]));
 if length(Felder)>0 then
  F.FBlockWrite(Felder[0],length(Felder)*SizeOf(Felder[0]));
 if length(Geschichte)>0 then
  F.FBlockWrite(Geschichte[0],length(Geschichte)*SizeOf(Geschichte[0]));
 F.FCloseFile;
 F.Destroy;
end;

function  TFeld.LoadFromFile(Filename: String): boolean;
var F: TRaetselFile;
    C: Cardinal;
begin
 F:=TRaetselFile.Create;
 F.Kennung:='Slither';
 F.FAssignFile(Filename);
 Result:=F.FReset;
 if not Result then exit;
 C:=0;
 Result:=F.FBlockRead(C,4);
 if not Result then exit;
 _Breite:=C;
 Result:=F.FBlockRead(C,4);
 if not Result then exit;
 _Hoehe:=C;
 Result:=F.FBlockRead(C,4);
 if not Result then exit;
 _Schleife:=C<>0;
 FKInitialisieren;
 Result:=F.FBlockRead(C,4);
 if not Result then exit;
 Setlength(Geschichte,C);
 if length(Kanten)>0 then
  Result:=F.FBlockRead(Kanten[0],length(Kanten)*SizeOf(Kanten[0]));
 if not Result then Exit;
 if length(SKanten)>0 then
  Result:=F.FBlockRead(SKanten[0],length(SKanten)*SizeOf(SKanten[0]));
 if not Result then Exit;
 if length(Felder)>0 then
  Result:=F.FBlockRead(Felder[0],length(Felder)*SizeOf(Felder[0]));
 if not Result then Exit;
 if length(Geschichte)>0 then
  Result:=F.FBlockRead(Geschichte[0],length(Geschichte)*SizeOf(Geschichte[0]));
 F.FCloseFile;
 F.Destroy;
end;

procedure TFeld.LoadFromFeld(F: TFeld);
begin
 Schleife:=F.Schleife;
 Hoehe:=F.Hoehe-byte(not Schleife);
 Breite:=F.Breite-byte(not Schleife);
 Setlength(Geschichte,length(F.Geschichte));
 if length(Kanten)>0 then
  Move(F.Kanten[0],Kanten[0],length(Kanten)*SizeOf(Kanten[0]));
 if length(SKanten)>0 then
  Move(F.SKanten[0],SKanten[0],length(SKanten)*SizeOf(SKanten[0]));
 if length(Felder)>0 then
  Move(F.Felder[0],Felder[0],length(Felder)*SizeOf(Felder[0]));
 if length(Geschichte)>0 then
  Move(F.Geschichte[0],Geschichte[0],length(Geschichte)*SizeOf(Geschichte[0]));
end;

procedure TFeld.WohinMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 lmx:=X;
 lmy:=Y;
end;

procedure TFeld.OnKeyPress(Sender: TObject; var Key: Char);
begin
 case Key of
  'x': WohinMouseUp(Sender,mbLeft,[],lmx,lmy);
  'y': WohinMouseUp(Sender,mbRight,[],lmx,lmy);
  'c':
   begin
    Rueckgaengig;
    Zeichnen;
   end;
 end{of Case};
end;

procedure TFeld.inDieserSituationTutMan(I: Integer);
var F: File;
    B: Byte;
    J: Integer;
begin
  if Lerndatei='' then exit;
  AssignFile(F,Lerndatei);
  Reset(F,1);
  Seek(F,fileSize(F));
  B:=Byte(Schleife);
  BlockWrite(F,B,1);
  BlockWrite(F,_Breite,4);
  BlockWrite(F,_Hoehe,4);
  for J:=0 to length(Kanten)-1 do begin
    B:=Kanten[J]+2;
    BlockWrite(F,B,1);
  end;
  for J:=0 to length(Felder)-1 do begin
    B:=Felder[J]+2;
    BlockWrite(F,B,1);
  end;
  BlockWrite(F,I,4);
  Closefile(F);
end;

//******************************************************************************

constructor TGenerierungsthread.create(breite, hoehe: integer; Progressbar: TProgressbar; Parent: TWinControl; Schleife: boolean);
begin
 inherited create(true);
 Fertig:=0;
 PB:=Progressbar;
 Feld:=TFeld.create(Parent);
 Feld.Schleife:=Schleife;
 Feld.Breite:=breite;
 Feld.Hoehe:=hoehe;
 Starttime:=now;
 Priority:=tpLowest;
 Suspended:=false;
end;

destructor TGenerierungsthread.destroy;
begin
 Feld.destroy;
 inherited destroy;
end;

procedure TGenerierungsthread.execute;
begin
 Feld.Erzeugen(PB);
 Fertig:=1;
end;

begin
 {$IFNDEF norandomize}
 randomize;
 {$ENDIF}
end.