unit raetselunit;

{$mode objfpc}{$H+}

interface

// TODO: Spielnummernzufall

// TODO: Cross-Compilieren

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;

  tZug = record
    Position:       integer;
    Vorher:         integer;
    vorherFarbe,
    nachherFarbe,
    vorherMalFarbe: TColor;
  end;

  tRaetsel = class
  private
    besitzer:         tForm;
    farbWahlFlaeche,
      zeichenflaeche: tImage;
    erzeugeBtn,
      speichernBtn,
      ladenBtn:       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 speichernOnClick(sender: tObject);
    procedure ladenOnClick(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;
    procedure speichern(var datei: file); dynamic;
    procedure laden(var datei: file); dynamic;
  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;
    zuege:                             array of tZug;
    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;
    procedure alsZugSpeichern;
    procedure speichern(var datei: file); override;
    procedure laden(var datei: file); 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;
  randomize;
  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;
  speichernBtn:=tButtonWithArrowKeys.create(besitzer);
  speichernBtn.parent:=besitzer;
  speichernBtn.left:=erzeugeBtn.left+erzeugeBtn.width+spacing;
  speichernBtn.top:=spacing;
  speichernBtn.caption:='Speichern!';
  speichernBtn.onClick:=@speichernOnClick;
  speichernBtn.onKeyDown:=@onKeyDown;
  ladenBtn:=tButtonWithArrowKeys.create(besitzer);
  ladenBtn.parent:=besitzer;
  ladenBtn.left:=speichernBtn.left+speichernBtn.width+spacing;
  ladenBtn.top:=spacing;
  ladenBtn.caption:='Laden!';
  ladenBtn.onClick:=@ladenOnClick;
  ladenBtn.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:=
    max(
      zeichenflaeche.width+zeichenflaeche.left,
      ladenBtn.width+ladenBtn.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);
begin
  loeschen;
  loesen(-1);
  randErzeugen;
  leeren;
  startFelderFestlegen;
  zeichnen;
end;

procedure tRaetsel.speichernOnClick(sender: tObject);
var
  saveDialog1: tSaveDialog;
  dat:         file;
begin
  saveDialog1:=tSaveDialog.create(besitzer);
  if saveDialog1.execute then begin
    assignFile(dat,saveDialog1.fileName);
    rewrite(dat,1);
    speichern(dat);
    closeFile(dat);
  end;
  saveDialog1.free;
end;

procedure tRaetsel.ladenOnClick(sender: tObject);
var
  openDialog1: tOpenDialog;
  dat:         file;
begin
  openDialog1:=tOpenDialog.create(besitzer);
  if openDialog1.execute then begin
    assignFile(dat,openDialog1.fileName);
    reset(dat,1);
    laden(dat);
    assert(eof(dat),'Zu viele Daten in Datei!');
    closeFile(dat);
    zeichnen;
  end;
  openDialog1.free;
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;

procedure tRaetsel.speichern(var datei: file);
begin
  blockWrite(datei,aktuelleFarbe,sizeOf(aktuelleFarbe));
end;

procedure tRaetsel.laden(var datei: file);
begin
  blockRead(datei,aktuelleFarbe,sizeOf(aktuelleFarbe));
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 ssCtrl in shiftState then begin
    if (Key=ord('Z')) and (length(Zuege)>0) then begin
      cursorPosition:=Zuege[length(Zuege)-1].Position;
      inhalt[cursorPosition]:=Zuege[length(Zuege)-1].Vorher;
      FeldFarben[cursorPosition]:=Zuege[length(Zuege)-1].VorherFarbe;
      aktuelleFarbe:=Zuege[length(Zuege)-1].VorherMalFarbe;
      setlength(Zuege,length(Zuege)-1);
      farbWahlFlaecheBemalen;
    end;
    Zeichnen;
    exit;
  end;

  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<dim*dim) then
          relativeInhaltsAenderung(1);
      34,109,189:
        if (cursorPosition>=0) and (cursorPosition<dim*dim) then
          relativeInhaltsAenderung(-1);
      else
        exit;
    end{of case};
  key:=0;
  zeichnen;
end;

procedure tFelderRaetsel.onMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint);
begin
  x:=floor(x/zellGroesze-1);
  y:=floor(y/zellGroesze-1);
  if (x<0) or (x>=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
  aktuelleFarbe:=$000000;
  setlength(zuege,0);
  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;
  farbWahlFlaecheBemalen;
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) and (y<dim) and (diagonalenCB.checked and ((x=y) or (x+y=dim+1))) then
      brush.color:=brush.color - $181818;
    if not passtZumZeichnen(x,y) then
      font.color:=$0000FF
    else if geloest then
      font.color:=$007F00
    else if (x<0) or (y<0) or (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;

procedure tFelderRaetsel.alsZugSpeichern;
begin
  setLength(zuege,length(zuege)+1);
  zuege[length(zuege)-1].position:=cursorPosition;
  zuege[length(zuege)-1].vorher:=inhalt[cursorPosition];
  zuege[length(zuege)-1].vorherFarbe:=feldFarben[cursorPosition];
  zuege[length(zuege)-1].nachherFarbe:=aktuelleFarbe;
  if length(zuege)=1 then
    zuege[length(zuege)-1].vorherMalFarbe:=$000000
  else
    zuege[length(zuege)-1].vorherMalFarbe:=zuege[length(zuege)-2].nachherFarbe;
end;

procedure tFelderRaetsel.speichern(var datei: file);
var
  b: byte;
  i: longint;
begin
  blockWrite(datei,'Fe',2);
  b:=byte(diagonalenCB.checked);
  blockWrite(datei,b,1);
  b:=byte(sudokuCB.enabled);
  blockWrite(datei,b,1);
  b:=byte(sudokuCB.checked);
  blockWrite(datei,b,1);
  i:=length(groeszen);
  blockWrite(datei,i,sizeof(i));
  if length(groeszen)>0 then
    blockWrite(datei,groeszen[0],length(groeszen)*sizeof(groeszen[0]));
  i:=length(inhalt);
  blockWrite(datei,i,sizeof(i));
  if length(inhalt)>0 then
    blockWrite(datei,inhalt[0],length(inhalt)*sizeof(inhalt[0]));
  i:=length(rand);
  blockWrite(datei,i,sizeof(i));
  if length(rand)>0 then
    blockWrite(datei,rand[0],length(rand)*sizeof(rand[0]));
  blockWrite(datei,dim,sizeof(dim));
  blockWrite(datei,nSqrt,sizeof(nSqrt));
  blockWrite(datei,cursorPosition,sizeof(cursorPosition));
  i:=length(feldFarben);
  blockWrite(datei,i,sizeof(i));
  if length(feldFarben)>0 then
    blockWrite(datei,feldFarben[0],length(feldFarben)*sizeof(feldFarben[0]));
  i:=length(startFeld);
  blockWrite(datei,i,sizeof(i));
  if length(startFeld)>0 then
    blockWrite(datei,startFeld[0],length(startFeld)*sizeof(startFeld[0]));
  i:=length(zuege);
  blockWrite(datei,i,sizeof(i));
  if length(zuege)>0 then
    blockWrite(datei,zuege[0],length(zuege)*sizeof(zuege[0]));
  inherited speichern(datei);
end;

procedure tFelderRaetsel.laden(var datei: file);
var
  s: string[2];
  b: byte;
  i: longint;
begin
  s:=#0#0;
  b:=0;
  i:=0;
  blockRead(datei,s,2);
  assert(s='Fe','Die zu lesende Datei ist kein Felder-Rätsel!');
  blockRead(datei,b,1);
  assert(b<=1,'Syntaxfehler in Datei!');
  diagonalenCB.checked:=odd(b);
  blockRead(datei,b,1);
  assert(b<=1,'Syntaxfehler in Datei!');
  sudokuCB.enabled:=odd(b);
  blockRead(datei,b,1);
  assert(b<=1,'Syntaxfehler in Datei!');
  sudokuCB.checked:=odd(b);
  blockRead(datei,i,sizeOf(i));
  assert(length(groeszen)=i,'Falsche Anzahl freier Paraemeter in gespeichertem Spiel!');
  if length(groeszen)>0 then
    blockRead(datei,groeszen[0],length(groeszen)*sizeof(groeszen[0]));
  for i:=0 to length(groeszen)-1 do
    spinEdits[i+1].value:=groeszen[i];
  blockRead(datei,i,sizeOf(i));
  setLength(inhalt,i);
  if length(inhalt)>0 then
    blockRead(datei,inhalt[0],length(inhalt)*sizeof(inhalt[0]));
  blockRead(datei,i,sizeOf(i));
  setLength(rand,i);
  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,cursorPosition,sizeof(cursorPosition));
  blockRead(datei,i,sizeOf(i));
  setLength(feldFarben,i);
  if length(feldFarben)>0 then
    blockRead(datei,feldFarben[0],length(feldFarben)*sizeof(feldFarben[0]));
  blockRead(datei,i,sizeOf(i));
  setLength(startFeld,i);
  if length(startFeld)>0 then
    blockRead(datei,startFeld[0],length(startFeld)*sizeof(startFeld[0]));
  blockRead(datei,i,sizeOf(i));
  setLength(zuege,i);
  if length(zuege)>0 then
    blockRead(datei,zuege[0],length(zuege)*sizeof(zuege[0]));
  inherited laden(datei);
end;

// tHochhausRaetsel und tBuchstabenRaetsel

{$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}

{$DEFINE speichern}
procedure tHochhausRaetsel.speichern(var datei: file);
{$DEFINE hochhaus}
{$I raetselunit.inc}
{$UNDEF hochhaus}
procedure tBuchstabenRaetsel.speichern(var datei: file);
{$DEFINE buchstaben}
{$I raetselunit.inc}
{$UNDEF buchstaben}
{$UNDEF speichern}

{$DEFINE laden}
procedure tHochhausRaetsel.laden(var datei: file);
{$DEFINE hochhaus}
{$I raetselunit.inc}
{$UNDEF hochhaus}
procedure tBuchstabenRaetsel.laden(var datei: file);
{$DEFINE buchstaben}
{$I raetselunit.inc}
{$UNDEF buchstaben}
{$UNDEF laden}

end.