{$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; function passtZumZeichnen(spalte,zeile: integer): boolean; override; function passt(spalte,zeile: integer): boolean; override; function geloest: 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 Loesen(lPos: integer): 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} {$IFDEF passtZumZeichnen} // function tHochhausRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean; var I,KS,KZ: Integer; W,S: Longint; begin {$IFDEF buchstaben} if inhalt[Zeile*dim+Spalte]=-1 then begin {$ENDIF} {$IFDEF hochhaus} if inhalt[Zeile*dim+Spalte]=0 then begin {$ENDIF} result:=false; exit; end; W:=0; S:=0; 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]] or not EMoeglich[S*(NBuchst+1)]) and (AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] or not AMoeglich[W*(NBuchst+1)]) and (AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] or not AMoeglich[S*(NBuchst+1)]) and (EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]] or not EMoeglich[W*(NBuchst+1)]); {$ENDIF} {$IFDEF hochhaus} (EMoeglich[S*(dim+1)+Rand[Spalte]] or not EMoeglich[S*(dim+1)]) and (AMoeglich[W*(dim+1)+Rand[dim+Zeile]] or not AMoeglich[W*(dim+1)]) and (AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] or not AMoeglich[S*(dim+1)]) and (EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]] or not EMoeglich[W*(dim+1)]); {$ENDIF} {$IFDEF buchstaben} if inhalt[Zeile*dim+Spalte]=0 then W:=NLeer else {$ENDIF} W:=1; if diagonalenCB.checked then begin if Zeile=Spalte then begin S:=W; for I:=0 to dim-1 do if (I<>Zeile) and (inhalt[I*(dim+1)]=inhalt[Zeile*dim+Spalte]) then dec(S); Result:=Result and (S>0); end; if Zeile+Spalte=dim-1 then begin S:=W; For I:=0 to dim-1 do if (I<>Zeile) and (inhalt[(I+1)*(dim-1)]=inhalt[Zeile*dim+Spalte]) then dec(S); Result:=Result and (S>0); end; end; if sudokuCB.checked then begin KZ:=(Zeile div NSqrt)*NSqrt; KS:=(Spalte div NSqrt)*NSqrt; S:=W+1; For I:=0 to dim-1 do if inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]=inhalt[Zeile*dim+Spalte] then dec(S); Result:=Result and (S>0); end; S:=W; For I:=0 to dim-1 do if (I<>Zeile) and (inhalt[I*dim+Spalte]=inhalt[Zeile*dim+Spalte]) then dec(S); Result:=Result and (S>0); S:=W; For I:=0 to dim-1 do if (I<>Spalte) and (inhalt[Zeile*dim+I]=inhalt[Zeile*dim+Spalte]) then dec(S); Result:=Result and (S>0); end; {$ENDIF}