unit raetselunit; {$mode objfpc}{$H+} interface // TODO: Cross-Compilieren uses Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls, LCLType, lowlevelunit, Messages, ComCtrls, Graphics; type tAlphabetFunktion = function(i: longint): string; tButtonWithArrowKeys = class(tButton) private procedure wMGetDlgCode(var msg: tWMGetDlgCode); message wM_GETDLGCODE; end; tSmarterCheckBox = class(tCheckBox) function width: longint; end; tZug = record position: integer; vorher: integer; vorherFarbe, nachherFarbe, vorherMalFarbe: tColor; end; tOnSetCaption = procedure(c: string) of object; tRaetsel = class private besitzer: tForm; farbWahlFlaeche, zeichenFlaeche: tImage; erzeugeBtn, speichernBtn, ladenBtn, druckenBtn: tButtonWithArrowKeys; zufallSE, druckenSE: tSpinEdit; progressBar1: tProgressBar; aktuelleFarbe: tColor; function besitzerHoehe: longint; dynamic; function besitzerBreite: longint; dynamic; procedure zeichenFlaecheNeuKreieren; procedure onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); dynamic; abstract; procedure onMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); dynamic; abstract; procedure onFarbWahlMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); procedure onFarbWahlMouseMove(sender: tObject; shiftState: tShiftState; x,y: longint); procedure onFarbWahlMouseUp(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); procedure erzeugeOnClick(sender: tObject); procedure speichernOnClick(sender: tObject); procedure ladenOnClick(sender: tObject); procedure druckenOnClick(sender: tObject); procedure farbWahlFlaecheBemalen; procedure loeschen; dynamic; abstract; procedure leeren; dynamic; abstract; procedure vorbereiten; dynamic; abstract; function loesen(lPos: longint): boolean; dynamic; abstract; function anzLoesungen(lPos: longint): longint; dynamic; abstract; function passtZumZeichnen(spalte,zeile: integer): boolean; dynamic; abstract; function passt(spalte,zeile: integer): boolean; dynamic; abstract; function geloest: boolean; dynamic; abstract; procedure randErzeugen; dynamic; abstract; procedure startFelderFestlegen; dynamic; abstract; procedure speichern(var datei: file); dynamic; procedure laden(var datei: file); dynamic; public onSetCaption: tOnSetCaption; constructor create(aOwner: tForm); destructor destroy; override; procedure zeichnen(cursor: boolean = true); dynamic; abstract; end; tFelderRaetsel = class(tRaetsel) private spinEdits: array of tSpinEdit; diagonalenCB,sudokuCB,puzzleCB: tSmarterCheckBox; groeszen,inhalt,rand: array of longint; invPuzzleTeile: array of tIntPoint; // Ort -> [Teil, Kachel] puzzleTeile: array of array of longint; // [Teil,Kachel] -> Ort AMoeglich,EMoeglich: array of boolean; dim,schriftGroesze, cursorPosition: longint; zellGroesze: extended; uebersetze: tAlphabetFunktion; feldFarben: array of tColor; startFeld: array of boolean; zuege: array of tZug; procedure anzSEsOnChange(sender: tObject); procedure cbOnChange(sender: tObject); procedure onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); override; procedure onMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); override; procedure aktualisiereGroesze; procedure loeschen; override; procedure leeren; override; procedure vorbereiten; override; procedure aktualisiereZeichenflaechenGroesze; function besitzerHoehe: longint; override; function besitzerBreite: longint; override; procedure schreibeZentriert(x,y,i: longint); procedure relativeInhaltsAenderung(diff: longint); dynamic; abstract; function naechsterWert(pos: longint): boolean; dynamic; abstract; function absoluteInhaltsAenderung(key: word): boolean; dynamic; abstract; procedure gesamtRaenderErzeugen; dynamic; abstract; procedure startFelderFestlegen; override; procedure alsZugSpeichern; procedure speichern(var datei: file); override; procedure laden(var datei: file); override; procedure findePuzzelierung; public constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); destructor destroy; override; procedure zeichnen(cursor: boolean = true); override; end; {$DEFINE interface} {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF interface} function farbVerlauf(wo: extended): tColor; function rgb2TColor(r,g,b: extended): tColor; inline; const spacing = 2; implementation uses math, dialogs, lclintf, extDlgs, matheunit; {$DEFINE alphabetFunktion} function zahlenAlphabetFunktion(i: longint): string; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function buchstabenAlphabetFunktion(i: longint): string; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF alphabetFunktion} function farbVerlauf(wo: extended): tColor; const r: array[0..6] of extended = (0.5,0.9,0.9, 0, 0,0.2,0); g: array[0..6] of extended = ( 0,0.5,0.9,0.7,0.7,0.2,0); b: array[0..6] of extended = (0.7, 0, 0, 0,0.7, 1,0); var i: integer; begin wo:=wo*(length(r)-1); i:=floor(wo); wo:=wo-i; if i<0 then begin result:=rgb2TColor(r[0],g[0],b[0]); exit; end; if i>=(length(r)-1) then begin result:=rgb2TColor(r[length(r)-1],g[length(r)-1],b[length(r)-1]); exit; end; result:=rgb2TColor(r[i+1]*wo+r[i]*(1-wo), g[i+1]*wo+g[i]*(1-wo), b[i+1]*wo+b[i]*(1-wo)); end; function rgb2TColor(r,g,b: extended): tColor; begin result:=max(0,min($FF,round(r*$100))) or (max(0,min($FF,round(g*$100))) shl 8) or (max(0,min($FF,round(b*$100))) shl 16); end; // tButtonWithArrowKeys ******************************************************** procedure tButtonWithArrowKeys.wMGetDlgCode(var msg: tWMGetDlgCode);// message wM_GETDLGCODE; begin inherited; msg.result := msg.result or DLGC_WANTARROWS; end; // tSmarterCheckBox ************************************************************ function tSmarterCheckBox.width: longint; var c: tCanvas; begin c:=tCanvas.create; c.handle:=getDC(handle); c.font:=font; result:=height+c.textWidth(caption); releaseDC(handle,c.handle); c.free; end; // tRaetsel ******************************************************************** constructor tRaetsel.create(aOwner: tForm); begin inherited create; randomize; besitzer:=aOwner; zeichenFlaeche:=tImage.create(besitzer); zeichenFlaeche.parent:=besitzer; zeichenFlaeche.onMouseDown:=@onMouseDown; farbWahlFlaeche:=tImage.create(besitzer); farbWahlFlaeche.parent:=besitzer; farbWahlFlaeche.onMouseDown:=@onFarbWahlMouseDown; farbWahlFlaeche.onMouseMove:=@onFarbWahlMouseMove; farbWahlFlaeche.onMouseUp:=@onFarbWahlMouseUp; erzeugeBtn:=tButtonWithArrowKeys.create(besitzer); erzeugeBtn.parent:=besitzer; erzeugeBtn.left:=spacing; erzeugeBtn.top:=spacing; erzeugeBtn.caption:='Erzeugen!'; erzeugeBtn.onClick:=@erzeugeOnClick; erzeugeBtn.onKeyDown:=@onKeyDown; speichernBtn:=tButtonWithArrowKeys.create(besitzer); speichernBtn.parent:=besitzer; speichernBtn.left:=erzeugeBtn.left+erzeugeBtn.width+spacing; speichernBtn.top:=spacing; speichernBtn.caption:='Speichern!'; speichernBtn.onClick:=@speichernOnClick; speichernBtn.onKeyDown:=@onKeyDown; ladenBtn:=tButtonWithArrowKeys.create(besitzer); ladenBtn.parent:=besitzer; ladenBtn.left:=speichernBtn.left+speichernBtn.width+spacing; ladenBtn.top:=spacing; ladenBtn.caption:='Laden!'; ladenBtn.onClick:=@ladenOnClick; ladenBtn.onKeyDown:=@onKeyDown; druckenSE:=tSpinEdit.create(besitzer); druckenSE.parent:=besitzer; druckenSE.left:=ladenBtn.left+ladenBtn.width+spacing; druckenSE.top:=spacing; druckenSE.value:=1; druckenSE.minValue:=0; druckenSE.maxValue:=65536; druckenSE.showHint:=true; druckenSE.hint:='Anzahl zu druckender Rätsel'; druckenSE.onKeyDown:=@onKeyDown; druckenBtn:=tButtonWithArrowKeys.create(besitzer); druckenBtn.parent:=besitzer; druckenBtn.left:=druckenSE.left+druckenSE.width+spacing; druckenBtn.top:=spacing; druckenBtn.caption:='Drucken!'; druckenBtn.onClick:=@druckenOnClick; druckenBtn.onKeyDown:=@onKeyDown; zufallSE:=tSpinEdit.create(besitzer); zufallSE.parent:=besitzer; zufallSE.top:=erzeugeBtn.top+erzeugeBtn.height+spacing; zufallSE.left:=spacing; zufallSE.width:=64; zufallSE.minValue:=0; zufallSE.maxValue:=99999; zufallSE.value:=random(zufallSE.maxValue+1); zufallSE.showHint:=true; zufallSE.hint:='Nummer'; progressBar1:=tProgressBar.create(besitzer); progressBar1.visible:=false; progressBar1.smooth:=true; progressBar1.parent:=besitzer; end; destructor tRaetsel.destroy; begin zeichenFlaeche.free; farbWahlFlaeche.free; inherited destroy; end; function tRaetsel.besitzerHoehe: longint; begin result:=zeichenFlaeche.height+zeichenFlaeche.top+spacing; end; function tRaetsel.besitzerBreite: longint; begin result:= max( zeichenFlaeche.width+zeichenFlaeche.left, druckenBtn.width+druckenBtn.left )+spacing; end; procedure tRaetsel.zeichenFlaecheNeuKreieren; var i: tImage; begin i:=tImage.create(besitzer); i.parent:=zeichenFlaeche.parent; i.left:=zeichenFlaeche.left; i.top:=zeichenFlaeche.top; i.width:=zeichenFlaeche.width; i.height:=zeichenFlaeche.height; i.canvas.font.size:=zeichenFlaeche.canvas.font.size; i.onMouseDown:=zeichenFlaeche.onMouseDown; zeichenFlaeche.free; zeichenFlaeche:=i; i:=tImage.create(besitzer); i.parent:=farbWahlFlaeche.parent; i.left:=farbWahlFlaeche.left; i.top:=farbWahlFlaeche.top; i.width:=farbWahlFlaeche.width; i.height:=farbWahlFlaeche.height; i.onMouseDown:=farbWahlFlaeche.onMouseDown; i.onMouseMove:=farbWahlFlaeche.onMouseMove; i.onMouseUp:=farbWahlFlaeche.onMouseUp; farbWahlFlaeche.free; farbWahlFlaeche:=i; farbWahlFlaecheBemalen; end; procedure tRaetsel.onFarbWahlMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); begin if button<>mbLeft then exit; aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; procedure tRaetsel.onFarbWahlMouseMove(sender: tObject; shiftState: tShiftState; x,y: longint); begin if not(ssLeft in shiftState) then exit; aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; procedure tRaetsel.onFarbWahlMouseUp(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); begin if button<>mbLeft then exit; aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; procedure tRaetsel.erzeugeOnClick(sender: tObject); begin loeschen; randSeed:=zufallSE.value; if assigned(onSetCaption) then onSetCaption(intToStr(zufallSE.value)); zufallSE.value:=random(zufallSE.maxValue+1); repeat vorbereiten; until loesen(-1); randErzeugen; leeren; startFelderFestlegen; zeichnen; end; procedure tRaetsel.speichernOnClick(sender: tObject); var saveDialog1: tSaveDialog; dat: file; begin saveDialog1:=tSaveDialog.create(besitzer); if saveDialog1.execute then begin assignFile(dat,saveDialog1.fileName); rewrite(dat,1); speichern(dat); closeFile(dat); end; saveDialog1.free; end; procedure tRaetsel.ladenOnClick(sender: tObject); var openDialog1: tOpenDialog; dat: file; begin openDialog1:=tOpenDialog.create(besitzer); if openDialog1.execute then begin assignFile(dat,openDialog1.fileName); reset(dat,1); laden(dat); assert(eof(dat),'Zu viele Daten in Datei!'); closeFile(dat); zeichnen; end; openDialog1.free; end; procedure tRaetsel.druckenOnClick(sender: tObject); var safePictureDialog1: tSavePictureDialog; img: tImage; stamm,suffix,name: string; i: longint; begin safePictureDialog1:=TSavePictureDialog.create(besitzer); if safePictureDialog1.execute then begin suffix:=safePictureDialog1.fileName; while pos('.',suffix)>0 do delete(suffix,1,pos('.',suffix)); suffix:='.' + suffix; stamm:=copy(safePictureDialog1.fileName,1,length(safePictureDialog1.fileName)-length(suffix)); for i:=1 to druckenSE.value do begin if i>1 then erzeugeOnClick(sender); img:=zeichenFlaeche; zeichenFlaeche:=tImage.create(img.parent); zeichenFlaeche.width:=img.width; zeichenFlaeche.height:=img.height; zeichenFlaeche.canvas.font.size:=img.canvas.font.size; zeichnen(false); if druckenSE.value>1 then name:=stamm + '_' + intToStr(i) + suffix else name:=stamm + suffix; zeichenFlaeche.picture.saveToFile(name); zeichenFlaeche.free; zeichenFlaeche:=img; img:=nil; end; end; safePictureDialog1.free; end; procedure tRaetsel.farbWahlFlaecheBemalen; var i: integer; begin farbWahlFlaeche.canvas.pen.color:=aktuelleFarbe; farbWahlFlaeche.canvas.brush.color:=aktuelleFarbe; farbWahlFlaeche.canvas.rectangle(0,0,farbWahlFlaeche.width,farbWahlFlaeche.height div 2); for i:=0 to farbWahlFlaeche.width-1 do begin farbWahlFlaeche.canvas.pen.color:=farbVerlauf(i/farbWahlFlaeche.width); farbWahlFlaeche.canvas.moveTo(i,farbWahlFlaeche.height div 2); farbWahlFlaeche.canvas.lineTo(i,farbWahlFlaeche.height); end; end; procedure tRaetsel.speichern(var datei: file); begin blockWrite(datei,aktuelleFarbe,sizeOf(aktuelleFarbe)); end; procedure tRaetsel.laden(var datei: file); begin blockRead(datei,aktuelleFarbe,sizeOf(aktuelleFarbe)); end; // tFelderRaetsel ************************************************************** constructor tFelderRaetsel.create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); var i: longint; begin inherited create(aOwner); uebersetze:=alphabetFunktion; cursorPosition:=-1; setLength(spinEdits,anzInhTypen+1); setLength(groeszen,length(spinEdits)-1); for i:=0 to length(spinEdits)-1 do begin spinEdits[i]:=tSpinEdit.create(besitzer); spinEdits[i].onKeyDown:=@onKeyDown; if i=1 then groeszen[i-1]:=5 else if i>1 then groeszen[i-1]:=1; with spinEdits[i] do begin parent:=besitzer; top:=erzeugeBtn.top+erzeugeBtn.height+spacing; if i=0 then left:=zufallSE.left + zufallSE.width else begin left:=spinEdits[i-1].left + spinEdits[i-1].width; value:=groeszen[i-1]; end; left:=left+spacing; onChange:=@anzSEsOnChange; onKeyDown:=@self.onKeyDown; tag:=i; end; end; spinEdits[0].showHint:=true; spinEdits[0].hint:='Schriftgröße'; spinEdits[0].value:=14; diagonalenCB:=tSmarterCheckBox.create(besitzer); diagonalenCB.parent:=besitzer; diagonalenCB.caption:='Diagonalen'; diagonalenCB.top:=spinEdits[length(spinEdits)-1].top+spinEdits[length(spinEdits)-1].height+spacing; diagonalenCB.left:=spacing; diagonalenCB.onKeyDown:=@onKeyDown; diagonalenCB.onChange:=@cbOnChange; sudokuCB:=tSmarterCheckBox.create(besitzer); sudokuCB.parent:=besitzer; sudokuCB.caption:='Sudoku'; sudokuCB.top:=diagonalenCB.top; sudokuCB.left:=diagonalenCB.left+diagonalenCB.width+spacing; sudokuCB.onKeyDown:=@onKeyDown; sudokuCB.onChange:=@cbOnChange; puzzleCB:=tSmarterCheckBox.create(besitzer); puzzleCB.parent:=besitzer; puzzleCB.caption:='Puzzle'; puzzleCB.top:=sudokuCB.top; puzzleCB.left:=sudokuCB.left+sudokuCB.width+spacing; puzzleCB.onKeyDown:=@onKeyDown; puzzleCB.onChange:=@cbOnChange; farbWahlFlaeche.left:=spacing; farbWahlFlaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; farbWahlFlaeche.height:=16; zeichenFlaeche.left:=spacing; zeichenFlaeche.top:=farbWahlFlaeche.top+farbWahlFlaeche.height+spacing; aktualisiereGroesze; end; destructor tFelderRaetsel.destroy; begin inherited destroy; end; procedure tFelderRaetsel.anzSEsOnChange(sender: tObject); begin if ((sender as tSpinEdit).tag = 0) and ((sender as tSpinEdit).value <> schriftGroesze) then begin schriftGroesze:=(sender as tSpinEdit).value; aktualisiereZeichenflaechenGroesze end else if (sender as tSpinEdit).value <> groeszen[(sender as tSpinEdit).tag-1] then aktualisiereGroesze; end; procedure tFelderRaetsel.cbOnChange(sender: tObject); begin if sender=sudokuCB then begin puzzleCB.enabled:=not sudokuCB.checked; if puzzleCB.checked and not puzzleCB.enabled then puzzleCB.checked:=false; end; if sender=puzzleCB then begin sudokuCB.enabled:=(intRoot(dim)>1) and not puzzleCB.checked; if sudokuCB.checked and not sudokuCB.checked then sudokuCB.checked:=false; end; findePuzzelierung; zeichnen; end; procedure tFelderRaetsel.onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); begin if ssCtrl in shiftState then begin if (key=ord('Z')) and (length(zuege)>0) then begin cursorPosition:=zuege[length(zuege)-1].position; inhalt[cursorPosition]:=zuege[length(zuege)-1].vorher; feldFarben[cursorPosition]:=zuege[length(zuege)-1].vorherFarbe; aktuelleFarbe:=zuege[length(zuege)-1].vorherMalFarbe; setLength(zuege,length(zuege)-1); farbWahlFlaecheBemalen; end; zeichnen; exit; end; if not absoluteInhaltsAenderung(key) then case key of VK_DOWN: cursorPosition:= (cursorPosition mod dim) + dim*min(dim-1,cursorPosition div dim + 1); VK_UP: cursorPosition:= (cursorPosition mod dim) + dim*max(0,cursorPosition div dim - 1); VK_LEFT: cursorPosition:= max(0,cursorPosition mod dim - 1) + dim*(cursorPosition div dim); VK_RIGHT: cursorPosition:= min(dim-1,cursorPosition mod dim + 1) + dim*(cursorPosition div dim); 33,107,187: if (cursorPosition>=0) and (cursorPosition=0) and (cursorPosition=dim) or (y<0) or (y>=dim) then exit; cursorPosition:=x+y*dim; zeichnen; end; procedure tFelderRaetsel.aktualisiereGroesze; var i: longint; begin dim:=0; schriftGroesze:=spinEdits[0].value; for i:=0 to length(groeszen)-1 do begin groeszen[i]:=spinEdits[i+1].value; dim:=dim+groeszen[i]; end; setLength(inhalt,dim*dim); setLength(startFeld,dim*dim); setLength(feldFarben,dim*dim); setLength(rand,4*dim); setLength(invPuzzleTeile,dim*dim); for i:=0 to length(puzzleTeile)-1 do setLength(puzzleTeile[i],0); setLength(puzzleTeile,dim); for i:=0 to dim-1 do setLength(puzzleTeile[i],dim); sudokuCB.enabled:=(intRoot(dim)>1); sudokuCB.checked:=false; loeschen; cursorPosition:=0; gesamtRaenderErzeugen; aktualisiereZeichenflaechenGroesze; end; procedure tFelderRaetsel.loeschen; var i: longint; begin aktuelleFarbe:=$000000; setLength(zuege,0); for i:=0 to length(inhalt)-1 do begin inhalt[i]:=-1; startFeld[i]:=true; feldFarben[i]:=$000000; end; for i:=0 to length(rand)-1 do rand[i]:=-1; farbWahlFlaecheBemalen; end; procedure tFelderRaetsel.leeren; var p: tLongintArray; i,w: longint; funktioniert: boolean; begin p:=permutation(dim*dim); progressBar1.step:=1; progressBar1.min:=0; progressBar1.max:=dim*(dim+4); progressBar1.position:=0; progressBar1.visible:=true; for i:=0 to length(p)-1 do begin progressBar1.stepIt; application.processMessages; if inhalt[p[i]]<0 then continue; w:=inhalt[p[i]]; inhalt[p[i]]:=-1; funktioniert:=true; while funktioniert and naechsterWert(p[i]) do begin if inhalt[p[i]]=w then continue; if passt(p[i] mod dim,p[i] div dim) and (anzLoesungen(-1)>0) then funktioniert:=false; end; if funktioniert then inhalt[p[i]]:=-1 else inhalt[p[i]]:=w; end; p:=permutation(dim*4); for i:=0 to length(p)-1 do begin progressBar1.stepIt; application.processMessages; if rand[p[i]]<0 then continue; w:=rand[p[i]]; rand[p[i]]:=0; funktioniert:=true; while funktioniert and (rand[p[i]]0 then funktioniert:=false; end; if funktioniert then rand[p[i]]:=-1 else rand[p[i]]:=w; end; progressBar1.visible:=false; end; procedure tFelderRaetsel.vorbereiten; var i: longint; begin for i:=0 to dim*dim-1 do begin puzzleTeile[i div dim][i mod dim]:=-1; invPuzzleTeile[i]:=intPoint(-1,-1); end; findePuzzelierung; end; procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze; begin zeichenFlaeche.canvas.font.size:=schriftGroesze; zellGroesze:= 2*spacing + zeichenFlaeche.canvas.pen.width + max( zeichenFlaeche.canvas.textWidth(uebersetze(dim)), zeichenFlaeche.canvas.textHeight(uebersetze(dim)) ); zeichenFlaeche.height:=round((dim+2)*zellGroesze); zeichenFlaeche.width:=zeichenFlaeche.height; farbWahlFlaeche.height:=16; farbWahlFlaeche.width:=zeichenFlaeche.width; zeichenFlaecheNeuKreieren; besitzer.height:=besitzerHoehe; besitzer.width:=besitzerBreite; if assigned(puzzleCB) then besitzer.width:=max(besitzer.width,puzzleCB.left+puzzleCB.width+spacing); if length(spinEdits)>0 then if assigned(spinEdits[length(spinEdits)-1]) then besitzer.width:=max(besitzer.width,spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing); progressBar1.width:=besitzer.width; zeichnen; end; function tFelderRaetsel.besitzerHoehe: longint; var i: longint; begin result:=inherited besitzerHoehe; if assigned(diagonalenCB) then result:=max(result,diagonalenCB.top+diagonalenCB.height+spacing); for i:=0 to length(spinEdits)-1 do if assigned(spinEdits[i]) then result:=max(result,spinEdits[i].top+spinEdits[i].height+spacing); end; function tFelderRaetsel.besitzerBreite: longint; var i: longint; begin result:=inherited besitzerBreite; if assigned(diagonalenCB) then result:=max(result,diagonalenCB.left+diagonalenCB.width+spacing); for i:=0 to length(spinEdits)-1 do if assigned(spinEdits[i]) then result:=max(result,spinEdits[i].left+spinEdits[i].width+spacing); end; procedure tFelderRaetsel.schreibeZentriert(x,y,i: longint); var br,ho: longint; s: string; begin s:=uebersetze(i); with zeichenFlaeche.canvas do begin brush.color:=$FFFFFF; if (x>=0) and (y>=0) and (x=dim) or (y>=dim) then font.color:=$000000 else if startFeld[x+y*dim] then font.color:=$7F7F7F else font.color:=feldFarben[x+y*dim]; br:=textWidth(s); ho:=textHeight(s); textOut( round((x+1.5)*zellGroesze-br/2), round((y+1.5)*zellGroesze-ho/2), s ); end; end; procedure tFelderRaetsel.zeichnen(cursor: boolean = true); var i,j,k: longint; begin if not (assigned(sudokuCB) and assigned(puzzleCB)) then exit; zeichenFlaeche.canvas.brush.color:=$ffffff; zeichenFlaeche.canvas.rectangle(-10,-10,zeichenFlaeche.width+10,zeichenFlaeche.height+10); zeichenFlaeche.canvas.pen.width:=1; zeichenFlaeche.canvas.pen.color:=$000000; if diagonalenCB.checked then for i:=1 to dim do begin zeichenFlaeche.canvas.brush.color:=$ffffff - $181818; zeichenFlaeche.canvas.fillRect( round(i*zellGroesze), round(i*zellGroesze), round((i+1)*zellGroesze), round((i+1)*zellGroesze) ); zeichenFlaeche.canvas.fillRect( round(i*zellGroesze), round((dim-i+1)*zellGroesze), round((i+1)*zellGroesze), round((dim-i+2)*zellGroesze) ); end; for i:=0 to dim do with zeichenFlaeche.canvas do begin pen.width:=3-2*byte((i>0) and (i0) and (puzzleTeile[0][0]>=0) then begin for i:=0 to dim-1 do for j:=1 to dim-1 do if invPuzzleTeile[i+j*dim]['x']<>invPuzzleTeile[i+(j-1)*dim]['x'] then with zeichenFlaeche.canvas do begin moveTo(round((i+1)*zellGroesze),round((j+1)*zellGroesze)); lineTo(round((i+2)*zellGroesze),round((j+1)*zellGroesze)); end; for j:=0 to dim-1 do for i:=1 to dim-1 do if invPuzzleTeile[i+j*dim]['x']<>invPuzzleTeile[(i-1)+j*dim]['x'] then with zeichenFlaeche.canvas do begin moveTo(round((i+1)*zellGroesze),round((j+1)*zellGroesze)); lineTo(round((i+1)*zellGroesze),round((j+2)*zellGroesze)); end; end; zeichenFlaeche.canvas.pen.color:=$8080ff; zeichenFlaeche.canvas.pen.width:=3; if (cursorPosition>=0) and (dim>0) and cursor then begin for i:=0 to 1 do for j:=0 to 1 do for k:=0 to 1 do with zeichenFlaeche.canvas do begin moveTo(round((i+1+(cursorPosition mod dim))*zellGroesze),round((j+1+(cursorPosition div dim))*zellGroesze)); lineTo(round((i+1+(cursorPosition mod dim)+(1-2*i)*k/6)*zellGroesze),round((j+1+(cursorPosition div dim)+(1-2*j)*(1-k)/6)*zellGroesze)); end; end; zeichenFlaeche.canvas.pen.width:=3; zeichenFlaeche.canvas.brush.color:=$ffffff; for i:=0 to dim-1 do begin schreibeZentriert(i,-1,rand[i]); schreibeZentriert(dim,i,rand[dim+i]); schreibeZentriert(i,dim,rand[2*dim+i]); schreibeZentriert(-1,i,rand[3*dim+i]); end; for i:=0 to length(inhalt)-1 do schreibeZentriert(i mod dim,i div dim,inhalt[i]); end; procedure tFelderRaetsel.startFelderFestlegen; var i: longint; begin for i:=0 to length(inhalt)-1 do startFeld[i]:=inhalt[i]>=0; end; procedure tFelderRaetsel.alsZugSpeichern; begin setLength(zuege,length(zuege)+1); zuege[length(zuege)-1].position:=cursorPosition; zuege[length(zuege)-1].vorher:=inhalt[cursorPosition]; zuege[length(zuege)-1].vorherFarbe:=feldFarben[cursorPosition]; zuege[length(zuege)-1].nachherFarbe:=aktuelleFarbe; if length(zuege)=1 then zuege[length(zuege)-1].vorherMalFarbe:=$000000 else zuege[length(zuege)-1].vorherMalFarbe:=zuege[length(zuege)-2].nachherFarbe; end; procedure tFelderRaetsel.speichern(var datei: file); var b: byte; i: longint; begin blockWrite(datei,'Fe',2); b:=byte(diagonalenCB.checked); blockWrite(datei,b,1); b:=byte(sudokuCB.enabled); blockWrite(datei,b,1); b:=byte(sudokuCB.checked); blockWrite(datei,b,1); b:=byte(puzzleCB.enabled); blockWrite(datei,b,1); b:=byte(puzzleCB.checked); blockWrite(datei,b,1); i:=length(groeszen); blockWrite(datei,i,sizeOf(i)); if length(groeszen)>0 then blockWrite(datei,groeszen[0],length(groeszen)*sizeOf(groeszen[0])); i:=length(inhalt); blockWrite(datei,i,sizeOf(i)); if length(inhalt)>0 then blockWrite(datei,inhalt[0],length(inhalt)*sizeOf(inhalt[0])); i:=length(rand); blockWrite(datei,i,sizeOf(i)); if length(rand)>0 then blockWrite(datei,rand[0],length(rand)*sizeOf(rand[0])); blockWrite(datei,dim,sizeOf(dim)); i:=length(puzzleTeile); blockWrite(datei,i,sizeOf(i)); if length(puzzleTeile)>0 then blockWrite(datei,puzzleTeile[0],length(puzzleTeile)*sizeOf(puzzleTeile[0])); i:=length(invPuzzleTeile); blockWrite(datei,i,sizeOf(i)); if length(invPuzzleTeile)>0 then blockWrite(datei,invPuzzleTeile[0],length(invPuzzleTeile)*sizeOf(invPuzzleTeile[0])); blockWrite(datei,cursorPosition,sizeOf(cursorPosition)); i:=length(feldFarben); blockWrite(datei,i,sizeOf(i)); if length(feldFarben)>0 then blockWrite(datei,feldFarben[0],length(feldFarben)*sizeOf(feldFarben[0])); i:=length(startFeld); blockWrite(datei,i,sizeOf(i)); if length(startFeld)>0 then blockWrite(datei,startFeld[0],length(startFeld)*sizeOf(startFeld[0])); i:=length(zuege); blockWrite(datei,i,sizeOf(i)); if length(zuege)>0 then blockWrite(datei,zuege[0],length(zuege)*sizeOf(zuege[0])); inherited speichern(datei); end; procedure tFelderRaetsel.laden(var datei: file); var s: string[2]; b: byte; i: longint; begin s:=#0#0; b:=0; i:=0; blockRead(datei,s,2); assert(s='Fe','Die zu lesende Datei ist kein Felder-Rätsel!'); blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); diagonalenCB.checked:=odd(b); blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); sudokuCB.enabled:=odd(b); blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); sudokuCB.checked:=odd(b); blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); puzzleCB.enabled:=odd(b); blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); puzzleCB.checked:=odd(b); blockRead(datei,i,sizeOf(i)); assert(length(groeszen)=i,'Falsche Anzahl freier Paraemeter in gespeichertem Spiel!'); if length(groeszen)>0 then blockRead(datei,groeszen[0],length(groeszen)*sizeOf(groeszen[0])); for i:=0 to length(groeszen)-1 do spinEdits[i+1].value:=groeszen[i]; blockRead(datei,i,sizeOf(i)); setLength(inhalt,i); if length(inhalt)>0 then blockRead(datei,inhalt[0],length(inhalt)*sizeOf(inhalt[0])); blockRead(datei,i,sizeOf(i)); setLength(rand,i); if length(rand)>0 then blockRead(datei,rand[0],length(rand)*sizeOf(rand[0])); blockRead(datei,dim,sizeOf(dim)); blockRead(datei,i,sizeOf(i)); setLength(puzzleTeile,i); if length(puzzleTeile)>0 then blockRead(datei,puzzleTeile[0],length(puzzleTeile)*sizeOf(puzzleTeile[0])); blockRead(datei,i,sizeOf(i)); setLength(invPuzzleTeile,i); if length(invPuzzleTeile)>0 then blockRead(datei,invPuzzleTeile[0],length(invPuzzleTeile)*sizeOf(invPuzzleTeile[0])); blockRead(datei,cursorPosition,sizeOf(cursorPosition)); blockRead(datei,i,sizeOf(i)); setLength(feldFarben,i); if length(feldFarben)>0 then blockRead(datei,feldFarben[0],length(feldFarben)*sizeOf(feldFarben[0])); blockRead(datei,i,sizeOf(i)); setLength(startFeld,i); if length(startFeld)>0 then blockRead(datei,startFeld[0],length(startFeld)*sizeOf(startFeld[0])); blockRead(datei,i,sizeOf(i)); setLength(zuege,i); if length(zuege)>0 then blockRead(datei,zuege[0],length(zuege)*sizeOf(zuege[0])); inherited laden(datei); end; procedure tFelderRaetsel.findePuzzelierung; var i,j,k,l: longint; perms: array of array of longint; kAnzs: array of longint; lw: longword; gefunden: boolean; begin if sudokuCB.checked then begin k:=intRoot(dim); l:=dim div k; for i:=0 to dim-1 do for j:=0 to dim-1 do begin invPuzzleTeile[i*dim + j]:= intPoint( j div l + (i div k) * k, j mod l + (i mod k) * l ); puzzleTeile[ invPuzzleTeile[i*dim + j]['x'], invPuzzleTeile[i*dim + j]['y'] ]:=i*dim + j; end; exit; end; if not puzzleCB.checked then begin puzzleTeile[0][0]:=-1; exit; end; setLength(perms,dim*dim); for i:=0 to dim*dim-1 do begin invPuzzleTeile[i]:=intPoint(-1,-1); perms[i]:=permutation(dim); end; setLength(kAnzs,dim); for i:=0 to dim-1 do kAnzs[i]:=0; //invPuzzleTeile: array of tIntPoint; // Ort -> [Teil, Kachel] //puzzleTeile: array of array of longint; // [Teil,Kachel] -> Ort i:=0; while i=0 then begin repeat inc(j); until (j>=dim) or (perms[i][j]=invPuzzleTeile[i]['x']); assert(perms[i][j]=invPuzzleTeile[i]['x'], 'Could not invert '+intToStr(invPuzzleTeile[i]['x'])+' (dim='+intToStr(dim)+')!'); dec(kAnzs[perms[i][j]]); // Kachel vom Puzzleteil entfernen end; inc(j); // nächsten Wert nehmen while (j=dim) do inc(j); if (j>=dim) then begin // hier passt nichts invPuzzleTeile[i]:=intPoint(-1,-1); dec(i); continue; end; invPuzzleTeile[i]:=intPoint(perms[i][j],kAnzs[perms[i][j]]); // Kachel anfügen puzzleTeile[perms[i][j]][kAnzs[perms[i][j]]]:=i; inc(kAnzs[perms[i][j]]); if kAnzs[perms[i][j]]=dim then begin // prüfen, ob Puzzleteil zusammenhängt lw:=(1 shl dim) - 2; repeat gefunden:=false; for k:=0 to dim-1 do begin if odd(lw shr k) then continue; if (puzzleTeile[perms[i][j]][k] mod dim > 0) and (invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['x']=perms[i][j]) and odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['y']) then begin lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['y']); gefunden:=true; end; if (puzzleTeile[perms[i][j]][k] mod dim < dim-1) and (invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['x']=perms[i][j]) and odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['y']) then begin lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['y']); gefunden:=true; end; if (puzzleTeile[perms[i][j]][k] div dim > 0) and (invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['x']=perms[i][j]) and odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['y']) then begin lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['y']); gefunden:=true; end; if (puzzleTeile[perms[i][j]][k] div dim < dim-1) and (invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['x']=perms[i][j]) and odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['y']) then begin lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['y']); gefunden:=true; end; end; until not gefunden; if lw<>0 then begin // nicht zusammenhängend dec(kAnzs[perms[i][j]]); invPuzzleTeile[i]:=intPoint(-1,-1); dec(i); continue; end; end; if ((i div dim) > 0) and (invPuzzleTeile[i-dim]['x']<>invPuzzleTeile[i]['x']) and (kAnzs[invPuzzleTeile[i-dim]['x']]