unit raetselunit; {$mode objfpc}{$H+} interface 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; tRaetsel = class private besitzer: tForm; farbWahlFlaeche, zeichenflaeche: tImage; erzeugeBtn: tButtonWithArrowKeys; 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 farbWahlFlaecheBemalen; procedure loeschen; dynamic; abstract; procedure leeren; 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; public constructor create(aOwner: tForm); destructor destroy; override; procedure zeichnen; dynamic; abstract; end; tFelderRaetsel = class(tRaetsel) private spinEdits: array of tSpinEdit; diagonalenCB,sudokuCB: tSmarterCheckBox; groeszen,inhalt,rand: array of longint; AMoeglich,EMoeglich: array of boolean; dim,nSqrt,schriftGroesze, cursorPosition: longint; zellGroesze: extended; uebersetze: tAlphabetFunktion; FeldFarben: array of tColor; startfeld: array of boolean; procedure anzSEsOnChange(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 aktualisiereZeichenflaechenGroesze; function besitzerHoehe: longint; override; function besitzerBreite: longint; override; procedure schreibeZentriert(x,y,i: longint); procedure relativeInhaltsAenderung(diff: longint); dynamic; abstract; function absoluteInhaltsAenderung(key: word): boolean; dynamic; abstract; procedure gesamtRaenderErzeugen; dynamic; abstract; procedure startfelderfestlegen; override; public constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); destructor destroy; override; procedure zeichnen; 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; {$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; 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; progressbar1:=tProgressBar.create(besitzer); progressbar1.visible:=false; 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:=zeichenflaeche.width+zeichenflaeche.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); var i: longint; begin loeschen; loesen(-1); randErzeugen; leeren; startFelderFestlegen; zeichnen; 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; // 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 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; sudokuCB:=tSmarterCheckBox.create(besitzer); sudokuCB.parent:=besitzer; sudokuCB.caption:='Sudoku'; sudokuCB.top:=diagonalenCB.top; sudokuCB.left:=diagonalenCB.left+diagonalenCB.width+spacing; sudokuCB.onKeyDown:=@onKeyDown; 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.onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); begin 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); NSqrt:=round(sqrt(dim)); sudokuCB.enabled:=Sqr(NSqrt)=dim; if (not sudokuCB.enabled) and sudokuCB.checked then sudokuCB.checked:=false; loeschen; cursorPosition:=0; gesamtRaenderErzeugen; aktualisiereZeichenflaechenGroesze; end; procedure tFelderRaetsel.loeschen; var i: longint; begin 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; end; procedure tFelderRaetsel.leeren; var p: tLongintArray; i,w: longint; 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; if anzLoesungen(-1)<>1 then 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]]:=-1; if anzLoesungen(-1)<>1 then rand[p[i]]:=w; end; progressbar1.visible:=false; 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:= max(max( besitzerBreite, sudokuCB.left+sudokuCB.width+spacing), 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:=max(inherited besitzerHoehe,diagonalenCB.top+diagonalenCB.height+spacing); for i:=0 to length(spinEdits)-1 do result:=max(result,spinEdits[i].top+spinEdits[i].height+spacing); end; function tFelderRaetsel.besitzerBreite: longint; var i: longint; begin result:=max(inherited besitzerBreite,diagonalenCB.left+diagonalenCB.width+spacing);; for i:=0 to length(spinEdits)-1 do 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; var i: longint; begin zeichenflaeche.canvas.brush.color:=$ffffff; zeichenflaeche.canvas.rectangle(-10,-10,zeichenflaeche.width+10,zeichenflaeche.height+10); zeichenflaeche.canvas.pen.width:=3; 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 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.color:=$8080ff; if (cursorPosition>=0) and (dim>0) then begin zeichenflaeche.canvas.brush.color:= $ffffff - $181818 * byte( diagonalenCB.checked and ( (cursorPosition mod (dim+1)=0) or (cursorPosition mod (dim-1)=0) ) ); zeichenflaeche.canvas.rectangle( round(((cursorPosition mod dim)+1)*zellGroesze), round(((cursorPosition div dim)+1)*zellGroesze), round(((cursorPosition mod dim)+2)*zellGroesze+1), round(((cursorPosition div dim)+2)*zellGroesze+1) ); end; 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; {$DEFINE create} constructor tHochhausRaetsel.create(aOwner: tForm); {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} constructor tBuchstabenRaetsel.create(aOwner: tForm); {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF create} {$DEFINE destroy} destructor tHochhausRaetsel.destroy; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} destructor tBuchstabenRaetsel.destroy; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF destroy} {$DEFINE passt} function tHochhausRaetsel.passt(spalte,zeile: integer): boolean; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.passt(spalte,zeile: integer): boolean; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF passt} {$DEFINE geloest} function tHochhausRaetsel.geloest: boolean; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.geloest: boolean; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF geloest} {$DEFINE gesamtRaenderErzeugen} procedure tHochhausRaetsel.gesamtRaenderErzeugen; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} procedure tBuchstabenRaetsel.gesamtRaenderErzeugen; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF gesamtRaenderErzeugen} {$DEFINE passtZumZeichnen} function tHochhausRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF passtZumZeichnen} {$DEFINE randErzeugen} procedure tHochhausRaetsel.randErzeugen; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} procedure tBuchstabenRaetsel.randErzeugen; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF randErzeugen} {$DEFINE relativeInhaltsAenderung} procedure tHochhausRaetsel.relativeInhaltsAenderung(diff: integer); {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} procedure tBuchstabenRaetsel.relativeInhaltsAenderung(diff: integer); {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF relativeInhaltsAenderung} {$DEFINE absoluteInhaltsAenderung} function tHochhausRaetsel.absoluteInhaltsAenderung(key: word): boolean; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.absoluteInhaltsAenderung(key: word): boolean; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF absoluteInhaltsAenderung} {$DEFINE loesen} function tHochhausRaetsel.loesen(lPos: integer): boolean; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.loesen(lPos: integer): boolean; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF loesen} {$DEFINE anzLoesungen} function tHochhausRaetsel.anzLoesungen(lPos: integer): integer; {$DEFINE hochhaus} {$I raetselunit.inc} {$UNDEF hochhaus} function tBuchstabenRaetsel.anzLoesungen(lPos: integer): integer; {$DEFINE buchstaben} {$I raetselunit.inc} {$UNDEF buchstaben} {$UNDEF anzLoesungen} end.