diff options
Diffstat (limited to 'raetselunit.pas')
| -rw-r--r-- | raetselunit.pas | 103 |
1 files changed, 93 insertions, 10 deletions
diff --git a/raetselunit.pas b/raetselunit.pas index 90d49ff..e5f9f47 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -59,6 +59,7 @@ type 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; @@ -80,8 +81,10 @@ type spinEdits: array of tSpinEdit; diagonalenCB,sudokuCB: 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,nSqrt,schriftGroesze, + dim,schriftGroesze, cursorPosition: longint; zellGroesze: extended; uebersetze: tAlphabetFunktion; @@ -95,6 +98,7 @@ type procedure aktualisiereGroesze; procedure loeschen; override; procedure leeren; override; + procedure vorbereiten; override; procedure aktualisiereZeichenflaechenGroesze; function besitzerHoehe: longint; override; function besitzerBreite: longint; override; @@ -106,6 +110,7 @@ type 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; @@ -133,7 +138,7 @@ const implementation uses - math, dialogs, lclintf, extDlgs; + math, dialogs, lclintf, extDlgs, matheunit; {$DEFINE alphabetFunktion} function zahlenAlphabetFunktion(i: longint): string; @@ -339,6 +344,7 @@ begin if assigned(onSetCaption) then onSetCaption(intToStr(zufallSE.value)); zufallSE.value:=random(zufallSE.maxValue+1); + vorbereiten; loesen(-1); randErzeugen; leeren; @@ -499,6 +505,7 @@ end; procedure tFelderRaetsel.cbOnChange(sender: tObject); begin + findePuzzelierung; zeichnen; end; @@ -571,11 +578,19 @@ begin 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); - nSqrt:=round(sqrt(dim)); - sudokuCB.enabled:=Sqr(nSqrt)=dim; - if (not sudokuCB.enabled) and sudokuCB.checked then - sudokuCB.checked:=false; + puzzleCB.enabled:=dim>2; + if puzzleCB.checked and not puzzleCB.enabled then + puzzleCB.checked:=false; + + sudokuCB.enabled:=(intRoot(dim)>1) and not puzzleCB.checked; + sudokuCB.checked:=false; loeschen; cursorPosition:=0; @@ -634,6 +649,17 @@ begin 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; @@ -716,7 +742,7 @@ end; procedure tFelderRaetsel.zeichnen(cursor: boolean = true); var - i: longint; + i,j: longint; begin if not assigned(sudokuCB) then exit; @@ -742,13 +768,29 @@ begin end; for i:=0 to dim do with zeichenFlaeche.canvas do begin - pen.width:=3-2*byte((not sudokuCB.checked or (i mod nSqrt <> 0)) and (i>0) and (i<dim)); + pen.width:=3-2*byte((i>0) and (i<dim)); moveTo(round((i+1)*zellGroesze),round(zellGroesze)); lineTo(round((i+1)*zellGroesze),round((dim+1)*zellGroesze)); moveTo(round(zellGroesze),round((i+1)*zellGroesze)); lineTo(round((dim+1)*zellGroesze),round((i+1)*zellGroesze)); end; zeichenFlaeche.canvas.pen.width:=3; + if (length(invPuzzleTeile)>0) 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; if (cursorPosition>=0) and (dim>0) and cursor then begin zeichenFlaeche.canvas.brush.color:= @@ -822,7 +864,14 @@ begin if length(rand)>0 then blockWrite(datei,rand[0],length(rand)*sizeOf(rand[0])); blockWrite(datei,dim,sizeOf(dim)); - blockWrite(datei,nSqrt,sizeOf(nSqrt)); + 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)); @@ -874,7 +923,14 @@ begin if length(rand)>0 then blockRead(datei,rand[0],length(rand)*sizeOf(rand[0])); blockRead(datei,dim,sizeOf(dim)); - blockRead(datei,nSqrt,sizeOf(nSqrt)); + 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); @@ -891,6 +947,33 @@ begin inherited laden(datei); end; +procedure tFelderRaetsel.findePuzzelierung; +var + i,j,k,l: longint; +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; +end; + // tHochhausRaetsel und tBuchstabenRaetsel {$DEFINE create} |