{$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; procedure randErzeugen; override; function loesen(lPos: integer): boolean; override; function anzLoesungen(lPos: integer): integer; override; procedure speichern(var datei: file); override; procedure laden(var datei: file); override; public constructor create(aOwner: tForm); destructor destroy; override; 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 NSqrt)*NSqrt; KS:=(Spalte div NSqrt)*NSqrt; 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)+max(0,inhalt[Zeile*dim+I]); S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); K:=K*(dim+1)+max(0,inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]); {$ENDIF} end; result:= AMoeglich[K*(groeszen[0]+1)] and EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] and AMoeglich[W*(groeszen[0]+1)+max(0,Rand[dim+Zeile])] and AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] and EMoeglich[W*(groeszen[0]+1)+max(0,Rand[3*dim+Zeile])]; 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)+max(0,inhalt[Zeile*dim+I]); S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); {$ENDIF} end; result:= EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] and AMoeglich[W*(groeszen[0]+1)+max(0,Rand[dim+Zeile])] and AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] and EMoeglich[W*(groeszen[0]+1)+max(0,Rand[3*dim+Zeile])]; 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)+max(0,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)+max(0,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; lw:=0; // silence warning 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; if (spalte>=0) and (zeile>=0) and (spalteZeile) 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 else begin // auf dem Rand if zeile=-1 then begin if rand[spalte]=-1 then exit; s:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; {$ENDIF} {$IFDEF hochhaus} S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); {$ENDIF} end; result:= EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] or not EMoeglich[S*(groeszen[0]+1)]; exit; end; if spalte=dim then begin if rand[dim+zeile]=-1 then exit; w:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; {$ENDIF} {$IFDEF hochhaus} w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]); {$ENDIF} end; result:= AMoeglich[w*(groeszen[0]+1)+max(0,Rand[dim+zeile])] or not AMoeglich[w*(groeszen[0]+1)]; exit; end; if zeile=dim then begin if rand[2*dim+spalte]=-1 then exit; s:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; {$ENDIF} {$IFDEF hochhaus} S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); {$ENDIF} end; result:= AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] or not EMoeglich[S*(groeszen[0]+1)]; exit; end; if spalte=-1 then begin if rand[3*dim+zeile]=-1 then exit; w:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; {$ENDIF} {$IFDEF hochhaus} w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]); {$ENDIF} end; result:= EMoeglich[w*(groeszen[0]+1)+max(0,Rand[3*dim+zeile])] or not EMoeglich[w*(groeszen[0]+1)]; exit; end; end; end; {$ENDIF} {$IFDEF randErzeugen} // procedure tHochhausRaetsel.RandErzeugen; var i,j: integer; {$IFDEF hochhaus} h,z: integer; {$ENDIF} begin for i:=0 to dim-1 do begin {$IFDEF hochhaus} h:=0; z:=0; {$ENDIF} for j:=0 to dim-1 do begin if inhalt[i+dim*j]=-1 then begin {$IFDEF hochhaus} z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} if inhalt[i+dim*j]=0 then continue; Rand[I]:=inhalt[I+dim*J]; break; {$ENDIF} {$IFDEF hochhaus} if inhalt[I+dim*J]>H then begin H:=inhalt[I+dim*J]; inc(Z); end; {$ENDIF} end; {$IFDEF hochhaus} Rand[I]:=Z; H:=0; Z:=0; {$ENDIF} For J:=dim-1 downto 0 do begin if inhalt[I+dim*J]=-1 then begin {$IFDEF hochhaus} z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} if inhalt[i+dim*j]=0 then continue; Rand[2*dim+I]:=inhalt[I+dim*J]; break; {$ENDIF} {$IFDEF hochhaus} if inhalt[I+dim*J]>H then begin H:=inhalt[I+dim*J]; inc(Z); end; {$ENDIF} end; {$IFDEF hochhaus} Rand[2*dim+I]:=Z; H:=0; Z:=0; {$ENDIF} For J:=dim-1 downto 0 do begin if inhalt[J+dim*I]=-1 then begin {$IFDEF hochhaus} z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} if inhalt[J+dim*I]=0 then continue; Rand[dim+I]:=inhalt[J+dim*I]; break; {$ENDIF} {$IFDEF hochhaus} if inhalt[J+dim*I]>H then begin H:=inhalt[J+dim*I]; inc(Z); end; {$ENDIF} end; {$IFDEF hochhaus} Rand[dim+I]:=Z; H:=0; Z:=0; {$ENDIF} For J:=0 to dim-1 do begin if inhalt[J+dim*I]=-1 then begin {$IFDEF hochhaus} Z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} if inhalt[J+dim*I]=0 then continue; Rand[3*dim+I]:=inhalt[J+dim*I]; break; {$ENDIF} {$IFDEF hochhaus} if inhalt[J+dim*I]>H then begin H:=inhalt[J+dim*I]; inc(Z); end; {$ENDIF} end; {$IFDEF hochhaus} Rand[3*dim+I]:=Z; {$ENDIF} end; end; {$ENDIF} {$IFDEF relativeInhaltsAenderung} // procedure tHochhausRaetsel.relativeInhaltsAenderung(diff: longint); begin if (cursorPosition<0) or (cursorPosition>=dim*dim) or startfeld[cursorPosition] then exit; alsZugSpeichern; {$IFDEF hochhaus} if inhalt[cursorPosition]=-1 then inhalt[cursorPosition]:=0; {$ENDIF} inhalt[cursorPosition]:=min(max(-1,inhalt[cursorPosition]+diff),groeszen[0]); {$IFDEF hochhaus} if inhalt[cursorPosition]=0 then inhalt[cursorPosition]:=-1; {$ENDIF} feldFarben[cursorPosition]:=aktuelleFarbe; end; {$ENDIF} {$IFDEF absoluteInhaltsAenderung} // function tHochhausRaetsel.absoluteInhaltsAenderung(key: word): boolean; begin if (cursorPosition<0) or (cursorPosition>=dim*dim) or startfeld[cursorPosition] then begin result:=false; exit; end; result:=true; {$IFDEF buchstaben} if (key>=ord('A')) and (key<=min(ord('A')+groeszen[0]-1,ord('Z'))) then begin alsZugSpeichern; inhalt[cursorPosition]:=key-ord('A')+1; feldFarben[cursorPosition]:=aktuelleFarbe; exit; end; if (key in [109,189]) then begin alsZugSpeichern; inhalt[cursorPosition]:=0; feldFarben[cursorPosition]:=aktuelleFarbe; exit; end; {$ENDIF} {$IFDEF hochhaus} if (key>=ord('1')) and (key<=min(ord('1')+groeszen[0]-1,ord('9'))) then begin alsZugSpeichern; inhalt[cursorPosition]:=key-ord('1')+1; feldFarben[cursorPosition]:=aktuelleFarbe; exit; end; {$ENDIF} if (key=ord(' ')) or (key=46) or (key=8) then begin alsZugSpeichern; inhalt[cursorPosition]:=-1; feldFarben[cursorPosition]:=aktuelleFarbe; exit; end; result:=false; end; {$ENDIF} {$IFDEF loesen} // function tHochhausRaetsel.loesen(lPos: integer): boolean; var i,p: integer; perm: tLongintArray; begin result:=false; setlength(perm,0); for p:=lPos+1 to dim*dim-1 do if inhalt[P]=-1 then begin {$IFDEF buchstaben} perm:=permutation(groeszen[0]+1); {$ENDIF} {$IFDEF hochhaus} perm:=permutation(dim); {$ENDIF} for I:=0 to dim-1 do begin {$IFDEF buchstaben} inhalt[P]:=Perm[I]; {$ENDIF} {$IFDEF hochhaus} inhalt[P]:=Perm[I]+1; {$ENDIF} if passt(P mod dim,P div dim) then if loesen(P) then begin result:=true; exit; end; end; inhalt[P]:=-1; exit; end; result:=true; end; {$ENDIF} {$IFDEF anzLoesungen} // function tHochhausRaetsel.anzLoesungen(lPos: integer): integer; var i,p: integer; begin result:=0; for P:=lPos+1 to dim*dim-1 do if inhalt[P]=-1 then begin for {$IFDEF hochhaus} I:=1 {$ENDIF} {$IFDEF buchstaben}I:=0 {$ENDIF} to groeszen[0] do begin inhalt[P]:=I; if passt(P mod dim,P div dim) then result:=result+Anzloesungen(P); if result>=2 then begin inhalt[P]:=-1; exit; end; end; inhalt[P]:=-1; exit; end; result:=1; end; {$ENDIF} {$IFDEF speichern} // procedure tHochhausRaetsel.speichern(var datei: file); begin {$IFDEF hochhaus} blockWrite(datei,'Ho',2); {$ENDIF} {$IFDEF buchstaben} blockWrite(datei,'Bu',2); {$ENDIF} inherited speichern(datei); end; {$ENDIF} {$IFDEF laden} // procedure tHochhausRaetsel.laden(var datei: file); var s: string[2]; begin s:=#0#0; blockRead(datei,s[1],2); {$IFDEF hochhaus} assert(s='Ho','Die zu ladende Datei ist kein Hochhausrätsel!'); uebersetze:=@zahlenAlphabetFunktion; {$ENDIF} {$IFDEF buchstaben} assert(s='Bu','Die zu ladende Datei ist kein Buchstabenrätsel!'); uebersetze:=@buchstabenAlphabetFunktion; {$ENDIF} inherited laden(datei); end; {$ENDIF}