diff options
Diffstat (limited to 'raetselunit.pas')
| -rw-r--r-- | raetselunit.pas | 271 |
1 files changed, 119 insertions, 152 deletions
diff --git a/raetselunit.pas b/raetselunit.pas index dc6741c..5f1033b 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -6,36 +6,22 @@ interface uses Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls, LCLType, - lowlevelunit; + lowlevelunit, Messages, ComCtrls; type tAlphabetFunktion = function(i: longint): string; - tFelderRaetsel = class; - - tFelderLoesMeta = class + tButtonWithArrowKeys = class(tButton) private - _inh: boolean; - _perm: tLongintArray; - _mgl: tInt64Array; - _posi: longint; - _fr: tFelderRaetsel; - 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,alt: longint); - procedure aktualisiereRand(p,alt: longint); + procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; end; tRaetsel = class private besitzer: tForm; zeichenflaeche: tImage; - erzeugeBtn: tButton; + erzeugeBtn: tButtonWithArrowKeys; + progressbar1: tProgressBar; function besitzerHoehe: longint; dynamic; function besitzerBreite: longint; dynamic; procedure zeichenFlaecheNeuKreieren; @@ -43,19 +29,19 @@ type 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; procedure leeren; dynamic; abstract; public constructor create(aOwner: tForm); destructor destroy; override; - function gleichzeitigMoeglich(num: longint): longint; dynamic; abstract; - function _loesen(lm: tFelderLoesMeta): longint; dynamic; abstract; + function loesen(inhaltBehalten: boolean; lPos: longint): longint; dynamic; abstract; + function passt(spalte,zeile: integer): boolean; dynamic; abstract; + function geloest: boolean; dynamic; abstract; procedure zeichnen; dynamic; abstract; end; tFelderRaetsel = class(tRaetsel) spinEdits: array of tSpinEdit; - diagonalenCB: tCheckBox; + diagonalenCB,sudokuCB: tCheckBox; groeszen,inhalt,rand: array of longint; moeglich: array of int64; dim,schriftGroesze,cursorPosition: longint; @@ -66,7 +52,6 @@ type 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; @@ -80,114 +65,43 @@ type procedure zeichnen; override; end; -const - spacing = 2; - -implementation - -uses - math; - -// tFelderLoesMeta ************************************************************* - -constructor tFelderLoesMeta.create(ib: boolean; fr: tFelderRaetsel); -var - i: longint; -begin - inherited create; - _fr:=fr; - _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; +{$DEFINE interface} -destructor tFelderLoesMeta.destroy; -begin - setlength(_perm,0); - setlength(_mgl,0); - inherited destroy; -end; +{$DEFINE hochhaus} +{$I raetselunit.inc} +{$UNDEF hochhaus} -function tFelderLoesMeta.posi: longint; -begin - result:=_perm[_posi]; -end; +{$DEFINE buchstaben} +{$I raetselunit.inc} +{$UNDEF buchstaben} -function tFelderLoesMeta.fwd: boolean; -begin - result:=_posi<length(_perm); - if result then - inc(_posi); -end; +{$UNDEF interface} -procedure tFelderLoesMeta.rev; -begin - dec(_posi); -end; +const + spacing = 2; -procedure tFelderLoesMeta.aktualisiereInhalt(p,alt: longint); -var - i,j,x,y,cnt,neu: longint; - maske: int64; -begin - // hier sollte die Zeile und Spalte von _mgl[p] aktualisiert werden - x:=p mod _fr.dim; - y:=p div _fr.dim; - neu:=_fr.inhalt[p]; - if neu<>-1 then begin - if alt<>-1 then begin - _fr.inhalt[p]:=-1; - aktualisiereInhalt(p,alt); - _fr.inhalt[p]:=neu; - alt:=-1; - end; - cnt:=_fr.gleichzeitigMoeglich(p); - maske:=1 shr _fr.inhalt[p]; - _mgl[p]:=maske; - if cnt>1 then begin - j:=0; - for i:=0 to _fr.dim-1 do - j:=j+byte(_fr.inhalt[y*_fr.dim+i]=neu); - if j>=cnt then - for i:=0 to _fr.dim-2 do - _mgl[i*_fr.dim+i+byte(i>=x)]:=_mgl[i*_fr.dim+i+byte(i>=x)] and not maske; - j:=0; - for i:=0 to _fr.dim-1 do - j:=j+byte(_fr.inhalt[i*_fr.dim+x]=neu); - if j>=cnt then - for i:=0 to _fr.dim-2 do - _mgl[(i+byte(i>=y))*_fr.dim+x]:=_mgl[(i+byte(i>=y))*_fr.dim+x] and not maske; - // TODO: Diagonalen - end - else begin - for i:=0 to _fr.dim-2 do begin - _mgl[y*_fr.dim+i+byte(i>=x)]:=_mgl[y*_fr.dim+i+byte(i>=x)] and not maske; - _mgl[(i+byte(i>=y))*_fr.dim+x]:=_mgl[(i+byte(i>=y))*_fr.dim+x] and not maske; - end; - // TODO: Diagonalen - end; - end - else begin - if alt=-1 then - exit; - maske:=1 shr alt; - for i:=0 to _fr.dim-2 do begin - _mgl[(i+byte(i>=y))*_fr.dim+x]:=_mgl[(i+byte(i>=y))*_fr.dim+x] or maske; - _mgl[y*_fr.dim+x+byte(i>=x)]:=_mgl[y*_fr.dim+x+byte(i>=x)] or maske; - end; - // TODO: Diagonalen - // TODO: _mgl[p] - end; -end; +implementation -procedure tFelderLoesMeta.aktualisiereRand(p,alt: longint); +uses + math, dialogs; + +{$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} + +// tButtonWithArrowkeys ******************************************************** + +procedure tButtonWithArrowkeys.WMGetDlgCode(var msg: tWMGetDLGCODE);// message WM_GETDLGCODE; begin - // hier sollte die Zeile bzw. Spalte von _rand[p] aktualisiert werden + inherited; + msg.Result := msg.Result or DLGC_WANTARROWS; end; // tRaetsel ******************************************************************** @@ -199,7 +113,7 @@ begin zeichenflaeche:=tImage.create(besitzer); zeichenflaeche.parent:=besitzer; zeichenflaeche.onMouseDown:=@onMouseDown; - erzeugeBtn:=tButton.create(besitzer); + erzeugeBtn:=tButtonWithArrowKeys.create(besitzer); erzeugeBtn.parent:=besitzer; erzeugeBtn.left:=spacing;; erzeugeBtn.top:=spacing;; @@ -243,7 +157,7 @@ end; procedure tRaetsel.erzeugeOnClick(sender: tObject); begin loeschen; - loesen(true); + loesen(true,-1); leeren; end; @@ -285,6 +199,11 @@ begin diagonalenCB.caption:='Diagonalen'; diagonalenCB.top:=erzeugeBtn.top+erzeugeBtn.height+spacing; diagonalenCB.left:=spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing; + sudokuCB:=tCheckBox.create(besitzer); + sudokuCB.parent:=besitzer; + sudokuCB.caption:='Sudoku'; + sudokuCB.top:=erzeugeBtn.top+erzeugeBtn.height+spacing; + sudokuCB.left:=diagonalenCB.left+diagonalenCB.width+spacing; zeichenflaeche.left:=spacing; zeichenflaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; aktualisiereGroesze; @@ -375,34 +294,19 @@ begin 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; + if inhalt[p[i]]<0 then + continue; w:=inhalt[p[i]]; inhalt[p[i]]:=-1; - lm.aktualisiereInhalt(p[i],w); - if _loesen(lm)<>1 then begin + if loesen(false,-1)<>1 then inhalt[p[i]]:=w; - lm.aktualisiereInhalt(p[i],-1); - end; end; p:=permutation((dim+1)*4); @@ -410,13 +314,9 @@ begin if rand[p[i]]<0 then continue; w:=rand[p[i]]; rand[p[i]]:=-1; - lm.aktualisiereRand(p[i],w); - if _loesen(lm)<>1 then begin + if loesen(false,-1)<>1 then rand[p[i]]:=w; - lm.aktualisiereRand(p[i],-1); - end; end; - lm.free; end; procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze; @@ -456,11 +356,22 @@ end; procedure tFelderRaetsel.schreibeZentriert(x,y,i: longint); var - br,ho: longint; - s: string; + br,ho: longint; + s: string; begin s:=uebersetze(i); with zeichenflaeche.canvas do begin + brush.color:=$FFFFFF - $181818*byte(diagonalenCB.checked and ((x=y) or (x+y=dim+1))); + if not passt(x,y) then + font.color:=$0000FF + else if geloest then + font.color:=$007F00 +// else if startFeld[x+y*dim] then +// font.color:=$7F7F7F + else + font.color:=$000000; + // feldFarben[x+y*dim]; + br:=textWidth(s); ho:=textHeight(s); textOut( @@ -504,5 +415,61 @@ begin schreibeZentriert(i mod dim,i div dim,inhalt[i]); 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} + end. |