summaryrefslogtreecommitdiff
path: root/raetselunit.inc
diff options
context:
space:
mode:
Diffstat (limited to 'raetselunit.inc')
-rw-r--r--raetselunit.inc439
1 files changed, 439 insertions, 0 deletions
diff --git a/raetselunit.inc b/raetselunit.inc
new file mode 100644
index 0000000..57e68fd
--- /dev/null
+++ b/raetselunit.inc
@@ -0,0 +1,439 @@
+{$IFDEF interface}
+
+type
+{$IFDEF hochhaus}
+ tHochhausRaetsel = class(tFelderRaetsel)
+{$ENDIF}
+{$IFDEF buchstaben}
+ tBuchstabenRaetsel = class(tFelderRaetsel)
+{$ENDIF}
+ private
+// procedure relativeInhaltsAenderung(diff: longint); override;
+// function absoluteInhaltsAenderung(key: word): boolean; override;
+ public
+ {$IFDEF buchstaben}
+ NBuchst,
+ NLeer,
+ {$ENDIF}
+ NSqrt: integer;
+ AMoeglich,EMoeglich: array of boolean;
+ constructor create(aOwner: tForm);
+ destructor destroy; override;
+ procedure gesamtRaenderErzeugen;
+(* function passtZumZeichnen(Spalte,Zeile: integer): boolean;
+ procedure Zeichnen;
+ procedure schreibe(was: String; Spalte,Zeile: integer); *)
+ function passt(spalte,zeile: integer): boolean; override;
+// function Loesen(lPos: integer): boolean;
+ function geloest: boolean;
+(* procedure leeren;
+ procedure RandErzeugen;
+ function anzLoesungen(lPos: integer): integer;
+ procedure Image2Bemalen; *)
+ end;
+
+{$IFDEF hochhaus}
+function zahlenAlphabetFunktion(i: longint): string;
+{$ENDIF}
+{$IFDEF buchstaben}
+function buchstabenAlphabetFunktion(i: longint): string;
+{$ENDIF}
+
+{$ENDIF}
+
+{$IFDEF alphabetFunktion}
+// function *AlphabetFunktion(i: longint): string;
+begin
+ if i<0 then
+ result:=''
+ else if i=0 then
+ result:='-'
+{$IFDEF hochhaus}
+ else
+ result:=inttostr(i);
+{$ENDIF}
+{$IFDEF buchstaben}
+ else begin
+ result:='';
+ while i>0 do begin
+ dec(i);
+ result:=char(ord('A')+(i mod 26))+result;
+ i:=i div 26;
+ end;
+ end;
+{$ENDIF}
+end;
+{$ENDIF}
+
+{$IFDEF create}
+// constructor tHochhausRaetsel.create(aOwner: tForm);
+begin
+{$IFDEF hochhaus}
+ inherited create(aOwner,1,@zahlenAlphabetFunktion);
+ spinEdits[1].showHint:=true;
+ spinEdits[1].hint:='Anzahl Spalten';
+ spinEdits[1].value:=5;
+{$ENDIF}
+{$IFDEF buchstaben}
+ inherited create(aOwner,2,@buchstabenAlphabetFunktion);
+ spinEdits[1].showHint:=true;
+ spinEdits[1].hint:='Anzahl Buchstaben';
+ spinEdits[1].value:=5;
+ spinEdits[2].showHint:=true;
+ spinEdits[2].hint:='Anzahl Leerfelder';
+ spinEdits[2].value:=1;
+{$ENDIF}
+ aktualisiereGroesze;
+end;
+{$ENDIF}
+
+{$IFDEF destroy}
+// destructor tHochhausRaetsel.destroy;
+begin
+ inherited destroy;
+end;
+{$ENDIF}
+
+{$IFDEF passt}
+// function tHochhausRaetsel.passt(spalte,zeile: integer): boolean;
+var
+ I,KZ,KS: Integer;
+ W,S,K: Longint;
+begin
+ W:=0;
+ S:=0;
+ K:=0;
+ if sudokuCB.checked then begin
+ KZ:=(Zeile div dim)*dim;
+ KS:=(Spalte div dim)*dim;
+ for I:=0 to dim-1 do begin
+ {$IFDEF buchstaben}
+ W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1;
+ S:=S*(NBuchst+2)+inhalt[I*dim+Spalte]+1;
+ K:=K*(NBuchst+2)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]+1;
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ W:=W*(dim+1)+inhalt[Zeile*dim+I];
+ S:=S*(dim+1)+inhalt[I*dim+Spalte];
+ K:=K*(dim+1)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)];
+ {$ENDIF}
+ end;
+ result:=
+ {$IFDEF buchstaben}
+ AMoeglich[K*(NBuchst+1)] and
+ EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
+ AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and
+ AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and
+ EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]];
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ AMoeglich[K*(dim+1)] and
+ EMoeglich[S*(dim+1)+Rand[Spalte]] and
+ AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
+ AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
+ EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
+ {$ENDIF}
+ end
+ else begin
+ for I:=0 to dim-1 do begin
+ {$IFDEF buchstaben}
+ W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1;
+ S:=S*(NBuchst+2)+inhalt[I*dim+Spalte]+1;
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ W:=W*(dim+1)+inhalt[Zeile*dim+I];
+ S:=S*(dim+1)+inhalt[I*dim+Spalte];
+ {$ENDIF}
+ end;
+ result:=
+ {$IFDEF buchstaben}
+ EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
+ AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and
+ AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and
+ EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]];
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ EMoeglich[S*(dim+1)+Rand[Spalte]] and
+ AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
+ AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
+ EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
+ {$ENDIF}
+ end;
+ if diagonalenCB.checked then begin
+ if Zeile=Spalte then begin
+ W:=0;
+ {$IFDEF buchstaben}
+ for I:=0 to dim-1 do
+ W:=W*(NBuchst+2)+inhalt[I*(dim+1)]+1;
+ Result:=Result and AMoeglich[W*(NBuchst+1)];
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ for I:=0 to dim-1 do
+ W:=W*(dim+1)+inhalt[I*(dim+1)];
+ result:=result and AMoeglich[W*(dim+1)];
+ {$ENDIF}
+ end;
+ if Zeile+Spalte=dim-1 then begin
+ W:=0;
+ {$IFDEF buchstaben}
+ for I:=0 to dim-1 do
+ W:=W*(NBuchst+2)+inhalt[(I+1)*(dim-1)]+1;
+ Result:=Result and AMoeglich[W*(NBuchst+1)];
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ for I:=0 to dim-1 do
+ W:=W*(dim+1)+inhalt[(I+1)*(dim-1)];
+ Result:=Result and AMoeglich[W*(dim+1)];
+ {$ENDIF}
+ end;
+ end;
+end;
+{$ENDIF}
+
+{$IFDEF geloest}
+// function tHochhausRaetsel.geloest: boolean;
+var
+ i,j: integer;
+begin
+ result:=false;
+ for i:=0 to dim-1 do
+ for j:=0 to dim-1 do
+ if (not passt(i,j)) or (inhalt[i+dim*j]<0)
+ {$IFDEF hochhaus}
+ or (inhalt[I+dim*j]=0)
+ {$ENDIF}
+ then exit;
+ result:=true;
+end;
+{$ENDIF}
+
+{$IFDEF gesamtRaenderErzeugen}
+// procedure tHochhausRaetsel.gesamtRaenderErzeugen;
+var
+ I,J,K,Nullen: Integer;
+ {$IFNDEF buchstaben}
+ AZ,
+ {$ENDIF}
+ AR: Integer;
+ AK,EK,NAK,NEK: Longint;
+ Nums: tLongintArray;
+ B: Boolean;
+ Basis,Faktor: Integer;
+ Schritt: Longint;
+ dat: File of Cardinal;
+ lw1,lw2,L: Cardinal;
+
+const dat_name =
+{$IFDEF buchstaben}
+ 'Buchstabenraetsel.dat';
+{$ENDIF}
+{$IFDEF hochhaus}
+ 'Hochhausraetsel.dat';
+{$ENDIF}
+
+function calcNums(I: Longint): tLongintArray;
+var
+ J: Integer;
+begin
+ Setlength(Result,dim);
+ For J:=0 to dim-1 do begin
+ Result[J]:=I mod Basis;
+ I:=I div Basis;
+ end;
+end;
+
+function calcIndex(Nums: TLongintArray): Longint;
+var
+ j: integer;
+begin
+ Result:=0;
+ For j:=0 to dim-1 do
+ Result:=Result*Basis + Nums[dim-J-1];
+end;
+
+function swapIndex(I: Longint): Longint;
+var
+ j: integer;
+begin
+ Result:=0;
+ for J:=0 to dim-1 do begin
+ Result:=Result*Basis+(I mod Basis);
+ I:=I div Basis;
+ end;
+end;
+
+begin
+ {$IFDEF buchstaben}
+ Basis:=NBuchst+2;
+ Faktor:=NBuchst+1;
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ Basis:=dim+1;
+ Faktor:=dim+1;
+ {$ENDIF}
+ AK:=round(power(Basis,dim)*Faktor);
+
+ if (length(AMoeglich) = AK) and
+ (length(EMoeglich) = AK) then
+ exit;
+
+ if fileexists(extractfilepath(application.exename)+dat_name) then begin
+ assignfile(dat,extractfilepath(application.exename)+dat_name);
+ reset(dat);
+ while not eof(dat) do begin
+ read(dat,lw1);
+ if lw1=AK then begin
+ Setlength(AMoeglich,AK);
+ Setlength(EMoeglich,AK);
+ for L:=0 to length(AMoeglich)-1 do begin
+ if L mod 32 = 0 then
+ if not eof(dat) then
+ read(dat,lw2)
+ else begin
+ messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
+ exit;
+ end;
+ AMoeglich[L]:=odd(lw2 shr (L mod 32));
+ end;
+ For L:=0 to length(EMoeglich)-1 do begin
+ if L mod 32 = 0 then
+ if not eof(dat) then
+ read(dat,lw2)
+ else begin
+ messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
+ exit;
+ end;
+ EMoeglich[L]:=odd(lw2 shr (L mod 32));
+ end;
+ exit;
+ end
+ else
+ Seek(dat,Filepos(dat)+((lw1-1) div 32 +1)*2);
+ end;
+ closefile(dat);
+ end;
+
+ Progressbar1.Visible:=true;
+ Progressbar1.Min:=0;
+ Progressbar1.Max:=1000;
+ Progressbar1.Position:=0;
+
+ Setlength(AMoeglich,AK);
+ Setlength(EMoeglich,AK);
+ For AK:=0 to length(AMoeglich)-1 do begin
+ AMoeglich[AK]:=False;
+ EMoeglich[AK]:=False;
+ end;
+ Setlength(Nums,0);
+
+ Schritt:=max(1,round((length(AMoeglich) div Faktor) / Progressbar1.Max));
+ For AK:=0 to length(AMoeglich) div Faktor -1 do begin
+ if AK mod Schritt = 0 then
+ Progressbar1.StepIt;
+ Nums:=calcNums(AK);
+ B:=true;
+ {$IFDEF buchstaben}
+ Nullen:=NLeer;
+ For I:=0 to length(Nums)-1 do
+ begin
+ B:=B and (Nums[I]<>0);
+ if Nums[I]=1 then dec(Nullen)
+ else
+ For J:=0 to I-1 do
+ B:=B and (Nums[I]<>Nums[J]);
+ end;
+ B:=B and (Nullen>=0);
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ For I:=0 to length(Nums)-1 do begin
+ B:=B and (Nums[I]<>0);
+ For J:=0 to I-1 do
+ B:=B and (Nums[I]<>Nums[J]);
+ end;
+ {$ENDIF}
+ if B then begin
+ EK:=swapIndex(AK);
+ AR:=0;
+ {$IFNDEF buchstaben}
+ AZ:=0;
+ {$ENDIF}
+ For I:=0 to dim-1 do begin
+ {$IFDEF buchstaben}
+ if Nums[I]>1 then begin
+ AR:=Nums[I]-1;
+ break;
+ end;
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ if Nums[I]>AZ then begin
+ inc(AR);
+ AZ:=Nums[I];
+ end;
+ {$ENDIF}
+ end;
+
+ AMoeglich[AK*Faktor+AR]:=true;
+ EMoeglich[EK*Faktor+AR]:=true;
+ AMoeglich[AK*Faktor]:=true;
+ EMoeglich[EK*Faktor]:=true;
+ end;
+ end;
+
+ Progressbar1.Position:=0;
+ Schritt:=Max(round(((length(AMoeglich) div Faktor)*dim) / Progressbar1.Max),1);
+ For Nullen:=1 to dim do
+ For AK:=0 to length(AMoeglich) div Faktor -1 do begin
+ if AK mod Schritt = 0 then
+ Progressbar1.StepIt;
+ Nums:=calcNums(AK);
+ J:=Nullen;
+ For I:=0 to dim-1 do
+ if Nums[I]=0 then
+ dec(J);
+ if J<>0 then
+ continue;
+ EK:=swapIndex(AK);
+ For I:=0 to dim-1 do
+ if Nums[I]=0 then begin
+ For J:=1 to Basis-1 do begin
+ Nums[I]:=J;
+ NAK:=calcIndex(Nums);
+ NEK:=swapIndex(NAK);
+ For K:=0 to Faktor-1 do begin
+ AMoeglich[AK*Faktor+K]:=AMoeglich[AK*Faktor+K] or AMoeglich[NAK*Faktor+K];
+ EMoeglich[EK*Faktor+K]:=EMoeglich[EK*Faktor+K] or EMoeglich[NEK*Faktor+K];
+ end;
+ end;
+ break;
+ end;
+ end;
+ Progressbar1.Visible:=False;
+
+ assignfile(dat,extractfilepath(application.exename)+dat_name);
+ if Fileexists(extractfilepath(application.exename)+dat_name) then begin
+ reset(dat);
+ Seek(dat,Filesize(dat));
+ end
+ else
+ Rewrite(dat);
+
+ lw1:=length(AMoeglich);
+ write(dat,lw1);
+ lw1:=0;
+ For I:=0 to length(AMoeglich)-1 do begin
+ lw1:=lw1 or (Byte(AMoeglich[I]) shl (I mod 32));
+ if ((I mod 32) = 31) or (I = length(AMoeglich)-1) then begin
+ write(dat,lw1);
+ lw1:=0;
+ end;
+ end;
+ For I:=0 to length(EMoeglich)-1 do begin
+ lw1:=lw1 or (Byte(EMoeglich[I]) shl (I mod 32));
+ if ((I mod 32) = 31) or (I = length(EMoeglich)-1) then begin
+ write(dat,lw1);
+ lw1:=0;
+ end;
+ end;
+ closefile(dat);
+end;
+{$ENDIF}
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-24 00:27:02 +0000