unit Unit1;

interface

//{$DEFINE Buchstabenraetsel} // sonst Hochhausraetsel
//{$DEFINE debug}
{$DEFINE loesungsoptimierung}
{$O+}
//{$DEFINE keinRandomize}
//{$DEFINE alternativLoesung}
{$DEFINE preLoesung}
//{$DEFINE debugFileExport}
{$DEFINE datei}
{$DEFINE Speichermoegl}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Spin, StdCtrls, ExtCtrls, Math,
{$IFDEF Speichermoegl}
  RaetselFileUnit,
{$ENDIF}
  ComCtrls, ExtDlgs;

const ProgVers = 0;

type
  TIntArray = array of integer;
  TZug = record
          Position:       integer;
          Vorher:         integer;
          VorherFarbe,
          VorherMalFarbe: TColor;
         end;
  TButtonWithArrowKeys = class(TButton)
  private
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  end;
  TForm1 = class(TForm)
    procedure SpinEdit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Image1DblClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    {$IFDEF Speichermoegl}
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    {$ENDIF}
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure preStart;
  public
    { Public-Deklarationen }
    {$IFDEF Buchstabenraetsel}
    NBuchst,
    NLeer,
    {$ENDIF}
    NGes,NSqrt:          integer;
    Rand:                array of Integer;
    Feld:                array of Integer;
    FeldFarben:          array of TColor;
    Startfeld:           array of Boolean;
    Position:            integer;
    Zuege:               array of TZug;
    Button1,
    Button2,
    Button3:             TButtonWithArrowKeys;
    Checkbox1,Checkbox2: TCheckbox;
    {$IFDEF Buchstabenraetsel}
    Spinedit2,
    {$ENDIF}
    Spinedit1,
    Spinedit3:           TSpinedit;
    {$IFDEF Speichermoegl}
    OpenDialog1:     TOpenDialog;
    SaveDialog1:     TSaveDialog;
    Button4,Button5:     TButtonWithArrowKeys;
    {$ENDIF}
    Progressbar1:        TProgressbar;
    Image1,Image2,
    SchreibeImage:       TImage;
    Leertaste_aktiviert: TDateTime;
    aktuelleFarbe,
    letzteFarbe:         TColor;
    {$IFNDEF Buchstabenraetsel}
    {$IFDEF alternativLoesung}
    Maxima,Minima:       array of Byte;
    procedure gesamtRaenderErzeugen;
    {$ENDIF}
    {$ENDIF}
    {$IFDEF preLoesung}
    AMoeglich,EMoeglich: array of Boolean;
    procedure gesamtRaenderErzeugen;
    function  passtZumZeichnen(Spalte,Zeile: integer): boolean;
    {$ENDIF}
    procedure Zeichnen;
    procedure schreibe(was: String; Spalte,Zeile: integer);
    function  passt(Spalte,Zeile: integer): boolean;
    function  Loesen(lPos: integer): boolean;
    function  geloest: boolean;
    procedure leeren;
    procedure RandErzeugen;
    function  anzLoesungen(lPos: integer): integer;
    procedure WMGetDlgCode(var Msg: TMessage);// message WM_GETDLGCODE;
    procedure Image2Bemalen;
  end;

var
  Form1: TForm1;

const Groesse = 32;

function  Permutation(n: integer): TIntArray;
function  farbverlauf(Wo: extended): TColor;
function  RGB2TColor(R,G,B: Extended): TColor;
function  Vers2Str(C: Cardinal): string;

{$IFDEF datei}
{$IFDEF Buchstabenraetsel}
const dat_name = 'Buchstabenraetsel.dat';
{$ELSE}
const dat_name = 'Hochhausraetsel.dat';
{$ENDIF}
{$ENDIF}

{$IFDEF Speichermoegl}
{$IFDEF Buchstabenraetsel}
const dat_kennung = 'BuchstRaetsel';
{$ELSE}
const dat_kennung = 'HochHRaetsel';
{$ENDIF}
const I1_top = 64+24;
const I2_top = 48+24;
{$ELSE}
const I1_top = 64;
const I2_top = 48;
{$ENDIF}

implementation

{$R *.dfm}

function  Vers2Str(C: Cardinal): string;
var i: integer;
begin
 result:='';
 for i:=0 to 3 do
  begin
   result:='.'+inttostr(C and $3)+result;
   C:=C shr 2;
  end;
 delete(result,1,1);
end;

procedure TButtonWithArrowkeys.WMGetDlgCode(var Msg: TWMGetDLGCODE);// message WM_GETDLGCODE;
begin
 inherited;
 Msg.Result := Msg.Result or DLGC_WANTARROWS;
end;

procedure TForm1.WMGetDlgCode(var Msg: TMessage);// message WM_GETDLGCODE;
begin
 inherited;
 Msg.Result := Msg.Result or DLGC_WANTARROWS;
end;

procedure TForm1.FormCreate(Sender: TObject);
{$IFNDEF Debug}
var F,G: File;
    A:   Array of Byte;
{$ENDIF}
begin
 SchreibeImage:=TImage.Create(Form1);
 {$IFNDEF Buchstabenraetsel}
 {$IFDEF alternativLoesung}
 Setlength(Maxima,0);
 Setlength(Minima,0);
 {$ENDIF}
 {$ENDIF}
 {$IFNDEF Debug}
 if Uppercase(Extractfilename(application.ExeName))='RAETSEL.EXE' then
  begin
   assignfile(F,application.exename);
   {$IFDEF Buchstabenraetsel}
   assignfile(G,extractfilepath(application.exename)+'Buchstabenraetsel.exe');
   {$ELSE}
   assignfile(G,extractfilepath(application.exename)+'Hochhausraetsel.exe');
   {$ENDIF}
   Filemode:=fmOpenRead;
   Reset(F,1);
   Rewrite(G,1);
   Setlength(A,FileSize(F));
   Blockread(F,A[0],length(A));
   Blockwrite(G,A[0],length(A));
   Closefile(G);
   Closefile(F);
   halt;
  end;
 {$ENDIF} 
 Spinedit1:=TSpinedit.create(Form1);
 Spinedit1.Parent:=Form1;
 Spinedit1.Left:=0;
 Spinedit1.Top:=0;
 Spinedit1.Height:=22;
 {$IFDEF Buchstabenraetsel}
 Spinedit1.Hint:='Anzahl Buchstaben';
 {$ELSE}
 Spinedit1.Hint:='Anzahl Zahlen';
 {$ENDIF}
 Spinedit1.MaxValue:=0;
 Spinedit1.MinValue:=0;
 Spinedit1.ShowHint:=true;
 Spinedit1.Value:=5;
 Spinedit1.Width:=57;
 Spinedit1.OnChange:=SpinEdit1Change;
 Spinedit1.OnKeyDown:=FormKeyDown;
 {$IFDEF Buchstabenraetsel}
 Form1.Caption:='Buchstabenrätsel';
 {$ELSE}
 Form1.Caption:='Hochhausrätsel';
 {$ENDIF}
 Spinedit3:=TSpinedit.Create(Form1);
 Spinedit3.Parent:=Form1;
 Spinedit3.Top:=0;
 Spinedit3.Left:=100;
 Spinedit3.MinValue:=0;
 Spinedit3.MaxValue:=99999;
 Spinedit3.MaxLength:=5;
 Spinedit3.Width:=66;
 Spinedit3.ShowHint:=true;
 Spinedit3.Hint:='Spielnummer';
 Spinedit3.OnKeyDown:=FormKeyDown;
 Checkbox1:=TCheckbox.Create(Form1);
 Checkbox1.Parent:=Form1;
 Checkbox1.Caption:='Diagonalen';
 Checkbox1.Height:=17;
 {$IFDEF Buchstabenraetsel}
 Checkbox1.Left:=117;
 {$ELSE}
 Checkbox1.Left:=64;
 {$ENDIF}
 Checkbox1.TabStop:=false;
 Checkbox1.Top:=3;
 Checkbox1.Width:=76;
 Checkbox1.OnKeyDown:=FormKeyDown;
 Checkbox1.OnClick:=SpinEdit1Change;
 Checkbox2:=TCheckbox.Create(Form1);
 Checkbox2.Parent:=Form1;
 Checkbox2.Caption:='Sudoku';
 Checkbox2.Height:=17;
 Checkbox2.Left:=Checkbox1.Left+Checkbox1.Width;
 Checkbox2.TabStop:=false;
 Checkbox2.Top:=3;
 Checkbox2.Width:=61;
 Checkbox2.OnKeyDown:=FormKeyDown;
 Checkbox2.OnClick:=SpinEdit1Change;
 Checkbox2.Enabled:=false;
 {$IFDEF Buchstabenraetsel}
 Spinedit2:=TSpinedit.create(Form1);
 Spinedit2.Parent:=Form1;
 Spinedit2.Height:=22;
 Spinedit2.Hint:='Anzahl Leerzeichen';
 Spinedit2.Left:=56;
 Spinedit2.MaxValue:=0;
 Spinedit2.MinValue:=0;
 Spinedit2.ShowHint:=true;
 Spinedit2.Top:=0;
 Spinedit2.Value:=1;
 Spinedit2.Width:=57;
 Spinedit2.OnChange:=SpinEdit1Change;
 Spinedit2.OnKeyDown:=FormKeyDown;
 {$ENDIF}
 Progressbar1:=TProgressbar.create(Form1);
 Progressbar1.Parent:=Form1;
 Progressbar1.Height:=21;
 Progressbar1.Left:=0;
 Progressbar1.Smooth:=true;
 Progressbar1.Step:=1;
 Progressbar1.Top:=I2_top+1;
 Progressbar1.Visible:=false;
 Progressbar1.Width:=473;
 Image1:=TImage.Create(Form1);
 Image1.Parent:=Form1;
 Image1.Height:=465;
 Image1.Left:=0;
 Image1.Top:=I1_top;
 Image1.Width:=473;
 Image1.OnMouseDown:=Image1MouseDown;
 Image1.OnDblClick:=Image1DblClick;
 Image2:=TImage.Create(Form1);
 Image2.Parent:=Form1;
 Image2.Height:=16;
 Image2.Left:=0;
 Image2.Top:=I2_top;
 Image2.Width:=473;
 Image2.OnMouseDown:=Image2MouseDown;
 Image2.OnMouseMove:=Image2MouseMove;
 Image2.OnMouseUp:=Image2MouseUp;
 Image2Bemalen;

 Leertaste_aktiviert:=-1;
 Button1:=TButtonWithArrowKeys.create(Form1);
 Button1.Caption:='Start!';
 Button1.Height:=25;
 Button1.Width:=49;
 Button1.Left:=0;
 Button1.Top:=23;
 Button1.TabOrder:=3;
 Button1.OnClick:=Button1Click;
 Button1.OnKeyDown:=Form1.OnKeyDown;
 Button1.OnKeyUp:=Form1.OnKeyUp;
 Button1.Parent:=Form1;
 Button2:=TButtonWithArrowKeys.create(Form1);
 Button2.Enabled:=False;
 Button2.Caption:='Feldgröße ändern!';
 Button2.Height:=25;
 Button2.Width:=109;
 Button2.Left:=48;
 Button2.Top:=23;
 Button2.TabOrder:=3;
 Button2.OnClick:=Button2Click;
 Button2.OnKeyDown:=Form1.OnKeyDown;
 Button2.OnKeyUp:=Form1.OnKeyUp;
 Button2.Parent:=Form1;
 Button3:=TButtonWithArrowKeys.create(Form1);
 Button3.Enabled:=False;
 Button3.Caption:='Neu starten!';
 Button3.Height:=25;
 Button3.Width:=79;
 Button3.Left:=156;
 Button3.Top:=23;
 Button3.TabOrder:=3;
 Button3.OnClick:=Button3Click;
 Button3.OnKeyDown:=Form1.OnKeyDown;
 Button3.OnKeyUp:=Form1.OnKeyUp;
 Button3.Parent:=Form1;

 {$IFDEF Speichermoegl}
 Button4:=TButtonWithArrowKeys.create(Form1);
 Button4.Enabled:=False;
 Button4.Caption:='Speichern!';
 Button4.Height:=25;
 Button4.Width:=79;
 Button4.Left:=0;
 Button4.Top:=47;
 Button4.TabOrder:=3;
 Button4.OnClick:=Button4Click;
 Button4.OnKeyDown:=Form1.OnKeyDown;
 Button4.OnKeyUp:=Form1.OnKeyUp;
 Button4.Parent:=Form1;
 Button5:=TButtonWithArrowKeys.create(Form1);
 Button5.Enabled:=True;
 Button5.Caption:='Laden!';
 Button5.Height:=25;
 Button5.Width:=79;
 Button5.Left:=78;
 Button5.Top:=47;
 Button5.TabOrder:=3;
 Button5.OnClick:=Button5Click;
 Button5.OnKeyDown:=Form1.OnKeyDown;
 Button5.OnKeyUp:=Form1.OnKeyUp;
 Button5.Parent:=Form1;
 OpenDialog1:=TOpenDialog.Create(Form1);
 OpenDialog1.InitialDir:=extractfilepath(application.exename);
 {$IFDEF Buchstabenraetsel}
 OpenDialog1.Filter:='Buchstabenraetsel (*.bsr)|*.bsr';
 {$ELSE}
 OpenDialog1.Filter:='Hochhausraetsel (*.hhr)|*.hhr';
 {$ENDIF}
 SaveDialog1:=TSaveDialog.Create(Form1);
 SaveDialog1.InitialDir:=extractfilepath(application.exename);
 SaveDialog1.Filter:=OpenDialog1.Filter;
 {$ENDIF}

 setlength(Zuege,0);
 setlength(Rand,0);
 setlength(Feld,0);
 setlength(FeldFarben,0);
 setlength(Startfeld,0);
 {$IFDEF Buchstabenraetsel}
 NBuchst:=5;
 NLeer:=1;
 {$ENDIF}
 NGes:=5;
 NSqrt:=2;
 Position:=0;
 {$IFNDEF keinRandomize}
 randomize;
 {$ENDIF}
 aktuelleFarbe:=$000000;
 letzteFarbe:=$000000;

 {$IFDEF preLoesung}
 gesamtRaenderErzeugen;
 {$ENDIF}
 Spinedit3.Value:=random(Spinedit3.MaxValue+1);
 Spinedit1.OnChange(Form1);
 if (Paramcount>0) and fileexists(Paramstr(1)) then
  begin
   OpenDialog1.Tag:=1;
   OpenDialog1.FileName:=Paramstr(1);
   Button5Click(Sender);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 SchreibeImage.Free;
 Button1.Free;
 Button2.Free;
 Button3.Free;
 {$IFDEF Speichermoegl}
 Button4.Free;
 Button5.Free;
 OpenDialog1.Free;
 SaveDialog1.Free;
 {$ENDIF}
 {$IFDEF Buchstabenraetsel}
 Spinedit1.Free;
 Spinedit2.Free;
 {$ENDIF}
 Checkbox1.Free;
 Checkbox2.Free;
 Progressbar1.Free;
 Image1.Free;
 setlength(Zuege,0);
 setlength(Feld,0);
 setlength(FeldFarben,0);
 setlength(Startfeld,0);
 setlength(Rand,0);
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
var I: Integer;
begin
 if (Spinedit1.Value = 0)
 {$IFDEF Buchstabenraetsel}
    and (Spinedit2.Value = 0)
 {$ENDIF}
  then exit;
 {$IFDEF Buchstabenraetsel}
 NBuchst:=Abs(Spinedit1.Value);
 NLeer:=Abs(Spinedit2.Value);
 NGes:=NBuchst+NLeer;
 {$ELSE}
 NGes:=Abs(Spinedit1.Value);
 {$ENDIF}
 NSqrt:=round(sqrt(NGes));
 Checkbox2.Enabled:=Sqr(NSqrt)=NGes;
 if (not Checkbox2.Enabled) and Checkbox2.Checked then
  Checkbox2.Checked:=false;
 Position:=0;

 setlength(Zuege,0);
 setlength(Rand,4*NGes);
 For I:=0 to length(Rand)-1 do
  Rand[I]:=0;
 setlength(Feld,NGes*NGes);
 setlength(FeldFarben,NGes*NGes);
 setlength(Startfeld,NGes*NGes);
 For I:=0 to length(Feld)-1 do
  begin
   {$IFDEF Buchstabenraetsel}
   Feld[I]:=-1;
   {$ELSE}
   Feld[I]:=0;
   {$ENDIF}
   Feldfarben[I]:=$000000;
   Startfeld[I]:=true;
  end;

 Image1.Free;
 Image1:=TImage.Create(Form1);
 Image1.Parent:=Form1;
 Image1.Left:=0;
 Image1.Top:=I1_top;
 Image1.Width:=Groesse*(NGes+2);
 Image1.Height:=Groesse*(NGes+2);
 Image1.OnMouseDown:=Image1MouseDown;
 Image1.OnDblClick:=Image1DblClick;
 Image1.Canvas.Font.Size:=Groesse;
 SchreibeImage.Canvas.Font.Size:=Groesse;

 Image2.Free;
 Image2:=TImage.Create(Form1);
 Image2.Parent:=Form1;
 Image2.Height:=16;
 Image2.Left:=0;
 Image2.Top:=I2_top;
 Image2.Width:=Groesse*(NGes+2);
 Image2.OnMouseDown:=Image2MouseDown;
 Image2.OnMouseMove:=Image2MouseMove;
 Image2.OnMouseUp:=Image2MouseUp;
 Image2Bemalen;

 {$IFDEF Buchstabenraetsel}
 while Image1.Canvas.TextHeight('A')*2 >= Groesse*3 do
  begin
   Image1.Canvas.Font.Size:=Image1.Canvas.Font.Size-1;
   SchreibeImage.Canvas.Font.Size:=Image1.Canvas.Font.Size;
  end;
 {$ELSE}
 while Image1.Canvas.TextHeight('0')*2 >= Groesse*3 do
  begin
   Image1.Canvas.Font.Size:=Image1.Canvas.Font.Size-1;
   SchreibeImage.Canvas.Font.Size:=Image1.Canvas.Font.Size;
  end;
 {$ENDIF}
 Image1.OnMouseDown:=Image1MouseDown;
 Image1.OnDblClick:=Image1DblClick;
 {$IFDEF Buchstabenraetsel}
 Form1.Width:=Form1.Width-Form1.Clientwidth+
      Max(Image1.Width+Image1.Left,
          Checkbox2.Width+Checkbox2.Left+Spinedit3.Width);
 {$ELSE}
 Form1.Width:=Form1.Width-Form1.Clientwidth+
      Max(Image1.Width+Image1.Left,
      Max(Button3.Width+Button3.Left,
          Checkbox2.Width+Checkbox2.Left+Spinedit3.Width));
 {$ENDIF}
 Form1.Height:=Form1.Height-Form1.Clientheight+
      Max(Image1.Height+Image1.Top,
          Progressbar1.Height+Progressbar1.Top);
 Zeichnen;
end;

procedure TForm1.Zeichnen;
var I:           Integer;
    FeldGeloest,
    passtHier:   Boolean;
begin
 Image1.Canvas.Rectangle(-1,-1,Image1.Width+2,Image1.Height+2);

 FeldGeloest:=Geloest;

 if Checkbox1.Checked then
  begin
   Image1.Canvas.Brush.Color:=$E7E7E7;
   For I:=0 to NGes-1 do
    begin
     Image1.Canvas.Rectangle(Groesse*(I+1),Groesse*(I+1),
                             Groesse*(I+2)+1,Groesse*(I+2)+1);
     Image1.Canvas.Rectangle(Groesse*(NGes-I),Groesse*(I+1),
                             Groesse*(NGes-I+1)+1,Groesse*(I+2)+1);
    end;
   Image1.Canvas.Brush.Color:=$FFFFFF;
  end;

 For I:=0 to length(Feld)-1 do
  begin
   {$IFDEF preLoesung}
   passtHier:=passtZumZeichnen(I mod NGes, I div NGes);
   {$ELSE}
   passtHier:=passt(I mod NGes, I div NGes);
   {$ENDIF}
   SchreibeImage.Canvas.Brush.Color:=$FFFFFF - $181818*Byte(Checkbox1.Checked and ((I mod (NGes+1) = 0) or (I mod (NGes-1)=0)));
   SchreibeImage.Canvas.Font.Color:=
     $0000FF*Byte(not passtHier) or
     $007F00*Byte(FeldGeloest) or
     $7F7F7F*Byte(Startfeld[I] and passtHier) or
     Feldfarben[I]*Byte((not FeldGeloest) and (not Startfeld[I]) and passtHier);
   {$IFDEF Buchstabenraetsel}
   case Feld[I] of
    -1: ;
    0:  schreibe('-', I mod NGes, I div NGes);
    else schreibe(char(ord('A')-1+Feld[I]), I mod NGes, I div NGes);
   end{of Case};
   {$ELSE}
   if Feld[I]>0 then
    schreibe(inttostr(Feld[I]), I mod NGes, I div NGes);
   {$ENDIF}
  end;
 SchreibeImage.Canvas.Font.Color:=$9F0000;
 SchreibeImage.Canvas.Brush.Color:=$FFFFFF;

 {$IFDEF Buchstabenraetsel}
 For I:=0 to length(Rand) div 4 - 1 do
  begin
   if Rand[I]>0 then
    schreibe(char(ord('A')-1+Rand[I]), I,-1);
   if Rand[I + length(Rand) div 4]>0 then
    schreibe(char(ord('A')-1+Rand[I + length(Rand) div 4]), NGes, I);
   if Rand[I + 2*(length(Rand) div 4)]>0 then
    schreibe(char(ord('A')-1+Rand[I + 2*(length(Rand) div 4)]), I, NGes);
   if Rand[I + 3*(length(Rand) div 4)]>0 then
    schreibe(char(ord('A')-1+Rand[I + 3*(length(Rand) div 4)]), -1, I);
  end;
 {$ELSE}
 For I:=0 to length(Rand) div 4 - 1 do
  begin
   if Rand[I]>0 then
    schreibe(inttostr(Rand[I]), I,-1);
   if Rand[I + length(Rand) div 4]>0 then
    schreibe(inttostr(Rand[I + length(Rand) div 4]), NGes, I);
   if Rand[I + 2*(length(Rand) div 4)]>0 then
    schreibe(inttostr(Rand[I + 2*(length(Rand) div 4)]), I, NGes);
   if Rand[I + 3*(length(Rand) div 4)]>0 then
    schreibe(inttostr(Rand[I + 3*(length(Rand) div 4)]), -1, I);
  end;
 {$ENDIF}
 SchreibeImage.Canvas.Font.Color:=$000000;

 For I:=0 to NGes do
  begin
   Image1.Canvas.MoveTo(Groesse*(I+1),Groesse);
   Image1.Canvas.LineTo(Groesse*(I+1),Image1.Height-Groesse+1);
   Image1.Canvas.MoveTo(Groesse,Groesse*(I+1));
   Image1.Canvas.LineTo(Image1.Width-Groesse+1,Groesse*(I+1));
  end;

 Image1.Canvas.Pen.Color:=$8080FF;
 Image1.Canvas.Brush.Style:=bsClear;
 Image1.Canvas.Pen.Width:=3;
 Image1.Canvas.Rectangle((Position mod NGes+1)*Groesse,
                         (Position div NGes+1)*Groesse,
                         (Position mod NGes+2)*Groesse+1,
                         (Position div NGes+2)*Groesse+1);

 Image1.Canvas.Pen.Color:=$000000;
 Image1.Canvas.Pen.Width:=3;
 Image1.Canvas.Rectangle(Groesse-1,Groesse-1,Groesse*(NGes+1)+2,Groesse*(NGes+1)+2);
 if Checkbox2.Checked then
  for I:=1 to NSqrt-1 do
   begin
    Image1.Canvas.MoveTo((I*NSqrt+1)*Groesse,Groesse);
    Image1.Canvas.LineTo((I*NSqrt+1)*Groesse,Groesse*(NGes+1));
    Image1.Canvas.MoveTo(Groesse,(I*NSqrt+1)*Groesse);
    Image1.Canvas.LineTo(Groesse*(NGes+1),(I*NSqrt+1)*Groesse);
   end;
 Image1.Canvas.Pen.Width:=1;
 Image1.Canvas.Brush.Style:=bsSolid;
end;

procedure TForm1.schreibe(was: String; Spalte,Zeile: integer);
var bgcl,fcl:   TColor;
    w,h,x,y,fs: longint;
begin
 if (SchreibeImage.Width<Groesse) or
    (SchreibeImage.Height<Groesse) then
  begin
   bgcl:=SchreibeImage.Canvas.Brush.Color;
   fcl:=SchreibeImage.Canvas.Font.Color;
   fs:=SchreibeImage.Canvas.Font.Size;
   SchreibeImage.Free;
   SchreibeImage:=TImage.Create(Form1);
   SchreibeImage.Width:=Groesse;
   SchreibeImage.Height:=Groesse;
   SchreibeImage.Canvas.Brush.Color:=bgcl;
   SchreibeImage.Canvas.Font.Color:=fcl;
   SchreibeImage.Canvas.Font.Size:=fs;
  end;
 w:=Image1.Canvas.TextWidth(was);
 h:=Image1.Canvas.TextHeight(was);
 x:=Groesse*(Spalte+1);
 y:=Groesse*(Zeile+1);
 SchreibeImage.Canvas.Rectangle(-1,-1,Groesse+1,Groesse+1);
 SchreibeImage.Canvas.TextOut(round(0.5*(Groesse-w+1)),round(0.5*(Groesse-h+1)),was);
 Image1.Canvas.CopyRect(
   Rect(x,y,x+Groesse-1,y+Groesse-1),
   SchreibeImage.Canvas,
   Rect(0,0,Groesse-1,Groesse-1));
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Spinedit1.Enabled then exit;
 if ssCtrl in Shift then
  begin
   if (Key=ord('Z')) and (length(Zuege)>0) then
    begin
     Position:=Zuege[length(Zuege)-1].Position;
     Feld[Position]:=Zuege[length(Zuege)-1].Vorher;
     FeldFarben[Position]:=Zuege[length(Zuege)-1].VorherFarbe;
     aktuelleFarbe:=Zuege[length(Zuege)-1].VorherMalFarbe;
     letzteFarbe:=aktuelleFarbe;
     setlength(Zuege,length(Zuege)-1);
     Image2bemalen;
    end;
   Zeichnen;
   exit;
  end;
 case Key of
  37: Position:=Position-1 + Byte(Position mod NGes = 0);
  38: Position:=Position-NGes + NGes*Byte(Position div NGes = 0);
  39: Position:=Position+1 - Byte(Position mod NGes = NGes-1);
  40: Position:=Position+NGes - NGes*Byte(Position div NGes = NGes-1);
  {$IFDEF Buchstabenraetsel}
  109,189:
   if (not Startfeld[Position]) and
      ((Feldfarben[Position]<>aktuelleFarbe) or
       (Feld[Position]<>0)) then
    begin
     setlength(Zuege,length(Zuege)+1);
     Zuege[length(Zuege)-1].Position:=Position;
     Zuege[length(Zuege)-1].Vorher:=Feld[Position];
     Zuege[length(Zuege)-1].VorherFarbe:=FeldFarben[Position];
     Zuege[length(Zuege)-1].VorherMalFarbe:=letzteFarbe;
     Feld[Position]:=0;
     Feldfarben[Position]:=aktuelleFarbe;
     letzteFarbe:=aktuelleFarbe;
    end;
  {$ENDIF}
  8,32,46:
   if (not Startfeld[Position]) and
      {$IFDEF Buchstabenraetsel}
      (Feld[Position]<>-1) then
      {$ELSE}
      (Feld[Position]<>0) then
      {$ENDIF}
    begin
     setlength(Zuege,length(Zuege)+1);
     Zuege[length(Zuege)-1].Position:=Position;
     Zuege[length(Zuege)-1].Vorher:=Feld[Position];
     Zuege[length(Zuege)-1].VorherFarbe:=FeldFarben[Position];
     Zuege[length(Zuege)-1].VorherMalFarbe:=letzteFarbe;
     {$IFDEF Buchstabenraetsel}
     Feld[Position]:=-1;
     {$ELSE}
     Feld[Position]:=0;
     {$ENDIF}
    end;
  else
   if not Startfeld[Position] then
    {$IFDEF Buchstabenraetsel}
    if (ord('A')<=Key) and
       (ord('A')+NBuchst>Key) and
       ((FeldFarben[Position]<>aktuelleFarbe) or
        (Feld[Position]<>Key-ord('A')+1)) then
        begin
         setlength(Zuege,length(Zuege)+1);
         Zuege[length(Zuege)-1].Position:=Position;
         Zuege[length(Zuege)-1].Vorher:=Feld[Position];
         Zuege[length(Zuege)-1].VorherFarbe:=FeldFarben[Position];
         Zuege[length(Zuege)-1].VorherMalFarbe:=LetzteFarbe;
         Feld[Position]:=Key-ord('A')+1;
         FeldFarben[Position]:=aktuelleFarbe;
         letzteFarbe:=aktuelleFarbe;
        end;
    {$ELSE}
    begin
     if (ord('1')<=Key) and
        (ord('1')+NGes>Key) and
        ((FeldFarben[Position]<>aktuelleFarbe) or
         (Feld[Position]<>Key-ord('0'))) then
         begin
          setlength(Zuege,length(Zuege)+1);
          Zuege[length(Zuege)-1].Position:=Position;
          Zuege[length(Zuege)-1].Vorher:=Feld[Position];
          Zuege[length(Zuege)-1].VorherFarbe:=FeldFarben[Position];
          Zuege[length(Zuege)-1].VorherMalFarbe:=LetzteFarbe;
          Feld[Position]:=Key-ord('0');
          FeldFarben[Position]:=aktuelleFarbe;
          letzteFarbe:=aktuelleFarbe;
         end;
     if (97<=Key) and
        (97+NGes>Key) and
        ((FeldFarben[Position]<>aktuelleFarbe) or
         (Feld[Position]<>Key-96)) then
         begin
          setlength(Zuege,length(Zuege)+1);
          Zuege[length(Zuege)-1].Position:=Position;
          Zuege[length(Zuege)-1].Vorher:=Feld[Position];
          Zuege[length(Zuege)-1].VorherFarbe:=FeldFarben[Position];
          Zuege[length(Zuege)-1].VorherMalFarbe:=LetzteFarbe;
          Feld[Position]:=Key-96;
          FeldFarben[Position]:=aktuelleFarbe;
          letzteFarbe:=aktuelleFarbe;
         end;
    end;
    {$ENDIF}
 end{of Case};
 {$IFDEF debug}
 Form1.Caption:=inttostr(Key);
 {$ENDIF}
 zeichnen;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 X:=X div Groesse;
 Y:=Y div Groesse;
 if ssCtrl in Shift then
  begin
   if (X>0) and (X<=NGes) and
      (Y>0) and (Y<=NGes) then
    begin
     Position:=(X-1) + (Y-1)*NGes;
     inc(Feld[Position]);
     {$IFDEF Buchstabenraetsel}
     if Feld[Position]>NBuchst then
      Feld[Position]:=-1;
     {$ELSE}
     if Feld[Position]>NGes then
      Feld[Position]:=-1;
     {$ENDIF}
     zeichnen;
    end
   else
    if ((X>0) and (X<=NGes)) or
       ((Y>0) and (Y<=NGes)) then
     begin
      X:=Byte(Y=0)*(X-1) +
         Byte(Y=NGes+1)*(2*NGes+(X-1)) +
         Byte(X=NGes+1)*(NGes+(Y-1)) +
         Byte(X=0)*(3*NGes+(Y-1));
      inc(Rand[X]);
      {$IFDEF Buchstabenraetsel}
      if Rand[X]>NBuchst then
       Rand[X]:=0;
      {$ELSE}
      if Rand[X]>NGes then
       Rand[X]:=0;
      {$ENDIF}
      zeichnen;
     end
      else
     begin
      if (X=0) and (Y=0) then
       begin
        GesamtRaenderErzeugen;
        exit;
       end;
      if (X=0) and (Y<>0) then
       begin
        Form1.Caption:=inttostr(AnzLoesungen(-1));
        exit;
       end;
      if (X<>0) and (Y<>0) then
       begin
        Form1.Caption:=inttostr(Byte(loesen(-1)));
        exit;
       end;
     end;
  end
   else
  if (X>0) and (X<=NGes) and
     (Y>0) and (Y<=NGes) then
   begin
    Position:=(X-1) + (Y-1)*NGes;
    zeichnen;
   end;
end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if Button<>mbLeft then exit;
 aktuelleFarbe:=Farbverlauf(X/(Image2.Width+1));
 Image2Bemalen;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
 if not(ssLeft in Shift) then exit;
 aktuelleFarbe:=Farbverlauf(X/(Image2.Width+1));
 Image2Bemalen;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if Button<>mbLeft then exit;
 aktuelleFarbe:=Farbverlauf(X/(Image2.Width+1));
 Image2Bemalen;
end;

function  TForm1.geloest: boolean;
var I,J: Integer;
begin
 Result:=False;
 For I:=0 to NGes-1 do
  For J:=0 to NGes-1 do
   if (not passt(I,J)) or (Feld[I+NGes*J]<0)
    {$IFNDEF Buchstabenraetsel}
    or (Feld[I+NGes*J]=0)
    {$ENDIF}
    then exit;
 Result:=true;
end;

{$IFDEF preLoesung}
function  TForm1.passt(Spalte,Zeile: integer): boolean;
var I,KZ,KS: Integer;
    W,S,K:   Longint;
begin
 W:=0;
 S:=0;
 K:=0;
 if Checkbox2.Checked then
  begin
   KZ:=(Zeile div NSqrt)*NSqrt;
   KS:=(Spalte div NSqrt)*NSqrt;
   For I:=0 to NGes-1 do
    begin
     {$IFDEF Buchstabenraetsel}
     W:=W*(NBuchst+2)+Feld[Zeile*NGes+I]+1;
     S:=S*(NBuchst+2)+Feld[I*NGes+Spalte]+1;
     K:=K*(NBuchst+2)+Feld[(KZ+(I div NSqrt))*NGes+KS+(I mod NSqrt)]+1;
     {$ELSE}
     W:=W*(NGes+1)+Feld[Zeile*NGes+I];
     S:=S*(NGes+1)+Feld[I*NGes+Spalte];
     K:=K*(NGes+1)+Feld[(KZ+(I div NSqrt))*NGes+KS+(I mod NSqrt)];
     {$ENDIF}
    end;
   Result:=
     {$IFDEF Buchstabenraetsel}
     AMoeglich[K*(NBuchst+1)] and
     EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
     AMoeglich[W*(NBuchst+1)+Rand[NGes+Zeile]] and
     AMoeglich[S*(NBuchst+1)+Rand[2*NGes+Spalte]] and
     EMoeglich[W*(NBuchst+1)+Rand[3*NGes+Zeile]];
     {$ELSE}
     AMoeglich[K*(NGes+1)] and
     EMoeglich[S*(NGes+1)+Rand[Spalte]] and
     AMoeglich[W*(NGes+1)+Rand[NGes+Zeile]] and
     AMoeglich[S*(NGes+1)+Rand[2*NGes+Spalte]] and
     EMoeglich[W*(NGes+1)+Rand[3*NGes+Zeile]];
     {$ENDIF}
  end
   else
  begin
   For I:=0 to NGes-1 do
    begin
     {$IFDEF Buchstabenraetsel}
     W:=W*(NBuchst+2)+Feld[Zeile*NGes+I]+1;
     S:=S*(NBuchst+2)+Feld[I*NGes+Spalte]+1;
     {$ELSE}
     W:=W*(NGes+1)+Feld[Zeile*NGes+I];
     S:=S*(NGes+1)+Feld[I*NGes+Spalte];
     {$ENDIF}
    end;
   Result:=
     {$IFDEF Buchstabenraetsel}
     EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
     AMoeglich[W*(NBuchst+1)+Rand[NGes+Zeile]] and
     AMoeglich[S*(NBuchst+1)+Rand[2*NGes+Spalte]] and
     EMoeglich[W*(NBuchst+1)+Rand[3*NGes+Zeile]];
     {$ELSE}
     EMoeglich[S*(NGes+1)+Rand[Spalte]] and
     AMoeglich[W*(NGes+1)+Rand[NGes+Zeile]] and
     AMoeglich[S*(NGes+1)+Rand[2*NGes+Spalte]] and
     EMoeglich[W*(NGes+1)+Rand[3*NGes+Zeile]];
     {$ENDIF}
  end;
 if checkbox1.checked then
  begin
   if Zeile=Spalte then
    begin
     W:=0;
     {$IFDEF Buchstabenraetsel}
     For I:=0 to NGes-1 do
      W:=W*(NBuchst+2)+Feld[I*(NGes+1)]+1;
     Result:=Result and AMoeglich[W*(NBuchst+1)];
     {$ELSE}
     For I:=0 to NGes-1 do
      W:=W*(NGES+1)+Feld[I*(NGes+1)];
     Result:=Result and AMoeglich[W*(NGes+1)];
     {$ENDIF}
    end;
   if Zeile+Spalte=NGes-1 then
    begin
     W:=0;
     {$IFDEF Buchstabenraetsel}
     For I:=0 to NGes-1 do
      W:=W*(NBuchst+2)+Feld[(I+1)*(NGes-1)]+1;
     Result:=Result and AMoeglich[W*(NBuchst+1)];
     {$ELSE}
     For I:=0 to NGes-1 do
      W:=W*(NGes+1)+Feld[(I+1)*(NGes-1)];
     Result:=Result and AMoeglich[W*(NGes+1)];
     {$ENDIF}
    end;
  end;
end;

function  TForm1.passtZumZeichnen(Spalte,Zeile: integer): boolean;
var I,KS,KZ: Integer;
    W,S:     Longint;
begin
 {$IFDEF Buchstabenraetsel}
 if Feld[Zeile*NGes+Spalte]=-1 then
 {$ELSE}
 if Feld[Zeile*NGes+Spalte]=0 then
 {$ENDIF}
  begin
   Result:=False;
   Exit;
  end;
 W:=0;
 S:=0;
 For I:=0 to NGes-1 do
  begin
   {$IFDEF Buchstabenraetsel}
   W:=W*(NBuchst+2)+Feld[Zeile*NGes+I]+1;
   S:=S*(NBuchst+2)+Feld[I*NGes+Spalte]+1;
   {$ELSE}
   W:=W*(NGes+1)+Feld[Zeile*NGes+I];
   S:=S*(NGes+1)+Feld[I*NGes+Spalte];
   {$ENDIF}
  end;
 Result:=
   {$IFDEF Buchstabenraetsel}
   (EMoeglich[S*(NBuchst+1)+Rand[Spalte]] or not EMoeglich[S*(NBuchst+1)]) and
   (AMoeglich[W*(NBuchst+1)+Rand[NGes+Zeile]] or not AMoeglich[W*(NBuchst+1)]) and
   (AMoeglich[S*(NBuchst+1)+Rand[2*NGes+Spalte]] or not AMoeglich[S*(NBuchst+1)]) and
   (EMoeglich[W*(NBuchst+1)+Rand[3*NGes+Zeile]] or not EMoeglich[W*(NBuchst+1)]);
   {$ELSE}
   (EMoeglich[S*(NGes+1)+Rand[Spalte]] or not EMoeglich[S*(NGes+1)]) and
   (AMoeglich[W*(NGes+1)+Rand[NGes+Zeile]] or not AMoeglich[W*(NGes+1)]) and
   (AMoeglich[S*(NGes+1)+Rand[2*NGes+Spalte]] or not AMoeglich[S*(NGes+1)]) and
   (EMoeglich[W*(NGes+1)+Rand[3*NGes+Zeile]] or not EMoeglich[W*(NGes+1)]);
   {$ENDIF}
 {$IFDEF Buchstabenraetsel}
 if Feld[Zeile*NGes+Spalte]=0 then W:=NLeer
                              else W:=1;
 {$ELSE}
 W:=1;
 {$ENDIF}
 if checkbox1.checked then
  begin
   if Zeile=Spalte then
    begin
     S:=W;
     For I:=0 to NGes-1 do
      if (I<>Zeile) and (Feld[I*(NGes+1)]=Feld[Zeile*NGes+Spalte]) then
       dec(S);
     Result:=Result and (S>0);
    end;
   if Zeile+Spalte=NGes-1 then
    begin
     S:=W;
     For I:=0 to NGes-1 do
      if (I<>Zeile) and (Feld[(I+1)*(NGes-1)]=Feld[Zeile*NGes+Spalte]) then
       dec(S);
     Result:=Result and (S>0);
    end;
  end;
 if checkbox2.checked then
  begin
   KZ:=(Zeile div NSqrt)*NSqrt;
   KS:=(Spalte div NSqrt)*NSqrt;
   S:=W+1;
   For I:=0 to NGes-1 do
    if Feld[(KZ+(I div NSqrt))*NGes+KS+(I mod NSqrt)]=Feld[Zeile*NGes+Spalte] then
     dec(S);
   Result:=Result and (S>0);
  end;
 S:=W;
 For I:=0 to NGes-1 do
  if (I<>Zeile) and (Feld[I*NGes+Spalte]=Feld[Zeile*NGes+Spalte]) then
   dec(S);
 Result:=Result and (S>0);
 S:=W;
 For I:=0 to NGes-1 do
  if (I<>Spalte) and (Feld[Zeile*NGes+I]=Feld[Zeile*NGes+Spalte]) then
   dec(S);
 Result:=Result and (S>0);
(* {$ELSE}
 For I:=0 to NGes-1 do
  Result:=Result and ((I=Zeile) or (Feld[I*NGes+Spalte]<>Feld[Zeile*NGes+Spalte]));
 For I:=0 to NGes-1 do
  Result:=Result and ((I=Spalte) or (Feld[Zeile*NGes+I]<>Feld[Zeile*NGes+Spalte]));
 {$ENDIF} *)
end;

{$ELSE}

function  TForm1.passt(Spalte,Zeile: integer): boolean;
{$IFDEF Buchstabenraetsel}
var I,Z:  Integer;
    Frei: Integer;
begin
 result:=true;
 if Feld[Zeile*NGes+Spalte]=-1 then exit;
 Frei:=1;
 if Feld[Zeile*NGes+Spalte]=0 then Frei:=NLeer;
 Z:=0;
 For I:=0 to NGes-1 do
  if Feld[NGes*Zeile+I]=Feld[Spalte+Zeile*NGes] then inc(Z);
 Result:=Result and (Frei>=Z);
 if not result then exit;
 Z:=0;
 For I:=0 to NGes-1 do
  if Feld[NGes*I+Spalte]=Feld[Spalte+Zeile*NGes] then inc(Z);
 Result:=Result and (Frei>=Z);
 if not result then exit;
 if Checkbox1.checked then
  begin
   if Zeile=Spalte then
    begin
     Z:=0;
     For I:=0 to NGes-1 do
      if Feld[I*(NGes+1)]=Feld[Spalte+Zeile*NGes] then inc(Z);
     Result:=Result and (Frei>=Z);
     if not result then exit;
    end;
   if Zeile+Spalte=NGes-1 then
    begin
     Z:=0;
     For I:=0 to NGes-1 do
      if Feld[(I+1)*(NGes-1)]=Feld[Spalte+Zeile*NGes] then inc(Z);
     Result:=Result and (Frei>=Z);
     if not result then exit;
    end;
  end;
 if Rand[Spalte]>0 then
  For I:=0 to NGes-1 do
   begin
    if (Feld[I*NGes+Spalte]=Rand[Spalte]) or
       (Feld[I*NGes+Spalte]<0) then break;
    if Feld[I*NGes+Spalte]>0 then
     begin
      result:=I<Zeile;
      if result then break
                else exit;
     end;
   end;
 if Rand[2*NGes+Spalte]>0 then
  For I:=NGes-1 downto 0 do
   begin
    if (Feld[I*NGes+Spalte]=Rand[2*NGes+Spalte]) or
       (Feld[I*NGes+Spalte]<0) then break;
    if Feld[I*NGes+Spalte]>0 then
     begin
      result:=I>Zeile;
      if result then break
                else exit;
     end;
   end;
 if Rand[NGes+Zeile]>0 then
  For I:=NGes-1 downto 0 do
   begin
    if (Feld[Zeile*NGes+I]=Rand[NGes+Zeile]) or
       (Feld[Zeile*NGes+I]<0) then break;
    if Feld[Zeile*NGes+I]>0 then
     begin
      result:=I>Spalte;
      if result then break
                else exit;
     end;
   end;
 if Rand[3*NGes+Zeile]>0 then
  For I:=0 to NGes-1 do
   begin
    if (Feld[Zeile*NGes+I]=Rand[3*NGes+Zeile]) or
       (Feld[Zeile*NGes+I]<0) then break;
    if Feld[Zeile*NGes+I]>0 then
     begin
      result:=I<Spalte;
      if result then break
                else exit;
     end;
   end;
end;
{$ELSE}

var I:           Integer;
{$IFDEF alternativLoesung}
    J:           Longint;
{$ELSE}
    Za,Zi,Ha,Hi: Integer;
{$ENDIF}
begin
 result:=true;
 if Feld[Zeile*NGes+Spalte]=0 then exit;
 For I:=0 to NGes-1 do
  if (I<>Spalte) and (Feld[NGes*Zeile+I]=Feld[Spalte+Zeile*NGes]) then
   begin
    result:=false;
    exit;
   end;
 For I:=0 to NGes-1 do
  if (I<>Zeile) and (Feld[NGes*I+Spalte]=Feld[Spalte+Zeile*NGes]) then
   begin
    result:=false;
    exit;
   end;
 {$IFDEF alternativLoesung}
 if Rand[Spalte]>0 then
  begin
   J:=0;
   For I:=0 to NGes-1 do
    J:=J*(NGes+1)+Feld[I*NGes+Spalte];
   if (Maxima[J]<Rand[Spalte]) or
      (Minima[J]>Rand[Spalte]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[2*NGes+Spalte]>0 then
  begin
   J:=0;
   For I:=NGes-1 downto 0 do
    J:=J*(NGes+1)+Feld[I*NGes+Spalte];
   if (Maxima[J]<Rand[2*NGes+Spalte]) or
      (Minima[J]>Rand[2*NGes+Spalte]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[NGes+Zeile]>0 then
  begin
   J:=0;
   For I:=NGes-1 downto 0 do
    J:=J*(NGes+1)+Feld[Zeile*NGes+I];
   if (Maxima[J]<Rand[NGes+Zeile]) or
      (Minima[J]>Rand[NGes+Zeile]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[3*NGes+Zeile]>0 then
  begin
   J:=0;
   For I:=0 to NGes-1 do
    J:=J*(NGes+1)+Feld[Zeile*NGes+I];
   if (Maxima[J]<Rand[3*NGes+Zeile]) or
      (Minima[J]>Rand[3*NGes+Zeile]) then
    begin
     result:=false;
     exit;
    end;
  end;
 {$ELSE}
 if Rand[Spalte]>0 then
  begin
   Za:=0;
   Zi:=0;
   Ha:=0;
   Hi:=0;
   For I:=0 to NGes-1 do
    begin
     if (Feld[I*NGes+Spalte]=0) and
        (Ha<NGes) then
      begin
       inc(Ha);
       inc(Za);
      end;
     if (Feld[I*NGes+Spalte]=0) and
        (Hi<NGes) then
      begin
       Hi:=NGes;
       inc(Zi);
      end;
     if Feld[I*NGes+Spalte]>Ha then
      begin
       Ha:=Feld[I*NGes+Spalte];
       inc(Za);
      end;
     if Feld[I*NGes+Spalte]>Hi then
      begin
       Hi:=Feld[I*NGes+Spalte];
       inc(Zi);
      end;
    end;
   if (Zi>Rand[Spalte]) or (Za<Rand[Spalte]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[2*NGes+Spalte]>0 then
  begin
   Za:=0;
   Zi:=0;
   Ha:=0;
   Hi:=0;
   For I:=NGes-1 downto 0 do
    begin
     if (Feld[I*NGes+Spalte]=0) and
        (Ha<NGes) then
      begin
       inc(Ha);
       inc(Za);
      end;
     if (Feld[I*NGes+Spalte]=0) and
        (Hi<NGes) then
      begin
       Hi:=NGes;
       inc(Zi);
      end;
     if Feld[I*NGes+Spalte]>Ha then
      begin
       Ha:=Feld[I*NGes+Spalte];
       inc(Za);
      end;
     if Feld[I*NGes+Spalte]>Hi then
      begin
       Hi:=Feld[I*NGes+Spalte];
       inc(Zi);
      end;
    end;
   if (Zi>Rand[2*NGes+Spalte]) or (Za<Rand[2*NGes+Spalte]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[NGes+Zeile]>0 then
  begin
   Za:=0;
   Zi:=0;
   Ha:=0;
   Hi:=0;
   For I:=NGes-1 downto 0 do
    begin
     if (Feld[Zeile*NGes+I]=0) and
        (Ha<NGes) then
      begin
       inc(Ha);
       inc(Za);
      end;
     if (Feld[Zeile*NGes+I]=0) and
        (Hi<NGes) then
      begin
       Hi:=NGes;
       inc(Zi);
      end;
     if Feld[Zeile*NGes+I]>Ha then
      begin
       Ha:=Feld[Zeile*NGes+I];
       inc(Za);
      end;
     if Feld[Zeile*NGes+I]>Hi then
      begin
       Hi:=Feld[Zeile*NGes+I];
       inc(Zi);
      end;
    end;
   if (Zi>Rand[NGes+Zeile]) or (Za<Rand[NGes+Zeile]) then
    begin
     result:=false;
     exit;
    end;
  end;
 if Rand[3*NGes+Zeile]>0 then
  begin
   Za:=0;
   Zi:=0;
   Ha:=0;
   Hi:=0;
   For I:=0 to NGes-1 do
    begin
     if (Feld[Zeile*NGes+I]=0) and
        (Ha<NGes) then
      begin
       inc(Ha);
       inc(Za);
      end;
     if (Feld[Zeile*NGes+I]=0) and
        (Hi<NGes) then
      begin
       Hi:=NGes;
       inc(Zi);
      end;
     if Feld[Zeile*NGes+I]>Ha then
      begin
       Ha:=Feld[Zeile*NGes+I];
       inc(Za);
      end;
     if Feld[Zeile*NGes+I]>Hi then
      begin
       Hi:=Feld[Zeile*NGes+I];
       inc(Zi);
      end;
    end;
   if (Zi>Rand[3*NGes+Zeile]) or (Za<Rand[3*NGes+Zeile]) then
    begin
     result:=false;
     exit;
    end;
  end;
 {$ENDIF}
end;
{$ENDIF}

{$IFNDEF preLoesung}
{$IFDEF alternativLoesung}
procedure TForm1.gesamtRaenderErzeugen;
var I,J,H,Z,Nullen,L: Integer;
    K,NullStelle:     Longint;
    Nums:             array of Integer;
    Verwendet:        array of Boolean;
    B:                Boolean;
begin
 if length(Maxima) = round(power(NGes+1,NGes)) then exit;
 Setlength(Maxima,round(power(NGes+1,NGes)));
 Setlength(Minima,round(power(NGes+1,NGes)));
 For K:=0 to length(Maxima)-1 do
  begin
   Maxima[K]:=NGes;
   Minima[K]:=1;
  end;
 Setlength(Nums,NGes);
 Setlength(Verwendet,NGes);
 For I:=0 to NGes-1 do
  Nums[I]:=1;

 repeat
  B:=True;
  For I:=0 to NGes-1 do
   begin
    B:=B and (Nums[I]<>0);
    For J:=0 to I-1 do
     B:=B and (Nums[I]<>Nums[J]);
   end;
  if B then
   begin
    K:=0;
    H:=0;
    Z:=0;
    For I:=0 to NGes-1 do
     begin
      K:=K*(NGes+1) + Nums[I];
      if Nums[I]>H then
       begin
        H:=Nums[I];
        inc(Z);
       end;
     end;
    Maxima[K]:=Z;
    Minima[K]:=Z;
   end;

  I:=0;
  repeat
   B:=true;
   inc(Nums[I]);
   if Nums[I]>NGes then
    begin
     Nums[I]:=1;
     inc(I);
     B:=false;
    end;
  until B or (I>=NGes);
 until (not B) and (I>=NGes);

 For Nullen:=1 to NGes do
  begin
   For I:=0 to NGes-1 do
    Nums[I]:=0;
   repeat
    L:=0;
    B:=True;
    For I:=0 to NGes-1 do
     begin
      if Nums[I]=0 then inc(L)
       else
        For J:=0 to I-1 do
         B:=B and (Nums[I]<>Nums[J]);
     end;

    if B and (L=Nullen) then
     begin
      K:=0;
      Nullstelle:=0;
      For I:=0 to NGes-1 do
       Verwendet[I]:=false;
      For I:=0 to NGes-1 do
       begin
        K:=K*(NGes+1) + Nums[I];
        Nullstelle:=Nullstelle*(NGes+1);
        if Nums[I] = 0 then Nullstelle:=1
                       else Verwendet[Nums[I]-1]:=true;
       end;
      Maxima[K]:=1;
      Minima[K]:=NGes;
      For I:=0 to NGes-1 do
       if not Verwendet[I] then
        begin
         if (K>=length(Maxima)) or (K+Nullstelle*(I+1) >= length(Maxima)) then
          halt;
         Maxima[K]:=max(Maxima[K],Maxima[K+Nullstelle*(I+1)]);
         Minima[K]:=min(Minima[K],Minima[K+Nullstelle*(I+1)]);
        end;
     end;

    I:=0;
    repeat
     B:=true;
     inc(Nums[I]);
     if Nums[I]>NGes then
      begin
       Nums[I]:=0;
       inc(I);
       B:=false;
      end;
    until B or (I>=NGes);
   until (not B) and (I>=NGes);
  end;
end;
{$ENDIF}
{$ENDIF}
{$ENDIF}

{$IFDEF preLoesung}
procedure TForm1.gesamtRaenderErzeugen;
var I,J,K,Nullen:      Integer;
    {$IFNDEF Buchstabenraetsel}
    AZ,
    {$ENDIF}
    AR:                Integer;
    AK,EK,NAK,NEK:     Longint;
    Nums:              TIntArray;
    B:                 Boolean;
    Basis,Faktor:      Integer;
    Schritt:           Longint;
    {$IFDEF debugFileExport}
    F:                 Textfile;
    S:                 String;
    {$ENDIF}
    {$IFDEF datei}
    dat:               File of Cardinal;
    lw1,lw2,L:         Cardinal;
    {$ENDIF}
function calcNums(I: Longint): TIntArray;
var J: Integer;
begin
 Setlength(Result,NGes);
 For J:=0 to NGes-1 do
  begin
   Result[J]:=I mod Basis;
   I:=I div Basis;
  end;
end;

function calcIndex(Nums: TIntArray): Longint;
var J: Integer;
begin
 Result:=0;
 For J:=0 to NGes-1 do
  Result:=Result*Basis + Nums[NGes-J-1];
end;

function swapIndex(I: Longint): Longint;
var J: Integer;
begin
 Result:=0;
 For J:=0 to NGes-1 do
  begin
   Result:=Result*Basis+(I mod Basis);
   I:=I div Basis;
  end;
end;

begin
 {$IFDEF Buchstabenraetsel}
 Basis:=NBuchst+2;
 Faktor:=NBuchst+1;
 {$ELSE}
 Basis:=NGes+1;
 Faktor:=NGes+1;
 {$ENDIF}
 AK:=round(power(Basis,NGes)*Faktor);

 if (length(AMoeglich) = AK) and
    (length(EMoeglich) = AK) then exit;

 {$IFDEF datei}
 if fileexists(extractfilepath(application.exename)+dat_name) then
  begin
   assignfile(dat,extractfilepath(application.exename)+dat_name);
   reset(dat);
   while not eof(dat) do
    begin
     read(dat,lw1);
     if lw1=AK then
      begin
       Setlength(AMoeglich,AK);
       Setlength(EMoeglich,AK);
       For L:=0 to length(AMoeglich)-1 do
        begin
         if L mod 32 = 0 then
          if not eof(dat) then
           read(dat,lw2)
            else
           begin
            messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
            exit;
           end;
         AMoeglich[L]:=odd(lw2 shr (L mod 32));  
        end;
       For L:=0 to length(EMoeglich)-1 do
        begin
         if L mod 32 = 0 then
          if not eof(dat) then
           read(dat,lw2)
            else
           begin
            messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
            exit;
           end;
         EMoeglich[L]:=odd(lw2 shr (L mod 32));  
        end;
       exit;
      end
       else
      Seek(dat,Filepos(dat)+((lw1-1) div 32 +1)*2);
    end;
   closefile(dat);
  end;
 {$ENDIF}

 Progressbar1.Visible:=true;
 Progressbar1.Min:=0;
 Progressbar1.Max:=1000;
 Progressbar1.Position:=0;
    
 Setlength(AMoeglich,AK);
 Setlength(EMoeglich,AK);
 For AK:=0 to length(AMoeglich)-1 do
  begin
   AMoeglich[AK]:=False;
   EMoeglich[AK]:=False;
  end;
 Setlength(Nums,0); 

 Schritt:=max(1,round((length(AMoeglich) div Faktor) / Progressbar1.Max));
 For AK:=0 to length(AMoeglich) div Faktor -1 do
  begin
   if AK mod Schritt = 0 then
    Progressbar1.StepIt;
   Nums:=calcNums(AK);
   B:=true;
   {$IFDEF Buchstabenraetsel}
   Nullen:=NLeer;
   For I:=0 to length(Nums)-1 do
    begin
     B:=B and (Nums[I]<>0);
     if Nums[I]=1 then dec(Nullen)
      else
       For J:=0 to I-1 do
        B:=B and (Nums[I]<>Nums[J]);
    end;
   B:=B and (Nullen>=0);
   {$ELSE}
   For I:=0 to length(Nums)-1 do
    begin
     B:=B and (Nums[I]<>0);
     For J:=0 to I-1 do
      B:=B and (Nums[I]<>Nums[J]);
    end;
   {$ENDIF}
   if B then
    begin
     EK:=swapIndex(AK);
     AR:=0;
     {$IFNDEF Buchstabenraetsel}
     AZ:=0;
     {$ENDIF}
     For I:=0 to NGes-1 do
      begin
       {$IFDEF Buchstabenraetsel}
       if Nums[I]>1 then
        begin
         AR:=Nums[I]-1;
         break;
        end;
       {$ELSE}
       if Nums[I]>AZ then
        begin
         inc(AR);
         AZ:=Nums[I];
        end;
       {$ENDIF}
      end;

     AMoeglich[AK*Faktor+AR]:=true;
     EMoeglich[EK*Faktor+AR]:=true;
     AMoeglich[AK*Faktor]:=true;
     EMoeglich[EK*Faktor]:=true;
    end;
  end;

 Progressbar1.Position:=0;
 Schritt:=Max(round(((length(AMoeglich) div Faktor)*NGes) / Progressbar1.Max),1);
 For Nullen:=1 to NGes do
  For AK:=0 to length(AMoeglich) div Faktor -1 do
   begin
    if AK mod Schritt = 0 then
     Progressbar1.StepIt;
    Nums:=calcNums(AK);
    J:=Nullen;
    For I:=0 to NGes-1 do
     if Nums[I]=0 then dec(J);
    if J<>0 then continue;
    EK:=swapIndex(AK);
    For I:=0 to NGes-1 do
     if Nums[I]=0 then
      begin
       For J:=1 to Basis-1 do
        begin
         Nums[I]:=J;
         NAK:=calcIndex(Nums);
         NEK:=swapIndex(NAK);
         For K:=0 to Faktor-1 do
          begin
           AMoeglich[AK*Faktor+K]:=AMoeglich[AK*Faktor+K] or AMoeglich[NAK*Faktor+K];
           EMoeglich[EK*Faktor+K]:=EMoeglich[EK*Faktor+K] or EMoeglich[NEK*Faktor+K];
          end;
        end;
       break;
      end;
   end;
 Progressbar1.Visible:=False;

 {$IFDEF datei}
 assignfile(dat,extractfilepath(application.exename)+dat_name);
 if Fileexists(extractfilepath(application.exename)+dat_name) then
  begin
   reset(dat);
   Seek(dat,Filesize(dat));
  end
   else
  Rewrite(dat);

 lw1:=length(AMoeglich);
 write(dat,lw1);
 lw1:=0;
 For I:=0 to length(AMoeglich)-1 do
  begin
   lw1:=lw1 or (Byte(AMoeglich[I]) shl (I mod 32));
   if ((I mod 32) = 31) or (I = length(AMoeglich)-1) then
    begin
     write(dat,lw1);
     lw1:=0;
    end;
  end;
 For I:=0 to length(EMoeglich)-1 do
  begin
   lw1:=lw1 or (Byte(EMoeglich[I]) shl (I mod 32));
   if ((I mod 32) = 31) or (I = length(EMoeglich)-1) then
    begin
     write(dat,lw1);
     lw1:=0;
    end;
  end;
 closefile(dat);
 {$ENDIF}

 {$IFDEF debugFileExport}
 Assignfile(F,'Test.txt');
 Rewrite(F);
 J:=0;
 For AK:=0 to length(AMoeglich) div Faktor -1 do
  begin
   S:='';
   B:=False;
   Nums:=calcNums(AK);
   For I:=0 to length(Nums)-1 do
    S:=S+inttostr(Nums[I]);
   S:=S+#9;
   For I:=0 to Faktor-1 do
    begin
     S:=S+Char(Byte(AMoeglich[AK*Faktor+I])*(ord('x')-ord('.'))+ord('.'));
     B:=B or AMoeglich[AK*Faktor+I];
    end;
   S:=S+#9;
   For I:=0 to Faktor-1 do
    begin
     S:=S+Char(Byte(EMoeglich[AK*Faktor+I])*(ord('x')-ord('.'))+ord('.'));
     B:=B or EMoeglich[AK*Faktor+I];
    end;
   if B then
    begin
     Writeln(F,S);
     inc(J);
    end;
  end;
 Writeln(F,J);
 Closefile(F);
 {$ENDIF}
end;
{$ENDIF}

procedure TForm1.preStart;
begin
 Spinedit1.Enabled:=false;
 Spinedit3.Enabled:=false;
{$IFDEF Buchstabenraetsel}
 Spinedit2.Enabled:=false;
{$ENDIF}
 Checkbox1.Enabled:=false;
 Checkbox2.Enabled:=false;
 Button2.Enabled:=true;
 Button3.Enabled:=true;
 {$IFDEF Speichermoegl}
 Button4.Enabled:=true;
 {$ENDIF}
 RandSeed:=Spinedit3.Value;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Leertaste_aktiviert>=(now-1/24/60/60) then exit;
 if not Spinedit1.Enabled then
  begin
   {$IFNDEF keinRandomize}
   randomize;
   {$ENDIF}
   Spinedit3.Value:=random(Spinedit3.maxValue+1);
  end;
 Spinedit1.OnChange(Sender);
 preStart;
{$IFDEF preLoesung}
 gesamtRaenderErzeugen;
{$ENDIF}
 loesen(-1);
 RandErzeugen;
 leeren;
 Zeichnen;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if Leertaste_aktiviert>=(now-1/24/60/60) then exit;
 Spinedit1.Enabled:=true;
 Spinedit3.Enabled:=true;
{$IFDEF Buchstabenraetsel}
 Spinedit2.Enabled:=true;
{$ENDIF}
 Checkbox1.Enabled:=true;
 Checkbox2.Enabled:=sqr(NSqrt)=NGes;
 Button1.Enabled:=true;
 Button2.Enabled:=false;
 Button3.Enabled:=false;
 {$IFDEF Speichermoegl}
 Button4.Enabled:=false;
 {$ENDIF}
 {$IFNDEF keinRandomize}
 Randomize;
 {$ENDIF}
 Spinedit3.Value:=random(Spinedit3.MaxValue+1);
 Spinedit1.OnChange(Sender);
end;

procedure TForm1.Button3Click(Sender: TObject);
var I: integer;
begin
 if Leertaste_aktiviert>=(now-1/24/60/60) then exit;
 For I:=0 to length(Feld)-1 do
  if not Startfeld[I] then
   {$IFDEF Buchstabenraetsel}
   Feld[I]:=-1;
   {$ELSE}
   Feld[I]:=0;
   {$ENDIF}
 aktuelleFarbe:=$000000;
 letzteFarbe:=aktuelleFarbe;
 Setlength(Zuege,0);
 Zeichnen;
 Image2Bemalen;
end;

{$IFDEF Speichermoegl}
procedure TForm1.Button4Click(Sender: TObject);
var F: TRaetselFile;
    C: Cardinal;
begin
 if Leertaste_aktiviert>=(now-1/24/60/60) then exit;
 repeat
  if not Savedialog1.Execute then exit;
  {$IFDEF Buchstabenraetsel}
  if uppercase(copy(SaveDialog1.FileName,length(SaveDialog1.FileName)-3,4))<>'.BSR' then
   SaveDialog1.FileName:=SaveDialog1.FileName+'.bsr';
  {$ELSE}
  if uppercase(copy(SaveDialog1.FileName,length(SaveDialog1.FileName)-3,4))<>'.HHR' then
   SaveDialog1.FileName:=SaveDialog1.FileName+'.hhr';
  {$ENDIF}
  if fileexists(SaveDialog1.FileName) then
   case Messagedlg('Die Datei existiert schon. Überschreiben?',mtConfirmation,[mbYes,mbNo,mbAbort],0) of
    mrYes: break;
    mrAbort: exit;
   end{of Case}
    else
   break;
 until false;
 F:=TRaetselFile.Create;
 F.Kennung:=dat_Kennung;
 F.FAssignFile(SaveDialog1.FileName);
 F.FRewrite;
 C:=ProgVers;
 F.FBlockWrite(C,1);
 C:=Byte(Checkbox1.Checked);
 F.FBlockWrite(C,1);
 {$IFDEF Buchstabenraetsel}
 C:=Spinedit2.Value;
 F.FBlockWrite(C,4);
 {$ENDIF}
 C:=Spinedit1.Value;
 F.FBlockWrite(C,4);
 C:=Spinedit3.Value;
 F.FBlockWrite(C,4);
 if length(Rand)>0 then
  F.FBlockWrite(Rand[0],length(Rand)*sizeof(Rand[0]));
 if length(Feld)>0 then
  F.FBlockWrite(Feld[0],length(Feld)*sizeof(Feld[0]));
 if length(FeldFarben)>0 then
  F.FBlockWrite(FeldFarben[0],length(FeldFarben)*sizeof(FeldFarben[0]));
 if length(StartFeld)>0 then
  F.FBlockWrite(StartFeld[0],length(StartFeld)*sizeof(StartFeld[0]));
 F.FBlockWrite(Position,4);
 C:=length(Zuege);
 F.FBlockWrite(C,4);
 if length(Zuege)>0 then
  F.FBlockWrite(Zuege[0],length(Zuege)*SizeOf(Zuege[0]));
 F.FCloseFile;
end;

procedure TForm1.Button5Click(Sender: TObject);
var F: TRaetselFile;
    C: Cardinal;
begin
 if Leertaste_aktiviert>=(now-1/24/60/60) then exit;
 if (Opendialog1.Tag=0) and (not Opendialog1.Execute) then exit;
 Opendialog1.Tag:=0;
 F:=TRaetselFile.Create;
 F.Kennung:=dat_Kennung;
 F.FAssignFile(OpenDialog1.FileName);
 if not F.FReset then
  begin
   Messagedlg('Ungültiges Dateiformat!',mtError,[mbOk],0);
   exit;
  end;
 C:=0;
 if not F.FBlockRead(C,1) then exit;
 if C>ProgVers then
  begin
   Messagedlg(
    'Diese Programmversion ('+Vers2Str(ProgVers)+') ist nicht mit der '+
    'ausgewählten Dateiversion ('+Vers2Str(C)+') kompatibel!',mterror,[mbOk],0);
   exit;
  end;
 if not F.FBlockRead(C,1) then exit;
 Checkbox1.Checked:=odd(C);
 {$IFDEF Buchstabenraetsel}
 if not F.FBlockRead(C,4) then exit;
 Spinedit2.Value:=C;
 {$ENDIF}
 if not F.FBlockRead(C,4) then exit;
 Spinedit1.Value:=C;
 if not F.FBlockRead(C,4) then exit;
 Spinedit3.Value:=C;
 if length(Rand)>0 then
  if not F.FBlockRead(Rand[0],length(Rand)*sizeof(Rand[0])) then exit;
 if length(Feld)>0 then
  if not F.FBlockRead(Feld[0],length(Feld)*sizeof(Feld[0])) then exit;
 if length(FeldFarben)>0 then
  if not F.FBlockRead(FeldFarben[0],length(FeldFarben)*sizeof(FeldFarben[0])) then exit;
 if length(StartFeld)>0 then
  if not F.FBlockRead(StartFeld[0],length(StartFeld)*sizeof(StartFeld[0])) then exit;
 if not F.FBlockRead(Position,4) then exit;
 if not F.FBlockRead(C,4) then exit;
 Setlength(Zuege,C);
 if length(Zuege)>0 then
  if not F.FBlockRead(Zuege[0],length(Zuege)*SizeOf(Zuege[0])) then exit;
 F.FCloseFile;
 preStart;       
 gesamtRaenderErzeugen;
 Zeichnen;
end;
{$ENDIF}

{$IFDEF Buchstabenraetsel}
function  TForm1.loesen(lPos: integer): boolean;
var I,P:  integer;
    Perm: TIntArray;
begin
 result:=false;
 setlength(Perm,0);
 For P:=lPos+1 to NGes*NGes-1 do
  if Feld[P]<0 then
   begin
    Perm:=Permutation(NBuchst+1);
    For I:=0 to NBuchst do
     begin
      Feld[P]:=Perm[I];
      if passt(P mod NGes,P div NGes) then
       if loesen(P) then
        begin
         result:=true;
         exit;
        end;
     end;
    Feld[P]:=-1;
    exit;
   end;
 result:=true;
end;

function  TForm1.AnzLoesungen(lPos: integer): integer;
var I,P: integer;
begin
 result:=0;
 For P:=lPos+1 to NGes*NGes-1 do
  if Feld[P]<0 then
   begin
    For I:=0 to NBuchst do
     begin
      Feld[P]:=I;
      if passt(P mod NGes,P div NGes) then
       result:=result+Anzloesungen(P);
      {$IFDEF loesungsoptimierung}
      if result>=2 then
       begin
        Feld[P]:=-1;
        exit;
       end;
      {$ENDIF}
     end;
    Feld[P]:=-1;
    exit;
   end;
 result:=1;
end;
{$ELSE}
function  TForm1.loesen(lPos: integer): boolean;
var I,P:  integer;
    Perm: TIntArray;
begin
 result:=false;
 setlength(Perm,0);
 For P:=lPos+1 to NGes*NGes-1 do
  if Feld[P]=0 then
   begin
    Perm:=Permutation(NGes);
    For I:=0 to NGes-1 do
     begin
      Feld[P]:=Perm[I]+1;
      if passt(P mod NGes,P div NGes) then
       if loesen(P) then
        begin
         result:=true;
         exit;
        end;
     end;
    Feld[P]:=0;
    exit;
   end;
 result:=true;
end;

function  TForm1.AnzLoesungen(lPos: integer): integer;
var I,P: integer;
begin
 result:=0;
 For P:=lPos+1 to NGes*NGes-1 do
  if Feld[P]=0 then
   begin
    For I:=0 to NGes-1 do
     begin
      Feld[P]:=I+1;
      if passt(P mod NGes,P div NGes) then
       result:=result+Anzloesungen(P);
      {$IFDEF loesungsoptimierung}
      if result>=2 then
       begin
        Feld[P]:=0;
        exit;
       end;
      {$ENDIF}
     end;
    Feld[P]:=0;
    exit;
   end;
 result:=1;
end;
{$ENDIF}

procedure TForm1.leeren;
var Perm:  TIntArray;
    tmp,i: integer;
{$IFDEF debug}
    anz,ges: integer;
    start,
    ende:  double;
{$ENDIF}
begin
 Progressbar1.Position:=0;
 Progressbar1.Max:=(NGes+4)*NGes-1;
 Progressbar1.Width:=Form1.ClientWidth-Progressbar1.Left;
 Progressbar1.Visible:=true;
 setlength(Perm,0);
 Perm:=Permutation(NGes*NGes);
 {$IFDEF debug}
 ges:=0;
 start:=now;
 {$ENDIF}
 {$IFDEF Buchstabenraetsel}            
 For I:=0 to NGes*NGes-1 do
  if Feld[Perm[I]]=0 then
   begin
    Feld[Perm[I]]:=-1;
    {$IFDEF debug}
    anz:=AnzLoesungen(-1);
    ges:=ges+anz-1;
    if anz>1 then
    {$ELSE}
    if AnzLoesungen(-1)>1 then
    {$ENDIF}
     Feld[Perm[I]]:=0
      else
     Startfeld[Perm[I]]:=false;
   end;
 {$ELSE}
 {$IFDEF alternativLoesung}
 gesamtRaenderErzeugen;
 {$ENDIF}
 {$ENDIF}
 {$IFDEF preLoesung}
 gesamtRaenderErzeugen;
 {$ENDIF}
 For I:=0 to NGes*NGes-1 do
  begin
   if Feld[Perm[I]]>0 then
    begin
     tmp:=Feld[Perm[I]];
     {$IFDEF Buchstabenraetsel}
     Feld[Perm[I]]:=-1;
     {$ELSE}
     Feld[Perm[I]]:=0;
     {$ENDIF}
     {$IFDEF debug}
     anz:=AnzLoesungen(-1);
     ges:=ges+anz-1;
     if anz>1 then
     {$ELSE}
     if AnzLoesungen(-1)>1 then
     {$ENDIF}
      Feld[Perm[I]]:=tmp
       else
      Startfeld[Perm[I]]:=false;
    end;
   Progressbar1.StepIt;
   Application.ProcessMessages;
  end;
 Perm:=Permutation(4*NGes);
 For I:=0 to 4*NGes-1 do
  begin
   if Rand[Perm[I]]<>0 then
    begin
     tmp:=Rand[Perm[I]];
     Rand[Perm[I]]:=0;
     {$IFDEF debug}
     anz:=AnzLoesungen(-1);
     ges:=ges+anz-1;
     if anz>1 then
     {$ELSE}
     if AnzLoesungen(-1)>1 then
     {$ENDIF}
      Rand[Perm[I]]:=tmp;
    end;
   Progressbar1.Stepit;
   Application.ProcessMessages;
  end;
 Progressbar1.Visible:=False;
 {$IFDEF debug}
 ende:=now;
 Messagedlg(floattostr((ende-start)*24*3600)+' Sekunden und'#13+
            inttostr(ges)+' zusäzliche Möglichkeiten!',mtinformation,[mbok],0);
 {$ENDIF}
end;

function  Permutation(n: integer): TIntArray;
var I,J,K: Integer;
begin
 setlength(Result,n);
 For I:=0 to n-1 do
  Result[I]:=-1;
 For I:=0 to n-1 do
  begin
   J:=random(n-I);
   K:=0;
   while K<=J do
    begin
     if Result[K]<>-1 then inc(J);
     inc(K);
    end;
   Result[J]:=I;
  end;
end;

{$IFDEF Buchstabenraetsel}
procedure TForm1.RandErzeugen;
var I,J: Integer;
begin
 For I:=0 to NGes-1 do
  begin
   For J:=0 to NGes-1 do
    begin
     if Feld[I+NGes*J]=-1 then break;
     if Feld[I+NGes*J]=0 then continue;
     Rand[I]:=Feld[I+NGes*J];
     break;
    end;
   For J:=NGes-1 downto 0 do
    begin
     if Feld[I+NGes*J]=-1 then break;
     if Feld[I+NGes*J]=0 then continue;
     Rand[2*NGes+I]:=Feld[I+NGes*J];
     break;
    end;
   For J:=NGes-1 downto 0 do
    begin
     if Feld[J+NGes*I]=-1 then break;
     if Feld[J+NGes*I]=0 then continue;
     Rand[NGes+I]:=Feld[J+NGes*I];
     break;
    end;
   For J:=0 to NGes-1 do
    begin
     if Feld[J+NGes*I]=-1 then break;
     if Feld[J+NGes*I]=0 then continue;
     Rand[3*NGes+I]:=Feld[J+NGes*I];
     break;
    end;
  end;
end;
{$ELSE}
procedure TForm1.RandErzeugen;
var I,J,H,Z: Integer;
begin
 For I:=0 to NGes-1 do
  begin
   H:=0;
   Z:=0;
   For J:=0 to NGes-1 do
    begin
     if Feld[I+NGes*J]=-1 then
      begin
       Z:=0;
       break;
      end;
     if Feld[I+NGes*J]>H then
      begin
       H:=Feld[I+NGes*J];
       inc(Z);
      end;
    end;
   Rand[I]:=Z;
   H:=0;
   Z:=0;
   For J:=NGes-1 downto 0 do
    begin
     if Feld[I+NGes*J]=-1 then
      begin
       Z:=0;
       break;
      end;
     if Feld[I+NGes*J]>H then
      begin
       H:=Feld[I+NGes*J];
       inc(Z);
      end;
    end;
   Rand[2*NGes+I]:=Z;
   H:=0;
   Z:=0;
   For J:=NGes-1 downto 0 do
    begin
     if Feld[J+NGes*I]=-1 then
      begin
       Z:=0;
       break;
      end;
     if Feld[J+NGes*I]>H then
      begin
       H:=Feld[J+NGes*I];
       inc(Z);
      end;
    end;
   Rand[NGes+I]:=Z;
   H:=0;
   Z:=0;
   For J:=0 to NGes-1 do
    begin
     if Feld[J+NGes*I]=-1 then
      begin
       Z:=0;
       break;
      end;
     if Feld[J+NGes*I]>H then
      begin
       H:=Feld[J+NGes*I];
       inc(Z);
      end;
    end;
   Rand[3*NGes+I]:=Z;
  end;
end;
{$ENDIF}

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key=32 then
  Leertaste_aktiviert:=now;
end;

procedure TForm1.Image2Bemalen;
var I: Integer;
begin
 Image2.Canvas.Pen.Color:=aktuelleFarbe;
 Image2.Canvas.Brush.Color:=aktuelleFarbe;
 Image2.Canvas.Rectangle(0,0,Image2.Width,Image2.Height div 2);
 For I:=0 to Image2.Width do
  begin
   Image2.Canvas.Pen.Color:=farbverlauf(I/(Image2.Width+1));
   Image2.Canvas.Moveto(I,Image2.Height div 2);
   Image2.Canvas.Lineto(I,Image2.Height);
  end;
end;

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;

procedure TForm1.FormResize(Sender: TObject);
begin
 Spinedit3.Left:=Form1.ClientWidth-Spinedit3.Width;
 Progressbar1.Width:=Form1.ClientWidth;
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;

procedure TForm1.Image1DblClick(Sender: TObject);
begin
 if Startfeld[Position] or
    (Feld[Position]<0)
    {$IFNDEF Buchstabenraetsel}
    or (Feld[Position]=0)
    {$ENDIF}
  then exit;
 aktuelleFarbe:=FeldFarben[Position];
 letzteFarbe:=aktuelleFarbe;
 Image2Bemalen;
end;

end.