{$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}