From 8add9f4d6a086e28ca34462a9bcac9cb9e320535 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Sun, 16 Aug 2020 21:47:04 +0200 Subject: whatever --- Slitherlink.lpi | 9 +---- SlitherlinkUnit.pas | 51 ++++++++++++++++++++++----- unit1.lfm | 57 +++++++++++++++++++++++++----- unit1.pas | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++- 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 @@ - + @@ -39,7 +39,6 @@ - @@ -68,12 +67,6 @@ - - - - - - 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; -- cgit v1.2.3-54-g00ecf