whatever

4 files changed, 190 insertions, 27 deletions

diff --git a/Slitherlink.lpi b/Slitherlink.lpi
index 689eb5c..137ad83 100644
--- a/Slitherlink.lpi
+++ b/Slitherlink.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>

+<?xml version="1.0" encoding="UTF-8"?>

 <CONFIG>

   <ProjectOptions>

     <Version Value="9"/>

@@ -39,7 +39,6 @@
       <Unit0>

         <Filename Value="Slitherlink.lpr"/>

         <IsPartOfProject Value="True"/>

-        <UnitName Value="Slitherlink"/>

       </Unit0>

       <Unit1>

         <Filename Value="unit1.pas"/>

@@ -68,12 +67,6 @@
         </Win32>

       </Options>

     </Linking>

-    <Other>

-      <CompilerMessages>

-        <MsgFileName Value=""/>

-      </CompilerMessages>

-      <CompilerPath Value="$(CompPath)"/>

-    </Other>

   </CompilerOptions>

   <Debugging>

     <Exceptions Count="3">

diff --git a/SlitherlinkUnit.pas b/SlitherlinkUnit.pas
index 6395e36..1be3682 100644
--- a/SlitherlinkUnit.pas
+++ b/SlitherlinkUnit.pas
@@ -1,6 +1,6 @@
 unit SlitherlinkUnit;

 

-{ $DEFINE norandomize}

+{$DEFINE norandomize}

 {$DEFINE preSchleifenTest}

 {$DEFINE vorLoesen}

 {$DEFINE SchleifenFrueherkennung}

@@ -69,7 +69,6 @@ type
            procedure WohinMouseUp(Sender: TObject; Button: TMouseButton;

                       Shift: TShiftState; X, Y: Integer);

            procedure WohinMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

-           procedure FelderErzeugen;

            function ersteFreieKante: integer;

            procedure LoesungInitialisieren;

            {$IFDEF preSchleifenTest}

@@ -94,7 +93,7 @@ type
            {$ENDIF}

            procedure wSchleife(S: boolean);

            function FesteKante(I: Integer): integer; // 0=nein; 1=fest weg; 2=fest da

-           function FestesFeld(I: Integer): boolean;

+           function festesFeld(I: Integer): boolean;

            procedure inDieserSituationTutMan(I: Integer);

           public

            Felder:       array of Integer; // -1 = leer

@@ -116,7 +115,11 @@ type
            constructor create(Parent: TWinControl);

            destructor destroy; override;

            procedure Loesen;

-           procedure Leeren(PB: TProgressbar);

+           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;

@@ -601,6 +604,19 @@ begin
   // (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}

@@ -901,6 +917,16 @@ begin
 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;

@@ -938,6 +964,7 @@ begin
   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]];

@@ -992,11 +1019,14 @@ begin
    PB.Position:=0;

    PB.Max:=length(_FelderPerm);

   end; 

- For J:=0 to 1 do

+ For J:=0 to byte(nullenExtra) do

   For I:=0 to length(_FelderPerm)-1 do

-   if (Felder[_FelderPerm[I]]=0) xor (J=1) then

+   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;

@@ -1036,7 +1066,11 @@ begin
      tvorloesen:=tvorloesen+now-tstart;

      {$ENDIF}

      {$ENDIF}

-     if not geht then

+     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;

@@ -1378,7 +1412,7 @@ begin
   end;

 end;

 

-function TFeld.FestesFeld(I: Integer): boolean;

+function TFeld.festesFeld(I: Integer): boolean;

 begin

  result:=

   not (Schleife or

@@ -1489,7 +1523,6 @@ end;
 

 procedure TFeld.inDieserSituationTutMan(I: Integer);

 var F: File;

-    C: Cardinal;

     B: Byte;

     J: Integer;

 begin

diff --git a/unit1.lfm b/unit1.lfm
index 7d13593..61427f1 100644
--- a/unit1.lfm
+++ b/unit1.lfm
@@ -1,17 +1,17 @@
 object Form1: TForm1

-  Left = 282

-  Height = 325

-  Top = 130

-  Width = 647

+  Left = 279

+  Height = 526

+  Top = 374

+  Width = 697

   Caption = 'Form1'

-  ClientHeight = 325

-  ClientWidth = 647

+  ClientHeight = 526

+  ClientWidth = 697

   OnActivate = FormActivate

   OnCreate = FormCreate

   OnDestroy = FormDestroy

   OnKeyDown = FormKeyDown

   OnResize = FormResize

-  LCLVersion = '1.0.2.0'

+  LCLVersion = '1.6.2.0'

   object Button1: TButton

     Left = 0

     Height = 25

@@ -19,6 +19,7 @@ object Form1: TForm1
     Width = 67

     Caption = 'erzeugen'

     OnClick = Button1Click

+    PopupMenu = PopupMenu1

     TabOrder = 0

   end

   object SpinEdit1: TSpinEdit

@@ -29,6 +30,7 @@ object Form1: TForm1
     Width = 56

     OnChange = SpinEdit1Change

     ParentShowHint = False

+    PopupMenu = PopupMenu1

     ShowHint = True

     TabOrder = 1

     Value = 5

@@ -41,6 +43,7 @@ object Form1: TForm1
     Width = 56

     OnChange = SpinEdit2Change

     ParentShowHint = False

+    PopupMenu = PopupMenu1

     ShowHint = True

     TabOrder = 2

     Value = 5

@@ -53,6 +56,7 @@ object Form1: TForm1
     Width = 56

     OnChange = SpinEdit3Change

     ParentShowHint = False

+    PopupMenu = PopupMenu1

     ShowHint = True

     TabOrder = 3

     Value = 16

@@ -62,6 +66,7 @@ object Form1: TForm1
     Height = 21

     Top = 2

     Width = 100

+    PopupMenu = PopupMenu1

     TabOrder = 4

   end

   object Button2: TButton

@@ -71,6 +76,7 @@ object Form1: TForm1
     Width = 48

     Caption = 'zurück'

     OnClick = Button2Click

+    PopupMenu = PopupMenu1

     TabOrder = 5

   end

   object Button3: TButton

@@ -80,6 +86,7 @@ object Form1: TForm1
     Width = 48

     Caption = 'laden'

     OnClick = Button3Click

+    PopupMenu = PopupMenu1

     TabOrder = 6

   end

   object Button4: TButton

@@ -89,6 +96,7 @@ object Form1: TForm1
     Width = 67

     Caption = 'speichern'

     OnClick = Button4Click

+    PopupMenu = PopupMenu1

     TabOrder = 7

   end

   object Button5: TButton

@@ -98,15 +106,18 @@ object Form1: TForm1
     Width = 64

     Caption = 'erzeugen'

     OnClick = Button5Click

+    PopupMenu = PopupMenu1

     TabOrder = 8

   end

   object CheckBox1: TCheckBox

     Left = 260

-    Height = 17

+    Height = 21

     Top = 4

-    Width = 78

+    Width = 100

     Caption = 'geschlossen'

     OnChange = CheckBox1Change

+    OnKeyDown = FormKeyDown

+    PopupMenu = PopupMenu1

     TabOrder = 9

   end

   object Timer1: TTimer

@@ -122,4 +133,32 @@ object Form1: TForm1
     left = 64

     top = 32

   end

+  object PopupMenu1: TPopupMenu

+    left = 96

+    top = 32

+    object MenuItem1: TMenuItem

+      Caption = 'füllen'

+      OnClick = MenuItem1Click

+    end

+    object MenuItem2: TMenuItem

+      Caption = 'leeren'

+      OnClick = MenuItem2Click

+    end

+    object MenuItem5: TMenuItem

+      Caption = 'ohne Nullen leeren'

+      OnClick = MenuItem5Click

+    end

+    object MenuItem4: TMenuItem

+      Caption = '10 Mal leeren'

+      OnClick = MenuItem4Click

+    end

+    object MenuItem6: TMenuItem

+      Caption = '10 Mal ohne Nullen leeren'

+      OnClick = MenuItem6Click

+    end

+    object MenuItem3: TMenuItem

+      Caption = 'Lösbarkeit'

+      OnClick = MenuItem3Click

+    end

+  end

 end

diff --git a/unit1.pas b/unit1.pas
index c4fa179..72ec28c 100644
--- a/unit1.pas
+++ b/unit1.pas
@@ -6,7 +6,7 @@ interface
 

 uses

   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,

-  Spin, ComCtrls, ExtCtrls, SlitherlinkUnit;

+  Spin, ComCtrls, ExtCtrls, Menus, SlitherlinkUnit;

 

 type

 

@@ -19,7 +19,14 @@ type
     Button4: TButton;

     Button5: TButton;

     CheckBox1: TCheckBox;

+    MenuItem1: TMenuItem;

+    MenuItem2: TMenuItem;

+    MenuItem3: TMenuItem;

+    MenuItem4: TMenuItem;

+    MenuItem5: TMenuItem;

+    MenuItem6: TMenuItem;

     OpenDialog1: TOpenDialog;

+    PopupMenu1: TPopupMenu;

     ProgressBar1: TProgressBar;

     SaveDialog1: TSaveDialog;

     SpinEdit1: TSpinEdit;

@@ -37,6 +44,12 @@ type
     procedure FormDestroy(Sender: TObject);

     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

     procedure FormResize(Sender: TObject);

+    procedure MenuItem1Click(Sender: TObject);

+    procedure MenuItem2Click(Sender: TObject);

+    procedure MenuItem3Click(Sender: TObject);

+    procedure MenuItem4Click(Sender: TObject);

+    procedure MenuItem5Click(Sender: TObject);

+    procedure MenuItem6Click(Sender: TObject);

     procedure SpinEdit1Change(Sender: TObject);

     procedure SpinEdit2Change(Sender: TObject);

     procedure SpinEdit3Change(Sender: TObject);

@@ -149,6 +162,91 @@ begin
   Progressbar1.Width:=Form1.ClientWidth-Progressbar1.Left;

 end;

 

+procedure TForm1.MenuItem1Click(Sender: TObject);

+var

+  x,y: longint;

+  s:   string;

+begin

+//  Feld.FelderErzeugen;

+  spinedit1.value:=13;

+  spinedit2.value:=12;

+  checkbox1.checked:=true;

+(*  s:=

+    ' 2222   2222 '+

+    '22  22 22  22'+

+    '2 00 2320  02'+

+    '1 0 0 1     1'+

+    '1           1'+

+    '2           2'+

+    '21         12'+

+    '120        21'+

+    '022      022 '+

+    '  22    022  '+

+    ' 0 221 122 0 '+

+    '   01232100  '; // geht! *)

+  s:=

+    '02   0 022  0'+

+    '2  0        2'+

+    '      3     2'+

+    ' 0   0 0    1'+

+    '1            '+

+    '           0 '+

+    '2          1 '+

+    '1         02 '+

+    '0220     02  '+

+    '   20        '+

+    '      0  2   '+

+    '    1 3  0   ';

+

+  for x:=0 to Feld.Breite-1 do

+    for y:=0 to Feld.Hoehe-1 do

+      if s[1+x+y*Feld.Breite]<>' ' then

+        Feld.Felder[x+y*(Feld.Breite+1)]:=

+          ord(s[1+x+y*Feld.Breite])-ord('0');

+  Feld.Zeichnen;

+end;

+

+procedure TForm1.MenuItem2Click(Sender: TObject);

+begin

+  Feld.Leeren(ProgressBar1,1);

+  Feld.Zeichnen;

+end;

+

+procedure TForm1.MenuItem3Click(Sender: TObject);

+var

+  anz: longint;

+begin

+  anz:=Feld.LoesungsAnzahl;

+  messagedlg('Es gibt zur Zeit '+inttostr(anz)+' Lösungsmöglichkeit'+copy('en',1,2*byte(anz<>1))+'.',mtInformation,[mbOk],0);

+end;

+

+procedure TForm1.MenuItem4Click(Sender: TObject);

+var

+  i: longint;

+begin

+  for i:=0 to 9 do begin

+    Feld.Leeren(ProgressBar1,1);

+    Feld.Zeichnen;

+    Application.ProcessMessages;

+  end;

+end;

+

+procedure TForm1.MenuItem5Click(Sender: TObject);

+begin

+  Feld.Leeren(ProgressBar1,1,false);

+end;

+

+procedure TForm1.MenuItem6Click(Sender: TObject);

+var

+  i: longint;

+begin

+  for i:=0 to 9 do begin

+    Feld.Leeren(ProgressBar1,1,false);

+    Feld.Zeichnen;

+    Application.ProcessMessages;

+  end;

+end;

+

 procedure TForm1.SpinEdit1Change(Sender: TObject);

 begin

   Feld.Breite:=SpinEdit1.Value;