From ca79f7d3720b106b14c50712a942611dfc09b198 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Sat, 29 Sep 2018 11:44:12 +0200 Subject: alter Stand --- raetsel.lps | 109 ++++++++++--------- raetselunit.pas | 323 +++++++++++++++++++++++++++++++++++++++++++++++++++----- unit2.lfm | 2 +- 3 files changed, 358 insertions(+), 76 deletions(-) diff --git a/raetsel.lps b/raetsel.lps index 0cfa3ac..fc7dde7 100644 --- a/raetsel.lps +++ b/raetsel.lps @@ -3,13 +3,13 @@ - + - + @@ -18,8 +18,8 @@ - - + + @@ -30,31 +30,41 @@ - + - + + + + + + + + + + + - - + + - - + + - - + + @@ -63,16 +73,6 @@ - - - - - - - - - - @@ -90,124 +90,133 @@ + + + + + + + + - + + - - - + + - + - + - + + - + - + - + + - + - + - + - + - + - + - + - + - - + - + - + - + - + - + - + - + - + diff --git a/raetselunit.pas b/raetselunit.pas index bdeb19b..a2c069e 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -5,18 +5,46 @@ unit raetselunit; interface uses - Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls; + Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls, LCLType, + lowlevelunit; type tAlphabetFunktion = function(i: longint): string; + tFelderRaetsel = class; + + tFelderLoesMeta = class + private + _inh: boolean; + _perm: tLongintArray; + _mgl: tInt64Array; + _posi: longint; + public + constructor create(ib: boolean; fr: tFelderRaetsel); + destructor destroy; + function posi: longint; + function fwd: boolean; + procedure rev; + property inhaltBehalten: boolean read _inh; + procedure aktualisiereInhalt(p: longint); + procedure aktualisiereRand(p: longint); + end; + tRaetsel = class private besitzer: tForm; zeichenflaeche: tImage; + erzeugeBtn: tButton; 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 erzeugeOnClick(sender: tObject); + procedure loeschen; dynamic; abstract; + function loesen(inhaltBehalten: boolean): longint; dynamic; abstract; + function _loesen(lm: tFelderLoesMeta): longint; dynamic; abstract; + procedure leeren; dynamic; abstract; public constructor create(aOwner: tForm); destructor destroy; override; @@ -24,19 +52,26 @@ type end; tFelderRaetsel = class(tRaetsel) - spinEdits: array of tSpinEdit; - diagonalenCB: tCheckBox; - groeszen: array of longint; - felder,rand: array of longint; - dim,schriftGroesze: longint; - zellGroesze: extended; - uebersetze: tAlphabetFunktion; + spinEdits: array of tSpinEdit; + diagonalenCB: tCheckBox; + groeszen,inhalt,rand: array of longint; + moeglich: array of int64; + dim,schriftGroesze,cursorPosition: longint; + zellGroesze: extended; + uebersetze: tAlphabetFunktion; 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; + function loesen(inhaltBehalten: boolean): longint; 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; public constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); destructor destroy; override; @@ -45,6 +80,9 @@ type tBuchstabenRaetsel = class(tFelderRaetsel) private + procedure relativeInhaltsAenderung(diff: longint); override; + function absoluteInhaltsAenderung(key: word): boolean; override; + function _loesen(lm: tFelderLoesMeta): longint; override; public constructor create(aOwner: tForm); destructor destroy; override; @@ -52,6 +90,9 @@ type tHochhausRaetsel = class(tFelderRaetsel) private + procedure relativeInhaltsAenderung(diff: longint); override; + function absoluteInhaltsAenderung(key: word): boolean; override; + function _loesen(lm: tFelderLoesMeta): longint; override; public constructor create(aOwner: tForm); destructor destroy; override; @@ -68,6 +109,47 @@ implementation uses math; +// tFelderLoesMeta ************************************************************* + +constructor tFelderLoesMeta.create(ib: boolean; fr: tFelderRaetsel); +var + i: longint; +begin + inherited create; + _inh:=ib; + _perm:=permutation(length(fr.inhalt)); + setlength(_perm,length(_perm)+1); + for i:=length(_perm)-1 downto 1 do + _perm[i]:=_perm[i-1]; + _perm[0]:=-1; + setlength(_mgl,length(fr.inhalt)); + _posi:=0; +end; + +destructor tFelderLoesMeta.destroy; +begin + setlength(_perm,0); + setlength(_mgl,0); + inherited destroy; +end; + +function tFelderLoesMeta.posi: longint; +begin + result:=_perm[_posi]; +end; + +function tFelderLoesMeta.fwd: boolean; +begin + result:=_posi0 then left:=spinEdits[i-1].left + spinEdits[i-1].width; left:=left+spacing; onChange:=@anzSEsOnChange; + onKeyDown:=@self.onKeyDown; tag:=i; end; if i>0 then @@ -135,11 +235,11 @@ begin end; spinEdits[0].showHint:=true; spinEdits[0].hint:='Schriftgröße'; - spinEdits[0].value:=7; + spinEdits[0].value:=14; diagonalenCB:=tCheckBox.create(besitzer); diagonalenCB.parent:=besitzer; diagonalenCB.caption:='Diagonalen'; - diagonalenCB.top:=spacing; + diagonalenCB.top:=erzeugeBtn.top+erzeugeBtn.height+spacing; diagonalenCB.left:=spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing; zeichenflaeche.left:=spacing; zeichenflaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; @@ -162,6 +262,48 @@ begin 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; @@ -172,15 +314,66 @@ begin groeszen[i]:=spinEdits[i+1].value; dim:=dim+groeszen[i]; end; - setlength(felder,dim*dim); - for i:=0 to length(felder)-1 do - felder[i]:=random(dim+1)-1; // 0; + setlength(inhalt,dim*dim); setlength(rand,4*dim); - for i:=0 to length(rand)-1 do - rand[i]:=random(dim+1)-1; // 0; + leeren; + cursorPosition:=0; aktualisiereZeichenflaechenGroesze; end; +procedure tFelderRaetsel.loeschen; +var + i: longint; +begin + for i:=0 to length(inhalt)-1 do + inhalt[i]:=-1; + for i:=0 to length(rand)-1 do + rand[i]:=-1; +end; + +function tFelderRaetsel.loesen(inhaltBehalten: boolean): longint; +var + lm: tFelderLoesMeta; +begin + lm:=tFelderLoesMeta.create(inhaltBehalten,self); + result:=_loesen(lm); + lm.free; +end; + +procedure tFelderRaetsel.leeren; +var + p: tLongintArray; + i,w: longint; +var + lm: tFelderLoesMeta; +begin + lm:=tFelderLoesMeta.create(false,self); + + p:=permutation(dim*dim); + for i:=0 to length(p)-1 do begin + if inhalt[p[i]]<0 then continue; + w:=inhalt[p[i]]; + inhalt[p[i]]:=-1; + lm.aktualisiereInhalt(p[i]); + if _loesen(lm)<>1 then begin + inhalt[p[i]]:=w; + lm.aktualisiereInhalt(p[i]); + end; + end; + + p:=permutation(dim*4); + for i:=0 to length(p)-1 do begin + if rand[p[i]]<0 then continue; + w:=rand[p[i]]; + rand[p[i]]:=-1; + lm.aktualisiereRand(p[i]); + if _loesen(lm)<>1 then begin + rand[p[i]]:=w; + lm.aktualisiereRand(p[i]); + end; + end; +end; + procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze; begin zeichenflaeche.canvas.font.size:=schriftGroesze; @@ -190,7 +383,7 @@ begin zeichenflaeche.canvas.textWidth(uebersetze(dim)), zeichenflaeche.canvas.textHeight(uebersetze(dim)) ); - zeichenflaeche.height:=(dim+2)*round(2*zellGroesze); + zeichenflaeche.height:=round((dim+2)*zellGroesze); zeichenflaeche.width:=zeichenflaeche.height; zeichenFlaecheNeuKreieren; besitzer.height:=besitzerHoehe; @@ -226,8 +419,8 @@ begin br:=textWidth(s); ho:=textHeight(s); textOut( - round(2*(x+1.5)*zellGroesze-br/2), - round(2*(y+1.5)*zellGroesze-ho/2), + round((x+1.5)*zellGroesze-br/2), + round((y+1.5)*zellGroesze-ho/2), s ); end; @@ -240,21 +433,30 @@ 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; for i:=0 to dim do with zeichenflaeche.canvas do begin - moveTo(round((i+1)*2*zellGroesze),round(2*zellGroesze)); - lineTo(round((i+1)*2*zellGroesze),round((dim+1)*2*zellGroesze)); - moveTo(round(2*zellGroesze),round((i+1)*2*zellGroesze)); - lineTo(round((dim+1)*2*zellGroesze),round((i+1)*2*zellGroesze)); + 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 + 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) + ); 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(felder)-1 do - schreibeZentriert(i mod dim,i div dim,felder[i]); + for i:=0 to length(inhalt)-1 do + schreibeZentriert(i mod dim,i div dim,inhalt[i]); end; // tBuchstabenRaetsel ********************************************************** @@ -276,6 +478,50 @@ begin inherited destroy; end; +procedure tBuchstabenRaetsel.relativeInhaltsAenderung(diff: longint); +begin + if (cursorPosition<0) or (cursorPosition>=dim*dim) then exit; + inhalt[cursorPosition]:=min(max(-1,inhalt[cursorPosition]+diff),groeszen[0]); +end; + +function tBuchstabenRaetsel.absoluteInhaltsAenderung(key: word): boolean; +begin + result:=true; + if (key>=ord('A')) and (key<=min(ord('A')+groeszen[0]-1,ord('Z'))) then begin + inhalt[cursorPosition]:=key-ord('A')+1; + exit; + end; + if (key=ord(' ')) or (key=46) or (key=8) then begin + inhalt[cursorPosition]:=-1; + exit; + end; + if (key=189) then begin + inhalt[cursorPosition]:=0; + exit; + end; + result:=false; +end; + +function tBuchstabenRaetsel._loesen(lm: tFelderLoesMeta): longint; +begin + if not lm.fwd then begin + result:=1; + exit; + end; + if inhalt[lm.posi]>=0 then begin + result:=_loesen(lm); + exit; + end; + + result:=0; + for + + if not lm.inhaltBehalten then begin + inhalt[lm.posi]:=-1; + lm.aktualisiereInhalt(lm.posi); + end; +end; + // tHochhausRaetsel ************************************************************ constructor tHochhausRaetsel.create(aOwner: tForm); @@ -292,6 +538,33 @@ begin inherited destroy; end; +procedure tHochhausRaetsel.relativeInhaltsAenderung(diff: longint); +begin + if (cursorPosition<0) or (cursorPosition>=dim*dim) then exit; + if inhalt[cursorPosition]=-1 then inhalt[cursorPosition]:=0; + inhalt[cursorPosition]:=min(max(0,inhalt[cursorPosition]+diff),groeszen[0]); + if inhalt[cursorPosition]=0 then inhalt[cursorPosition]:=-1; +end; + +function tHochhausRaetsel.absoluteInhaltsAenderung(key: word): boolean; +begin + result:=true; + if (key>=ord('1')) and (key<=min(ord('1')+groeszen[0]-1,ord('9'))) then begin + inhalt[cursorPosition]:=key-ord('1')+1; + exit; + end; + if (key=ord(' ')) or (key=46) or (key=8) then begin + inhalt[cursorPosition]:=-1; + exit; + end; + result:=false; +end; + +function tHochhausRaetsel._loesen(inhaltBehalten: boolean; perm: tLongintArray; posi: longint): longint; +begin + +end; + // allgemeine Funktionen ******************************************************* function buchstabenAlphabetFunktion(i: longint): string; diff --git a/unit2.lfm b/unit2.lfm index 381f031..42ae4b3 100644 --- a/unit2.lfm +++ b/unit2.lfm @@ -3,7 +3,7 @@ object Form2: TForm2 Height = 94 Top = 197 Width = 192 - Caption = 'Form2' + Caption = 'Rätsel' ClientHeight = 94 ClientWidth = 192 LCLVersion = '1.6.0.4' -- cgit v1.2.3-54-g00ecf