diff options
Diffstat (limited to 'ori_Unit1.pas')
| -rw-r--r-- | ori_Unit1.pas | 2384 |
1 files changed, 0 insertions, 2384 deletions
diff --git a/ori_Unit1.pas b/ori_Unit1.pas deleted file mode 100644 index b05de6b..0000000 --- a/ori_Unit1.pas +++ /dev/null @@ -1,2384 +0,0 @@ -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.
|