{$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; procedure gesamtRaenderErzeugen; override; public NSqrt: integer; AMoeglich,EMoeglich: array of boolean; constructor create(aOwner: tForm); destructor destroy; override; // 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*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; K:=K*(groeszen[0]+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*(groeszen[0]+1)] and EMoeglich[S*(groeszen[0]+1)+Rand[Spalte]] and AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] and AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] and EMoeglich[W*(groeszen[0]+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*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; S:=S*(groeszen[0]+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*(groeszen[0]+1)+Rand[Spalte]] and AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] and AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] and EMoeglich[W*(groeszen[0]+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*(groeszen[0]+2)+inhalt[I*(dim+1)]+1; Result:=Result and AMoeglich[W*(groeszen[0]+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*(groeszen[0]+2)+inhalt[(I+1)*(dim-1)]+1; Result:=Result and AMoeglich[W*(groeszen[0]+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; buff: array of byte; lw: 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:=groeszen[0]+2; Faktor:=groeszen[0]+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,1); while not eof(dat) do begin blockread(dat,lw,sizeof(lw)); if lw=AK then begin Setlength(AMoeglich,AK); Setlength(EMoeglich,AK); setlength(buff,(lw+7) div 8); blockread(dat,buff[0],length(buff)); for i:=0 to length(buff)-1 do for j:=0 to min(7,length(AMoeglich)-8*i-1) do AMoeglich[8*i+j]:=odd(buff[i] shr j); blockread(dat,buff[0],length(buff)); for i:=0 to length(buff)-1 do for j:=0 to min(7,length(EMoeglich)-8*i-1) do EMoeglich[8*i+j]:=odd(buff[i] shr j); exit; end else seek(dat,filepos(dat)+2*((lw + 7) div 8)); end; closefile(dat); end; Progressbar1.Visible:=true; Progressbar1.Min:=0; Progressbar1.Max:=1000; Progressbar1.Position:=0; Application.ProcessMessages; 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 begin progressbar1.stepIt; application.processMessages; end; Nums:=calcNums(AK); B:=true; {$IFDEF buchstaben} Nullen:=groeszen[1]; 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 begin progressbar1.stepIt; application.processMessages; end; 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,1); seek(dat,filesize(dat)); end else rewrite(dat,1); lw:=length(AMoeglich); blockWrite(dat,lw,sizeof(lw)); setlength(buff,(length(AMoeglich)+7) div 8); for i:=0 to length(buff)-1 do begin buff[i]:=0; for j:=0 to min(7,length(AMoeglich)-8*i-1) do buff[i]:=buff[i] or (byte(AMoeglich[8*i+j]) shl j); end; blockWrite(dat,buff[0],length(buff)); for i:=0 to length(buff)-1 do begin buff[i]:=0; for j:=0 to min(7,length(EMoeglich)-8*i-1) do buff[i]:=buff[i] or (byte(EMoeglich[8*i+j]) shl j); end; blockWrite(dat,buff[0],length(buff)); closefile(dat); end; {$ENDIF} {$IFDEF passtZumZeichnen} // function tHochhausRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean; var I,KS,KZ: Integer; W,S: Longint; begin result:=false; {$IFDEF buchstaben} if inhalt[Zeile*dim+Spalte]=-1 then exit; {$ENDIF} {$IFDEF hochhaus} if inhalt[Zeile*dim+Spalte]=0 then exit; {$ENDIF} W:=0; S:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} W:=W*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; S:=S*(groeszen[0]+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*(groeszen[0]+1)+Rand[Spalte]] or not EMoeglich[S*(groeszen[0]+1)]) and (AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] or not AMoeglich[W*(groeszen[0]+1)]) and (AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] or not AMoeglich[S*(groeszen[0]+1)]) and (EMoeglich[W*(groeszen[0]+1)+Rand[3*dim+Zeile]] or not EMoeglich[W*(groeszen[0]+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:=groeszen[1] 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}