geht schon fast

1 files changed, 251 insertions, 21 deletions

diff --git a/raetselunit.pas b/raetselunit.pas
index 6c77ce6..19306a8 100644
--- a/raetselunit.pas
+++ b/raetselunit.pas
@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Spin, Controls, StdCtrls, ExtCtrls, LCLType,
-  lowlevelunit, Messages, ComCtrls;
+  lowlevelunit, Messages, ComCtrls, Graphics;
 
 type
   tAlphabetFunktion = function(i: longint): string;
@@ -16,6 +16,10 @@ type
     procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
   end;
 
+  tSmarterCheckBox = class(tCheckBox)
+    function width: longint;
+  end;
+
   tRaetsel = class
   private
     besitzer:         tForm;
@@ -23,18 +27,25 @@ type
       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(inhaltBehalten: boolean; lPos: longint): longint; 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;
   public
     constructor create(aOwner: tForm);
     destructor destroy; override;
@@ -42,11 +53,13 @@ type
   end;
 
   tFelderRaetsel = class(tRaetsel)
+  private
     spinEdits:                         array of tSpinEdit;
-    diagonalenCB,sudokuCB:             tCheckBox;
+    diagonalenCB,sudokuCB:             tSmarterCheckBox;
     groeszen,inhalt,rand:              array of longint;
-    moeglich:                          array of int64;
-    dim,schriftGroesze,cursorPosition: longint;
+    AMoeglich,EMoeglich:               array of boolean;
+    dim,nSqrt,schriftGroesze,
+      cursorPosition:                  longint;
     zellGroesze:                       extended;
     uebersetze:                        tAlphabetFunktion;
     procedure anzSEsOnChange(sender: tObject);
@@ -80,13 +93,16 @@ type
 
 {$UNDEF interface}
 
+function  farbverlauf(wo: extended): tColor;
+function  RGB2TColor(R,G,B: Extended): TColor; inline;
+
 const
   spacing = 2;
 
 implementation
 
 uses
-  math, dialogs;
+  math, dialogs, lclintf;
 
 {$DEFINE alphabetFunktion}
 function zahlenAlphabetFunktion(i: longint): string;
@@ -99,6 +115,37 @@ function buchstabenAlphabetFunktion(i: longint): string;
 {$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;
@@ -107,6 +154,20 @@ begin
   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);
@@ -116,6 +177,11 @@ begin
   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;;
@@ -131,6 +197,7 @@ end;
 destructor tRaetsel.destroy;
 begin
   zeichenflaeche.free;
+  farbWahlFlaeche.free;
   inherited destroy;
 end;
 
@@ -158,13 +225,67 @@ begin
   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;
-  loesen(true,-1);
+  loesen(-1);
+  randErzeugen;
   leeren;
+  // TODO: Startfelder setzen
+  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 **************************************************************
@@ -180,6 +301,7 @@ begin
   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
@@ -200,18 +322,23 @@ begin
   spinEdits[0].showHint:=true;
   spinEdits[0].hint:='Schriftgröße';
   spinEdits[0].value:=14;
-  diagonalenCB:=tCheckBox.create(besitzer);
+  diagonalenCB:=tSmarterCheckBox.create(besitzer);
   diagonalenCB.parent:=besitzer;
   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);
+  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:=erzeugeBtn.top+erzeugeBtn.height+spacing;
+  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:=diagonalenCB.top+diagonalenCB.height+spacing;
+  zeichenflaeche.top:=farbWahlFlaeche.top+farbWahlFlaeche.height+spacing;
   aktualisiereGroesze;
 end;
 
@@ -284,7 +411,13 @@ begin
     dim:=dim+groeszen[i];
   end;
   setlength(inhalt,dim*dim);
-  setlength(rand,4*(dim+1));
+  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;
@@ -307,23 +440,33 @@ var
   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 loesen(false,-1)<>1 then
+    if anzLoesungen(-1)<>1 then
       inhalt[p[i]]:=w;
   end;
 
-  p:=permutation((dim+1)*4);
+  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 loesen(false,-1)<>1 then
+    if anzLoesungen(-1)<>1 then
       rand[p[i]]:=w;
   end;
+  progressbar1.visible:=false;
 end;
 
 procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze;
@@ -337,10 +480,17 @@ begin
     );
   zeichenflaeche.height:=round((dim+2)*zellGroesze);
   zeichenflaeche.width:=zeichenflaeche.height;
+  farbWahlFlaeche.height:=16;
+  farbWahlFlaeche.width:=zeichenflaeche.width;
   zeichenFlaecheNeuKreieren;
-  progressbar1.width:=besitzerBreite;
   besitzer.height:=besitzerHoehe;
-  besitzer.width:=besitzerBreite;
+  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;
 
@@ -370,7 +520,7 @@ 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 (x>=0) and (y>=0) and (x<dim) and (y<dim) and not passtZumZeichnen(x,y) then
+    if not passtZumZeichnen(x,y) then
       font.color:=$0000FF
     else if geloest then
       font.color:=$007F00
@@ -398,6 +548,22 @@ begin
   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));
@@ -406,13 +572,22 @@ begin
       lineTo(round((dim+1)*zellGroesze),round((i+1)*zellGroesze));
     end;
   zeichenflaeche.canvas.pen.color:=$8080ff;
-  if (cursorPosition>=0) and (dim>0) then
+  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]);
@@ -490,5 +665,60 @@ function  tBuchstabenRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean;
 {$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.