diff options
| -rw-r--r-- | RaetselFileUnit.pas | 274 | ||||
| -rw-r--r-- | ori_Unit1.pas | 2384 | ||||
| -rw-r--r-- | raetsel.lpr | 8 | ||||
| -rw-r--r-- | raetsel.lps | 117 | ||||
| -rw-r--r-- | raetselFileUnit.pas | 274 | ||||
| -rw-r--r-- | raetselunit.inc | 529 | ||||
| -rw-r--r-- | raetselunit.pas | 276 | ||||
| -rw-r--r-- | unit1.pas | 16 | ||||
| -rw-r--r-- | unit2.pas | 8 |
9 files changed, 478 insertions, 3408 deletions
diff --git a/RaetselFileUnit.pas b/RaetselFileUnit.pas deleted file mode 100644 index 1a389ab..0000000 --- a/RaetselFileUnit.pas +++ /dev/null @@ -1,274 +0,0 @@ -unit raetselFileUnit;
-
-interface
-
- uses
- dialogs, math;
-
- type
- tWort = record
- w: array of byte;
- bits: integer;
- end;
- tRaetselFile = class
- private
- f: file;
- wacc: boolean;
- inhalt,
- conv: array of byte;
- fPoint: integer;
- wB: array of tWort;
- procedure fFlush;
- procedure initWB;
- procedure concatWs(a,b: integer);
- function bIsAX(a: tWort; b: array of byte): boolean;
- procedure rConvert;
- procedure wConvert;
- public
- kennung: string;
- procedure fAssignFile(fileName: string);
- function fReset: boolean;
- procedure fRewrite;
- procedure fCloseFile;
- procedure fBlockWrite(var data; len: integer);
- function fBlockRead(var data; len: integer): boolean;
- end;
-
-implementation
-
-procedure tRaetselFile.fAssignFile(FileName: string);
-begin
- assignFile(f,fileName);
-end;
-
-function tRaetselFile.fReset: boolean;
-var
- c: cardinal;
- s: string;
-begin
- wacc:=false;
- result:=false;
- c:=0;
- reset(f,1);
- if fileSize(f) < 4 then begin
- fCloseFile;
- exit;
- end;
- blockRead(f,c,4);
- if c<>$26594131 then begin
- fCloseFile;
- exit;
- end;
- setLength(conv,fileSize(f)-4);
- blockRead(f,conv[0],length(conv));
- rConvert;
- if length(inhalt)<length(kennung) then begin
- fCloseFile;
- exit;
- end;
- s:=kennung;
- fBlockRead(s[1],length(s));
- if s<>kennung then begin
- fCloseFile;
- exit;
- end;
- result:=true;
-end;
-
-procedure tRaetselFile.initWB;
-var
- b: byte;
-begin
- setLength(wB,128);
- for b:=0 to 127 do begin
- setLength(wB[b].w,2);
- wB[b].w[0]:=b;
- wB[b].w[1]:=0;
- wB[b].bits:=7;
- end;
-end;
-
-procedure tRaetselFile.concatWs(a,b: integer);
-var
- i: integer;
-begin
- setLength(wB,length(wB)+1); // wB erweitern
- with wB[length(wB)-1] do begin
- bits:=wB[a].bits+wB[b].bits;
- setLength(w,(bits+7) div 8 + 1);
- for i:=0 to length(w)-1 do
- w[i]:=0;
- for i:=0 to length(wB[a].w)-2 do
- w[i]:=wB[a].w[i];
- for i:=0 to length(wB[b].w)-2 do begin
- w[length(wB[a].w)-2+i]:=
- w[length(wB[a].w)-2+i] or
- ($ff and (wB[b].w[i] shl (wB[a].bits mod 8)));
- if length(wB[a].w)-1+i < length(w) then
- w[length(wB[a].w)-1+i]:=
- w[length(wB[a].w)-1+i] or
- (wB[b].w[i] shr (8 - (wB[a].bits mod 8)));
- end;
- end;
-end;
-
-function tRaetselFile.bIsAX(A: tWort; b: array of byte): boolean;
-var
- i: integer;
-begin
- result:=true;
- for i:=0 to (A.bits div 8)-1 do
- result:=result and (A.w[i] = b[i]);
- result:=result and ((A.w[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))) =
- (b[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))));
-end;
-
-procedure tRaetselFile.rConvert;
-var
- rP: longint;
- wP,i: integer;
- passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(inhalt,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=0;
- while rP<((length(conv)-1)*8) do begin
- passt:=0;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin
- passt:=passt or (byte(odd(conv[rP div 8] shr (rP mod 8))) shl i);
- inc(rP);
- end;
- for i:=0 to wB[passt].bits-1 do begin
- if wP=8 then begin
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or (byte(odd((wB[passt].w[i div 8] shr (i mod 8)))) shl wP);
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.wConvert;
-var
- rP: longint;
- wP,i,j: integer;
- rBuff: array of byte;
- rBBits,passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(conv,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=0;
- while rP<((length(inhalt)-1)*8) do begin
- setLength(rBuff,0);
- rBBits:=0;
- passt:=-1;
- for i:=length(wB)-1 downto 0 do
- with wB[i] do begin
- if bits > (8*length(inhalt) - rP) then continue;
- if bits > rBBits then begin // mehr r-buffern
- setLength(rBuff,(bits+7) div 8);
- rBBits:=bits;
- for j:=0 to length(rBuff)-1 do begin
- rBuff[j]:=0;
- if j + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or (inhalt[j + rP div 8] shr (rP mod 8));
- if j+1 + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or ($ff and (inhalt[(rP div 8) + j+1] shl (8-(rP mod 8))));
- end;
- end;
- if ((passt=-1) or (wB[passt].bits < wB[i].bits)) and
- bIsAX(wB[i],rBuff) then
- passt:=i;
- end;
- if passt=-1 then begin // geht ja gar nicht - geht ja wohl!
- messageDlg('Zu wenig wörter im wörterbuch!',mterror,[mbOk],0);
- exit;
- end;
- rP:=rP+wB[passt].bits;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin // wB-index speichern
- if wP=8 then begin // w-buffer leeren
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or byte(odd(passt shr i)) shl wP;
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.fFlush;
-begin
- wConvert;
- blockWrite(f,conv[0],length(conv));
- setLength(inhalt,0);
-end;
-
-procedure tRaetselFile.fRewrite;
-var
- c: cardinal;
-begin
- wacc:=true;
- rewrite(f,1);
- c:=$26594131;
- blockWrite(f,c,4);
- setLength(inhalt,length(kennung));
- move(kennung[1],inhalt[0],length(kennung));
- fPoint:=length(inhalt);
-end;
-
-procedure tRaetselFile.fCloseFile;
-begin
- if wacc then begin
- fFlush;
- closeFile(f);
- end;
- setLength(inhalt,0);
- fPoint:=0;
-end;
-
-procedure tRaetselFile.fBlockWrite(var data; len: integer);
-begin
- setLength(inhalt,length(inhalt)+len);
- move(data,inhalt[fPoint],len);
- fPoint:=length(inhalt);
-end;
-
-function tRaetselFile.fBlockRead(var data; len: integer): boolean;
-begin
- result:=len<=(length(inhalt)-fPoint);
- if not result then begin
- fCloseFile;
- exit;
- end;
- move(inhalt[fPoint],data,len);
- fPoint:=fPoint+len;
-end;
-
-end.
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.
diff --git a/raetsel.lpr b/raetsel.lpr index a9538ec..672f9ca 100644 --- a/raetsel.lpr +++ b/raetsel.lpr @@ -12,9 +12,9 @@ uses {$R *.res} begin - RequireDerivedFormResource:=True; - Application.Initialize; - Application.CreateForm(TForm1, Form1); - Application.Run; + requireDerivedFormResource:=true; + application.initialize; + application.createForm(tForm1, form1); + application.run; end. diff --git a/raetsel.lps b/raetsel.lps index cf560a8..e0413a6 100644 --- a/raetsel.lps +++ b/raetsel.lps @@ -8,8 +8,8 @@ <Filename Value="raetsel.lpr"/> <IsPartOfProject Value="True"/> <EditorIndex Value="2"/> - <CursorPos X="47" Y="11"/> - <UsageCount Value="61"/> + <CursorPos X="66" Y="13"/> + <UsageCount Value="62"/> <Loaded Value="True"/> </Unit0> <Unit1> @@ -18,7 +18,9 @@ <ComponentName Value="Form1"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <UsageCount Value="61"/> + <TopLine Value="19"/> + <CursorPos X="43" Y="16"/> + <UsageCount Value="62"/> <Loaded Value="True"/> </Unit1> <Unit2> @@ -29,26 +31,26 @@ <ResourceBaseClass Value="Form"/> <UnitName Value="Unit2"/> <EditorIndex Value="-1"/> - <CursorPos Y="17"/> - <UsageCount Value="60"/> + <CursorPos X="11" Y="27"/> + <UsageCount Value="61"/> </Unit2> <Unit3> <Filename Value="raetselunit.pas"/> <IsPartOfProject Value="True"/> <IsVisibleTab Value="True"/> <EditorIndex Value="1"/> - <TopLine Value="332"/> - <CursorPos Y="332"/> - <UsageCount Value="55"/> + <TopLine Value="812"/> + <CursorPos X="50" Y="844"/> + <UsageCount Value="56"/> <Loaded Value="True"/> </Unit3> <Unit4> <Filename Value="raetselunit.inc"/> <IsPartOfProject Value="True"/> <EditorIndex Value="3"/> - <TopLine Value="437"/> - <CursorPos X="33" Y="100"/> - <UsageCount Value="41"/> + <TopLine Value="373"/> + <CursorPos X="27" Y="392"/> + <UsageCount Value="42"/> <Loaded Value="True"/> </Unit4> <Unit5> @@ -87,11 +89,10 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <UnitName Value="Unit1"/> - <EditorIndex Value="4"/> + <EditorIndex Value="-1"/> <TopLine Value="2341"/> <CursorPos X="13" Y="2380"/> <UsageCount Value="21"/> - <Loaded Value="True"/> </Unit10> <Unit11> <Filename Value="/usr/share/lazarus/lcl/stdctrls.pp"/> @@ -157,122 +158,122 @@ <JumpHistory Count="30" HistoryIndex="29"> <Position1> <Filename Value="raetselunit.pas"/> - <Caret Line="240" Column="42" TopLine="217"/> + <Caret Line="511" Column="82" TopLine="495"/> </Position1> <Position2> - <Filename Value="raetselunit.pas"/> - <Caret Line="234" Column="29" TopLine="217"/> + <Filename Value="unit1.pas"/> + <Caret Line="40" Column="19" TopLine="32"/> </Position2> <Position3> - <Filename Value="raetselunit.pas"/> - <Caret Line="59" Column="21" TopLine="39"/> + <Filename Value="unit1.pas"/> + <Caret Line="16" Column="41"/> </Position3> <Position4> - <Filename Value="raetselunit.pas"/> - <Caret Line="93" Column="21" TopLine="57"/> + <Filename Value="unit1.pas"/> + <Caret Line="17" Column="42"/> </Position4> <Position5> - <Filename Value="raetselunit.pas"/> - <Caret Line="326" Column="4" TopLine="305"/> + <Filename Value="unit1.pas"/> + <Caret Line="18" Column="39"/> </Position5> <Position6> - <Filename Value="raetselunit.pas"/> - <Caret Line="328" Column="36" TopLine="305"/> + <Filename Value="unit1.pas"/> + <Caret Line="46" Column="44" TopLine="13"/> </Position6> <Position7> <Filename Value="unit1.pas"/> - <Caret Line="52" TopLine="28"/> + <Caret Line="67" Column="45" TopLine="34"/> </Position7> <Position8> - <Filename Value="raetselunit.pas"/> - <Caret Line="327" Column="3" TopLine="306"/> + <Filename Value="unit1.pas"/> + <Caret Line="72" Column="42" TopLine="39"/> </Position8> <Position9> <Filename Value="raetselunit.pas"/> - <Caret Line="35" Column="39" TopLine="19"/> + <Caret Line="824" Column="55" TopLine="808"/> </Position9> <Position10> - <Filename Value="raetselunit.pas"/> - <Caret Line="331" Column="43" TopLine="308"/> + <Filename Value="raetselunit.inc"/> + <Caret Line="766" Column="55" TopLine="758"/> </Position10> <Position11> <Filename Value="raetselunit.pas"/> - <Caret Line="330" Column="14" TopLine="309"/> + <Caret Line="555" Column="43" TopLine="547"/> </Position11> <Position12> <Filename Value="raetselunit.pas"/> - <Caret Line="35" Column="49"/> + <Caret Line="566" Column="21" TopLine="547"/> </Position12> <Position13> - <Filename Value="unit1.pas"/> - <Caret Line="59" Column="25" TopLine="35"/> + <Filename Value="raetsel.lpr"/> + <Caret Line="13" Column="66"/> </Position13> <Position14> - <Filename Value="raetselunit.pas"/> - <Caret Line="35" Column="49"/> + <Filename Value="unit1.pas"/> + <Caret Line="4" Column="57"/> </Position14> <Position15> - <Filename Value="unit1.pas"/> + <Filename Value="raetselunit.inc"/> + <Caret Line="766" Column="55" TopLine="758"/> </Position15> <Position16> - <Filename Value="raetselunit.pas"/> - <Caret Line="11" Column="3"/> + <Filename Value="raetselunit.inc"/> </Position16> <Position17> - <Filename Value="raetsel.lpr"/> - <Caret Line="11" Column="47"/> + <Filename Value="raetselunit.inc"/> + <Caret Line="738" Column="22" TopLine="706"/> </Position17> <Position18> - <Filename Value="raetselunit.pas"/> - <Caret Line="11" Column="3" TopLine="46"/> + <Filename Value="raetsel.lpr"/> + <Caret Line="13" Column="66"/> </Position18> <Position19> <Filename Value="raetselunit.pas"/> - <Caret Line="375" Column="31" TopLine="343"/> + <Caret Line="563" Column="62" TopLine="525"/> </Position19> <Position20> <Filename Value="raetselunit.pas"/> - <Caret Line="651" Column="53" TopLine="647"/> + <Caret Line="169" Column="46" TopLine="152"/> </Position20> <Position21> <Filename Value="raetselunit.pas"/> - <Caret Line="44" Column="35" TopLine="24"/> + <Caret Line="170" Column="21" TopLine="152"/> </Position21> <Position22> <Filename Value="raetselunit.pas"/> - <Caret Line="218" Column="10" TopLine="213"/> + <Caret Line="2"/> </Position22> <Position23> - <Filename Value="raetselunit.pas"/> - <Caret Line="40" Column="15" TopLine="20"/> + <Filename Value="raetselunit.inc"/> + <Caret Line="714" Column="70" TopLine="706"/> </Position23> <Position24> <Filename Value="raetselunit.pas"/> - <Caret Line="219" Column="37" TopLine="182"/> + <Caret Line="170" Column="21" TopLine="138"/> </Position24> <Position25> <Filename Value="raetselunit.pas"/> - <Caret Line="54" Column="29" TopLine="34"/> + <Caret Line="42" Column="38" TopLine="22"/> </Position25> <Position26> <Filename Value="raetselunit.pas"/> - <Caret Line="219" Column="38" TopLine="215"/> + <Caret Line="227" Column="39" TopLine="196"/> </Position26> <Position27> <Filename Value="raetselunit.pas"/> - <Caret Line="332" Column="6" TopLine="316"/> + <Caret Line="732" Column="46" TopLine="701"/> </Position27> <Position28> - <Filename Value="raetselunit.pas"/> - <Caret Line="63" Column="20" TopLine="44"/> + <Filename Value="raetselunit.inc"/> + <Caret Line="714" Column="61" TopLine="706"/> </Position28> <Position29> <Filename Value="raetselunit.inc"/> - <Caret Line="807" TopLine="785"/> + <Caret Line="688" Column="63" TopLine="678"/> </Position29> <Position30> - <Filename Value="raetselunit.inc"/> - <Caret Line="14" Column="20"/> + <Filename Value="raetselunit.pas"/> + <Caret Line="812" Column="66" TopLine="808"/> </Position30> </JumpHistory> </ProjectSession> diff --git a/raetselFileUnit.pas b/raetselFileUnit.pas deleted file mode 100644 index 1a389ab..0000000 --- a/raetselFileUnit.pas +++ /dev/null @@ -1,274 +0,0 @@ -unit raetselFileUnit;
-
-interface
-
- uses
- dialogs, math;
-
- type
- tWort = record
- w: array of byte;
- bits: integer;
- end;
- tRaetselFile = class
- private
- f: file;
- wacc: boolean;
- inhalt,
- conv: array of byte;
- fPoint: integer;
- wB: array of tWort;
- procedure fFlush;
- procedure initWB;
- procedure concatWs(a,b: integer);
- function bIsAX(a: tWort; b: array of byte): boolean;
- procedure rConvert;
- procedure wConvert;
- public
- kennung: string;
- procedure fAssignFile(fileName: string);
- function fReset: boolean;
- procedure fRewrite;
- procedure fCloseFile;
- procedure fBlockWrite(var data; len: integer);
- function fBlockRead(var data; len: integer): boolean;
- end;
-
-implementation
-
-procedure tRaetselFile.fAssignFile(FileName: string);
-begin
- assignFile(f,fileName);
-end;
-
-function tRaetselFile.fReset: boolean;
-var
- c: cardinal;
- s: string;
-begin
- wacc:=false;
- result:=false;
- c:=0;
- reset(f,1);
- if fileSize(f) < 4 then begin
- fCloseFile;
- exit;
- end;
- blockRead(f,c,4);
- if c<>$26594131 then begin
- fCloseFile;
- exit;
- end;
- setLength(conv,fileSize(f)-4);
- blockRead(f,conv[0],length(conv));
- rConvert;
- if length(inhalt)<length(kennung) then begin
- fCloseFile;
- exit;
- end;
- s:=kennung;
- fBlockRead(s[1],length(s));
- if s<>kennung then begin
- fCloseFile;
- exit;
- end;
- result:=true;
-end;
-
-procedure tRaetselFile.initWB;
-var
- b: byte;
-begin
- setLength(wB,128);
- for b:=0 to 127 do begin
- setLength(wB[b].w,2);
- wB[b].w[0]:=b;
- wB[b].w[1]:=0;
- wB[b].bits:=7;
- end;
-end;
-
-procedure tRaetselFile.concatWs(a,b: integer);
-var
- i: integer;
-begin
- setLength(wB,length(wB)+1); // wB erweitern
- with wB[length(wB)-1] do begin
- bits:=wB[a].bits+wB[b].bits;
- setLength(w,(bits+7) div 8 + 1);
- for i:=0 to length(w)-1 do
- w[i]:=0;
- for i:=0 to length(wB[a].w)-2 do
- w[i]:=wB[a].w[i];
- for i:=0 to length(wB[b].w)-2 do begin
- w[length(wB[a].w)-2+i]:=
- w[length(wB[a].w)-2+i] or
- ($ff and (wB[b].w[i] shl (wB[a].bits mod 8)));
- if length(wB[a].w)-1+i < length(w) then
- w[length(wB[a].w)-1+i]:=
- w[length(wB[a].w)-1+i] or
- (wB[b].w[i] shr (8 - (wB[a].bits mod 8)));
- end;
- end;
-end;
-
-function tRaetselFile.bIsAX(A: tWort; b: array of byte): boolean;
-var
- i: integer;
-begin
- result:=true;
- for i:=0 to (A.bits div 8)-1 do
- result:=result and (A.w[i] = b[i]);
- result:=result and ((A.w[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))) =
- (b[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))));
-end;
-
-procedure tRaetselFile.rConvert;
-var
- rP: longint;
- wP,i: integer;
- passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(inhalt,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=0;
- while rP<((length(conv)-1)*8) do begin
- passt:=0;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin
- passt:=passt or (byte(odd(conv[rP div 8] shr (rP mod 8))) shl i);
- inc(rP);
- end;
- for i:=0 to wB[passt].bits-1 do begin
- if wP=8 then begin
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or (byte(odd((wB[passt].w[i div 8] shr (i mod 8)))) shl wP);
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.wConvert;
-var
- rP: longint;
- wP,i,j: integer;
- rBuff: array of byte;
- rBBits,passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(conv,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=0;
- while rP<((length(inhalt)-1)*8) do begin
- setLength(rBuff,0);
- rBBits:=0;
- passt:=-1;
- for i:=length(wB)-1 downto 0 do
- with wB[i] do begin
- if bits > (8*length(inhalt) - rP) then continue;
- if bits > rBBits then begin // mehr r-buffern
- setLength(rBuff,(bits+7) div 8);
- rBBits:=bits;
- for j:=0 to length(rBuff)-1 do begin
- rBuff[j]:=0;
- if j + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or (inhalt[j + rP div 8] shr (rP mod 8));
- if j+1 + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or ($ff and (inhalt[(rP div 8) + j+1] shl (8-(rP mod 8))));
- end;
- end;
- if ((passt=-1) or (wB[passt].bits < wB[i].bits)) and
- bIsAX(wB[i],rBuff) then
- passt:=i;
- end;
- if passt=-1 then begin // geht ja gar nicht - geht ja wohl!
- messageDlg('Zu wenig wörter im wörterbuch!',mterror,[mbOk],0);
- exit;
- end;
- rP:=rP+wB[passt].bits;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin // wB-index speichern
- if wP=8 then begin // w-buffer leeren
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or byte(odd(passt shr i)) shl wP;
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.fFlush;
-begin
- wConvert;
- blockWrite(f,conv[0],length(conv));
- setLength(inhalt,0);
-end;
-
-procedure tRaetselFile.fRewrite;
-var
- c: cardinal;
-begin
- wacc:=true;
- rewrite(f,1);
- c:=$26594131;
- blockWrite(f,c,4);
- setLength(inhalt,length(kennung));
- move(kennung[1],inhalt[0],length(kennung));
- fPoint:=length(inhalt);
-end;
-
-procedure tRaetselFile.fCloseFile;
-begin
- if wacc then begin
- fFlush;
- closeFile(f);
- end;
- setLength(inhalt,0);
- fPoint:=0;
-end;
-
-procedure tRaetselFile.fBlockWrite(var data; len: integer);
-begin
- setLength(inhalt,length(inhalt)+len);
- move(data,inhalt[fPoint],len);
- fPoint:=length(inhalt);
-end;
-
-function tRaetselFile.fBlockRead(var data; len: integer): boolean;
-begin
- result:=len<=(length(inhalt)-fPoint);
- if not result then begin
- fCloseFile;
- exit;
- end;
- move(inhalt[fPoint],data,len);
- fPoint:=fPoint+len;
-end;
-
-end.
diff --git a/raetselunit.inc b/raetselunit.inc index 5b7ffe0..190ab73 100644 --- a/raetselunit.inc +++ b/raetselunit.inc @@ -42,7 +42,7 @@ begin result:='-' {$IFDEF hochhaus} else - result:=inttostr(i); + result:=intToStr(i); {$ENDIF} {$IFDEF buchstaben} else begin @@ -89,76 +89,76 @@ end; {$IFDEF passt} // function tHochhausRaetsel.passt(spalte,zeile: integer): boolean; var - I,KZ,KS: Integer; - W,S,K: Longint; + i,KZ,KS: integer; + w,s,k: longint; begin - W:=0; - S:=0; - K:=0; + w:=0; + s:=0; + k:=0; if sudokuCB.checked then begin - KZ:=(Zeile div NSqrt)*NSqrt; - KS:=(Spalte div NSqrt)*NSqrt; - for I:=0 to dim-1 do begin + KZ:=(zeile div nSqrt)*nSqrt; + KS:=(spalte div nSqrt)*nSqrt; + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; - S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; - K:=K*(groeszen[0]+2)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]+1; + w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; + s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1; + k:=k*(groeszen[0]+2)+inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]+1; {$ENDIF} {$IFDEF hochhaus} - W:=W*(dim+1)+max(0,inhalt[Zeile*dim+I]); - S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); - K:=K*(dim+1)+max(0,inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]); + w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]); + s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]); + k:=k*(dim+1)+max(0,inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]); {$ENDIF} end; result:= - AMoeglich[K*(groeszen[0]+1)] and - EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] and - AMoeglich[W*(groeszen[0]+1)+max(0,Rand[dim+Zeile])] and - AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] and - EMoeglich[W*(groeszen[0]+1)+max(0,Rand[3*dim+Zeile])]; + AMoeglich[k*(groeszen[0]+1)] and + EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and + AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and + AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and + EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])]; end else begin - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; - S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; + w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; + s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1; {$ENDIF} {$IFDEF hochhaus} - W:=W*(dim+1)+max(0,inhalt[Zeile*dim+I]); - S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); + w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]); + s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]); {$ENDIF} end; result:= - EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] and - AMoeglich[W*(groeszen[0]+1)+max(0,Rand[dim+Zeile])] and - AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] and - EMoeglich[W*(groeszen[0]+1)+max(0,Rand[3*dim+Zeile])]; + EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and + AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and + AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and + EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])]; end; if diagonalenCB.checked then begin - if Zeile=Spalte then begin - W:=0; + if zeile=spalte then begin + w:=0; {$IFDEF buchstaben} - for I:=0 to dim-1 do - W:=W*(groeszen[0]+2)+inhalt[I*(dim+1)]+1; - Result:=Result and AMoeglich[W*(groeszen[0]+1)]; + for i:=0 to dim-1 do + w:=w*(groeszen[0]+2)+inhalt[i*(dim+1)]+1; + result:=result and AMoeglich[w*(groeszen[0]+1)]; {$ENDIF} {$IFDEF hochhaus} - for I:=0 to dim-1 do - W:=W*(dim+1)+max(0,inhalt[I*(dim+1)]); - result:=result and AMoeglich[W*(dim+1)]; + for i:=0 to dim-1 do + w:=w*(dim+1)+max(0,inhalt[i*(dim+1)]); + result:=result and AMoeglich[w*(dim+1)]; {$ENDIF} end; - if Zeile+Spalte=dim-1 then begin - W:=0; + if zeile+spalte=dim-1 then begin + w:=0; {$IFDEF buchstaben} - for I:=0 to dim-1 do - W:=W*(groeszen[0]+2)+inhalt[(I+1)*(dim-1)]+1; - Result:=Result and AMoeglich[W*(groeszen[0]+1)]; + for i:=0 to dim-1 do + w:=w*(groeszen[0]+2)+inhalt[(i+1)*(dim-1)]+1; + result:=result and AMoeglich[w*(groeszen[0]+1)]; {$ENDIF} {$IFDEF hochhaus} - for I:=0 to dim-1 do - W:=W*(dim+1)+max(0,inhalt[(I+1)*(dim-1)]); - Result:=Result and AMoeglich[W*(dim+1)]; + for i:=0 to dim-1 do + w:=w*(dim+1)+max(0,inhalt[(i+1)*(dim-1)]); + result:=result and AMoeglich[w*(dim+1)]; {$ENDIF} end; end; @@ -175,7 +175,7 @@ begin for j:=0 to dim-1 do if (not passt(i,j)) or (inhalt[i+dim*j]<0) {$IFDEF hochhaus} - or (inhalt[I+dim*j]=0) + or (inhalt[i+dim*j]=0) {$ENDIF} then exit; result:=true; @@ -185,16 +185,16 @@ end; {$IFDEF gesamtRaenderErzeugen} // procedure tHochhausRaetsel.gesamtRaenderErzeugen; var - I,J,K,Nullen: Integer; + i,j,k,nullen: integer; {$IFNDEF buchstaben} AZ, {$ENDIF} - AR: Integer; - AK,EK,NAK,NEK: Longint; - Nums: tLongintArray; - B: Boolean; - Basis,Faktor: Integer; - Schritt: Longint; + AR: integer; + AK,EK,NAK,NEK: longint; + nums: tLongintArray; + b: boolean; + Basis,faktor: integer; + schritt: longint; dat: file; buff: array of byte; lw: Cardinal; @@ -207,47 +207,47 @@ const dat_name = 'Hochhausraetsel.dat'; {$ENDIF} -function calcNums(I: Longint): tLongintArray; +function calcNums(i: longint): tLongintArray; var - J: Integer; + j: integer; begin - Setlength(Result,dim); - For J:=0 to dim-1 do begin - Result[J]:=I mod Basis; - I:=I div Basis; + setLength(result,dim); + for j:=0 to dim-1 do begin + result[j]:=i mod Basis; + i:=i div Basis; end; end; -function calcIndex(Nums: TLongintArray): Longint; +function calcIndex(nums: tLongintArray): longint; var j: integer; begin - Result:=0; - For j:=0 to dim-1 do - Result:=Result*Basis + Nums[dim-J-1]; + result:=0; + for j:=0 to dim-1 do + result:=result*Basis + nums[dim-j-1]; end; -function swapIndex(I: Longint): Longint; +function swapIndex(i: longint): longint; var j: integer; begin - Result:=0; - for J:=0 to dim-1 do begin - Result:=Result*Basis+(I mod Basis); - I:=I div Basis; + result:=0; + for j:=0 to dim-1 do begin + result:=result*Basis+(i mod Basis); + i:=i div Basis; end; end; begin {$IFDEF buchstaben} Basis:=groeszen[0]+2; - Faktor:=groeszen[0]+1; + faktor:=groeszen[0]+1; {$ENDIF} {$IFDEF hochhaus} Basis:=dim+1; - Faktor:=dim+1; + faktor:=dim+1; {$ENDIF} - AK:=round(power(Basis,dim)*Faktor); + AK:=round(power(Basis,dim)*faktor); if (length(AMoeglich) = AK) and (length(EMoeglich) = AK) then @@ -255,20 +255,20 @@ begin lw:=0; // silence warning - if fileexists(extractfilepath(application.exename)+dat_name) then begin - assignfile(dat,extractfilepath(application.exename)+dat_name); + if fileExists(extractFilePath(application.exeName)+dat_name) then begin + assignFile(dat,extractFilePath(application.exeName)+dat_name); reset(dat,1); while not eof(dat) do begin - blockread(dat,lw,sizeof(lw)); + blockRead(dat,lw,sizeOf(lw)); if lw=AK then begin - Setlength(AMoeglich,AK); - Setlength(EMoeglich,AK); - setlength(buff,(lw+7) div 8); - blockread(dat,buff[0],length(buff)); + setLength(AMoeglich,AK); + setLength(EMoeglich,AK); + setLength(buff,(lw+7) div 8); + blockRead(dat,buff[0],length(buff)); for i:=0 to length(buff)-1 do for j:=0 to min(7,length(AMoeglich)-8*i-1) do AMoeglich[8*i+j]:=odd(buff[i] shr j); - blockread(dat,buff[0],length(buff)); + blockRead(dat,buff[0],length(buff)); for i:=0 to length(buff)-1 do for j:=0 to min(7,length(EMoeglich)-8*i-1) do EMoeglich[8*i+j]:=odd(buff[i] shr j); @@ -277,120 +277,120 @@ begin else seek(dat,filepos(dat)+2*((lw + 7) div 8)); end; - closefile(dat); + closeFile(dat); end; - Progressbar1.Visible:=true; - Progressbar1.Min:=0; - Progressbar1.Max:=1000; - Progressbar1.Position:=0; - Application.ProcessMessages; - - Setlength(AMoeglich,AK); - Setlength(EMoeglich,AK); - For AK:=0 to length(AMoeglich)-1 do begin - AMoeglich[AK]:=False; - EMoeglich[AK]:=False; + progressBar1.visible:=true; + progressBar1.min:=0; + progressBar1.max:=1000; + progressBar1.position:=0; + application.processMessages; + + 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); + 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 begin - progressbar1.stepIt; + 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 begin + progressBar1.stepIt; application.processMessages; end; - Nums:=calcNums(AK); - B:=true; + nums:=calcNums(AK); + b:=true; {$IFDEF buchstaben} - Nullen:=groeszen[1]; - For I:=0 to length(Nums)-1 do begin - B:=B and (Nums[I]<>0); - if Nums[I]=1 then - dec(Nullen) + nullen:=groeszen[1]; + 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]); + for j:=0 to i-1 do + b:=b and (nums[i]<>nums[j]); end; - B:=B and (Nullen>=0); + b:=b and (nullen>=0); {$ENDIF} {$IFDEF hochhaus} - 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]); + 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 + if b then begin EK:=swapIndex(AK); AR:=0; {$IFNDEF buchstaben} AZ:=0; {$ENDIF} - For I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - if Nums[I]>1 then begin - AR:=Nums[I]-1; + if nums[i]>1 then begin + AR:=nums[i]-1; break; end; {$ENDIF} {$IFDEF hochhaus} - if Nums[I]>AZ then begin + if nums[i]>AZ then begin inc(AR); - AZ:=Nums[I]; + AZ:=nums[i]; end; {$ENDIF} end; - AMoeglich[AK*Faktor+AR]:=true; - EMoeglich[EK*Faktor+AR]:=true; - AMoeglich[AK*Faktor]:=true; - EMoeglich[EK*Faktor]:=true; + 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)*dim) / Progressbar1.Max),1); - For Nullen:=1 to dim do - For AK:=0 to length(AMoeglich) div Faktor -1 do begin - if AK mod Schritt = 0 then begin - progressbar1.stepIt; + progressBar1.position:=0; + schritt:=max(round(((length(AMoeglich) div faktor)*dim) / progressBar1.max),1); + for nullen:=1 to dim do + for AK:=0 to length(AMoeglich) div faktor -1 do begin + if AK mod schritt = 0 then begin + progressBar1.stepIt; application.processMessages; end; - Nums:=calcNums(AK); - J:=Nullen; - For I:=0 to dim-1 do - if Nums[I]=0 then - dec(J); - if J<>0 then + nums:=calcNums(AK); + j:=nullen; + for i:=0 to dim-1 do + if nums[i]=0 then + dec(j); + if j<>0 then continue; EK:=swapIndex(AK); - For I:=0 to dim-1 do - if Nums[I]=0 then begin - For J:=1 to Basis-1 do begin - Nums[I]:=J; - NAK:=calcIndex(Nums); + for i:=0 to dim-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]; + 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; + progressBar1.visible:=false; - assignfile(dat,extractfilepath(application.exename)+dat_name); - if fileexists(extractfilepath(application.exename)+dat_name) then begin + assignFile(dat,extractFilePath(application.exeName)+dat_name); + if fileExists(extractFilePath(application.exeName)+dat_name) then begin reset(dat,1); - seek(dat,filesize(dat)); + seek(dat,fileSize(dat)); end else rewrite(dat,1); lw:=length(AMoeglich); - blockWrite(dat,lw,sizeof(lw)); - setlength(buff,(length(AMoeglich)+7) div 8); + blockWrite(dat,lw,sizeOf(lw)); + setLength(buff,(length(AMoeglich)+7) div 8); for i:=0 to length(buff)-1 do begin buff[i]:=0; for j:=0 to min(7,length(AMoeglich)-8*i-1) do @@ -403,108 +403,108 @@ begin buff[i]:=buff[i] or (byte(EMoeglich[8*i+j]) shl j); end; blockWrite(dat,buff[0],length(buff)); - closefile(dat); + closeFile(dat); end; {$ENDIF} {$IFDEF passtZumZeichnen} // function tHochhausRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean; var - I,KS,KZ: Integer; - W,S: Longint; + i,KS,KZ: integer; + w,s: longint; begin result:=false; if (spalte>=0) and (zeile>=0) and (spalte<dim) and (zeile<dim) then begin // im inneren {$IFDEF buchstaben} - if inhalt[Zeile*dim+Spalte]=-1 then + if inhalt[zeile*dim+spalte]=-1 then exit; {$ENDIF} {$IFDEF hochhaus} - if inhalt[Zeile*dim+Spalte]<=0 then + if inhalt[zeile*dim+spalte]<=0 then exit; {$ENDIF} - W:=0; - S:=0; - for I:=0 to dim-1 do begin + w:=0; + s:=0; + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(groeszen[0]+2)+inhalt[Zeile*dim+I]+1; - S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; + w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; + s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1; {$ENDIF} {$IFDEF hochhaus} - W:=W*(dim+1)+max(0,inhalt[Zeile*dim+I]); - S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); + w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]); + s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]); {$ENDIF} end; - Result:= - EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] and - AMoeglich[W*(groeszen[0]+1)+max(0,Rand[dim+Zeile])] and - AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] and - EMoeglich[W*(groeszen[0]+1)+max(0,Rand[3*dim+Zeile])]; + result:= + EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and + AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and + AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and + EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])]; {$IFDEF buchstaben} - if inhalt[Zeile*dim+Spalte]=0 then - W:=groeszen[1] + if inhalt[zeile*dim+spalte]=0 then + w:=groeszen[1] else {$ENDIF} - W:=1; + w:=1; if diagonalenCB.checked then begin - if Zeile=Spalte then begin - S:=W; - for I:=0 to dim-1 do - if (I<>Zeile) and (inhalt[I*(dim+1)]=inhalt[Zeile*dim+Spalte]) then - dec(S); - Result:=Result and (S>0); + if zeile=spalte then begin + s:=w; + for i:=0 to dim-1 do + if (i<>zeile) and (inhalt[i*(dim+1)]=inhalt[zeile*dim+spalte]) then + dec(s); + result:=result and (s>0); end; - if Zeile+Spalte=dim-1 then begin - S:=W; - For I:=0 to dim-1 do - if (I<>Zeile) and (inhalt[(I+1)*(dim-1)]=inhalt[Zeile*dim+Spalte]) then - dec(S); - Result:=Result and (S>0); + if zeile+spalte=dim-1 then begin + s:=w; + for i:=0 to dim-1 do + if (i<>zeile) and (inhalt[(i+1)*(dim-1)]=inhalt[zeile*dim+spalte]) then + dec(s); + result:=result and (s>0); end; end; if sudokuCB.checked then begin - KZ:=(Zeile div NSqrt)*NSqrt; - KS:=(Spalte div NSqrt)*NSqrt; - S:=W+1; - For I:=0 to dim-1 do - if inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]=inhalt[Zeile*dim+Spalte] then - dec(S); - Result:=Result and (S>0); + KZ:=(zeile div nSqrt)*nSqrt; + KS:=(spalte div nSqrt)*nSqrt; + s:=w+1; + for i:=0 to dim-1 do + if inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]=inhalt[zeile*dim+spalte] then + dec(s); + result:=result and (s>0); end; - S:=W; - For I:=0 to dim-1 do - if (I<>Zeile) and (inhalt[I*dim+Spalte]=inhalt[Zeile*dim+Spalte]) then - dec(S); - Result:=Result and (S>0); - S:=W; - For I:=0 to dim-1 do - if (I<>Spalte) and (inhalt[Zeile*dim+I]=inhalt[Zeile*dim+Spalte]) then - dec(S); - Result:=Result and (S>0); + s:=w; + for i:=0 to dim-1 do + if (i<>zeile) and (inhalt[i*dim+spalte]=inhalt[zeile*dim+spalte]) then + dec(s); + result:=result and (s>0); + s:=w; + for i:=0 to dim-1 do + if (i<>spalte) and (inhalt[zeile*dim+i]=inhalt[zeile*dim+spalte]) then + dec(s); + result:=result and (s>0); end - else begin // auf dem Rand + else begin // auf dem rand if zeile=-1 then begin if rand[spalte]=-1 then exit; s:=0; - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; + s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1; {$ENDIF} {$IFDEF hochhaus} - S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); + s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]); {$ENDIF} end; result:= - EMoeglich[S*(groeszen[0]+1)+max(0,Rand[Spalte])] or - not EMoeglich[S*(groeszen[0]+1)]; + EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] or + not EMoeglich[s*(groeszen[0]+1)]; exit; end; if spalte=dim then begin if rand[dim+zeile]=-1 then exit; w:=0; - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; {$ENDIF} @@ -513,7 +513,7 @@ begin {$ENDIF} end; result:= - AMoeglich[w*(groeszen[0]+1)+max(0,Rand[dim+zeile])] or + AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] or not AMoeglich[w*(groeszen[0]+1)]; exit; end; @@ -521,24 +521,24 @@ begin if rand[2*dim+spalte]=-1 then exit; s:=0; - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - S:=S*(groeszen[0]+2)+inhalt[I*dim+Spalte]+1; + s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1; {$ENDIF} {$IFDEF hochhaus} - S:=S*(dim+1)+max(0,inhalt[I*dim+Spalte]); + s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]); {$ENDIF} end; result:= - AMoeglich[S*(groeszen[0]+1)+max(0,Rand[2*dim+Spalte])] or - not EMoeglich[S*(groeszen[0]+1)]; + AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] or + not EMoeglich[s*(groeszen[0]+1)]; exit; end; if spalte=-1 then begin if rand[3*dim+zeile]=-1 then exit; w:=0; - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1; {$ENDIF} @@ -547,7 +547,7 @@ begin {$ENDIF} end; result:= - EMoeglich[w*(groeszen[0]+1)+max(0,Rand[3*dim+zeile])] or + EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])] or not EMoeglich[w*(groeszen[0]+1)]; exit; end; @@ -578,24 +578,24 @@ begin {$IFDEF buchstaben} if inhalt[i+dim*j]=0 then continue; - Rand[I]:=inhalt[I+dim*J]; + rand[i]:=inhalt[i+dim*j]; break; {$ENDIF} {$IFDEF hochhaus} - if inhalt[I+dim*J]>H then begin - H:=inhalt[I+dim*J]; - inc(Z); + if inhalt[i+dim*j]>h then begin + h:=inhalt[i+dim*j]; + inc(z); end; {$ENDIF} end; {$IFDEF hochhaus} - Rand[I]:=Z; + rand[i]:=z; - H:=0; - Z:=0; + h:=0; + z:=0; {$ENDIF} - For J:=dim-1 downto 0 do begin - if inhalt[I+dim*J]=-1 then begin + for j:=dim-1 downto 0 do begin + if inhalt[i+dim*j]=-1 then begin {$IFDEF hochhaus} z:=0; {$ENDIF} @@ -604,69 +604,70 @@ begin {$IFDEF buchstaben} if inhalt[i+dim*j]=0 then continue; - Rand[2*dim+I]:=inhalt[I+dim*J]; + rand[2*dim+i]:=inhalt[i+dim*j]; break; {$ENDIF} {$IFDEF hochhaus} - if inhalt[I+dim*J]>H then begin - H:=inhalt[I+dim*J]; - inc(Z); + if inhalt[i+dim*j]>h then begin + h:=inhalt[i+dim*j]; + inc(z); end; {$ENDIF} end; {$IFDEF hochhaus} - Rand[2*dim+I]:=Z; + rand[2*dim+i]:=z; - H:=0; - Z:=0; + h:=0; + z:=0; {$ENDIF} - For J:=dim-1 downto 0 do begin - if inhalt[J+dim*I]=-1 then begin + for j:=dim-1 downto 0 do begin + if inhalt[j+dim*i]=-1 then begin {$IFDEF hochhaus} z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} - if inhalt[J+dim*I]=0 then + if inhalt[j+dim*i]=0 then continue; - Rand[dim+I]:=inhalt[J+dim*I]; + rand[dim+i]:=inhalt[j+dim*i]; break; {$ENDIF} {$IFDEF hochhaus} - if inhalt[J+dim*I]>H then begin - H:=inhalt[J+dim*I]; - inc(Z); + if inhalt[j+dim*i]>h then begin + h:=inhalt[j+dim*i]; + inc(z); end; {$ENDIF} end; {$IFDEF hochhaus} - Rand[dim+I]:=Z; + rand[dim+i]:=z; - H:=0; - Z:=0; + h:=0; + z:=0; {$ENDIF} - For J:=0 to dim-1 do begin - if inhalt[J+dim*I]=-1 then begin + for j:=0 to dim-1 do begin + if inhalt[j+dim*i]=-1 then begin {$IFDEF hochhaus} - Z:=0; + z:=0; {$ENDIF} break; end; {$IFDEF buchstaben} - if inhalt[J+dim*I]=0 then continue; - Rand[3*dim+I]:=inhalt[J+dim*I]; + if inhalt[j+dim*i]=0 then + continue; + rand[3*dim+i]:=inhalt[j+dim*i]; break; {$ENDIF} {$IFDEF hochhaus} - if inhalt[J+dim*I]>H then begin - H:=inhalt[J+dim*I]; - inc(Z); + if inhalt[j+dim*i]>h then begin + h:=inhalt[j+dim*i]; + inc(z); end; {$ENDIF} end; {$IFDEF hochhaus} - Rand[3*dim+I]:=Z; + rand[3*dim+i]:=z; {$ENDIF} end; end; @@ -675,7 +676,7 @@ end; {$IFDEF relativeInhaltsAenderung} // procedure tHochhausRaetsel.relativeInhaltsAenderung(diff: longint); begin - if (cursorPosition<0) or (cursorPosition>=dim*dim) or startfeld[cursorPosition] then + if (cursorPosition<0) or (cursorPosition>=dim*dim) or startFeld[cursorPosition] then exit; alsZugSpeichern; {$IFDEF hochhaus} @@ -694,7 +695,7 @@ end; {$IFDEF absoluteInhaltsAenderung} // function tHochhausRaetsel.absoluteInhaltsAenderung(key: word): boolean; begin - if (cursorPosition<0) or (cursorPosition>=dim*dim) or startfeld[cursorPosition] then begin + if (cursorPosition<0) or (cursorPosition>=dim*dim) or startFeld[cursorPosition] then begin result:=false; exit; end; @@ -738,29 +739,29 @@ var perm: tLongintArray; begin result:=false; - setlength(perm,0); + setLength(perm,0); for p:=lPos+1 to dim*dim-1 do - if inhalt[P]=-1 then begin + if inhalt[p]=-1 then begin {$IFDEF buchstaben} perm:=permutation(groeszen[0]+1); {$ENDIF} {$IFDEF hochhaus} perm:=permutation(dim); {$ENDIF} - for I:=0 to dim-1 do begin + for i:=0 to dim-1 do begin {$IFDEF buchstaben} - inhalt[P]:=Perm[I]; + inhalt[p]:=perm[i]; {$ENDIF} {$IFDEF hochhaus} - inhalt[P]:=Perm[I]+1; + inhalt[p]:=perm[i]+1; {$ENDIF} - if passt(P mod dim,P div dim) then - if loesen(P) then begin + if passt(p mod dim,p div dim) then + if loesen(p) then begin result:=true; exit; end; end; - inhalt[P]:=-1; + inhalt[p]:=-1; exit; end; result:=true; @@ -773,21 +774,21 @@ var i,p: integer; begin result:=0; - for P:=lPos+1 to dim*dim-1 do - if inhalt[P]=-1 then begin + for p:=lPos+1 to dim*dim-1 do + if inhalt[p]=-1 then begin for - {$IFDEF hochhaus} I:=1 {$ENDIF} - {$IFDEF buchstaben}I:=0 {$ENDIF} + {$IFDEF hochhaus} i:=1 {$ENDIF} + {$IFDEF buchstaben}i:=0 {$ENDIF} to groeszen[0] do begin - inhalt[P]:=I; - if passt(P mod dim,P div dim) then - result:=result+Anzloesungen(P); + inhalt[p]:=i; + if passt(p mod dim,p div dim) then + result:=result+anzLoesungen(p); if result>=2 then begin - inhalt[P]:=-1; + inhalt[p]:=-1; exit; end; end; - inhalt[P]:=-1; + inhalt[p]:=-1; exit; end; result:=1; diff --git a/raetselunit.pas b/raetselunit.pas index 982d7ff..ad4a43a 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -15,7 +15,7 @@ type tButtonWithArrowKeys = class(tButton) private - procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; + procedure wMGetDlgCode(var msg: tWMGetDlgCode); message wM_GETDLGCODE; end; tSmarterCheckBox = class(tCheckBox) @@ -23,11 +23,11 @@ type end; tZug = record - Position: integer; - Vorher: integer; + position: integer; + vorher: integer; vorherFarbe, nachherFarbe, - vorherMalFarbe: TColor; + vorherMalFarbe: tColor; end; tOnSetCaption = procedure(c: string) of object; @@ -36,12 +36,12 @@ type private besitzer: tForm; farbWahlFlaeche, - zeichenflaeche: tImage; + zeichenFlaeche: tImage; erzeugeBtn, speichernBtn, ladenBtn: tButtonWithArrowKeys; zufallSE: tSpinEdit; - progressbar1: tProgressBar; + progressBar1: tProgressBar; aktuelleFarbe: tColor; function besitzerHoehe: longint; dynamic; function besitzerBreite: longint; dynamic; @@ -63,7 +63,7 @@ type function passt(spalte,zeile: integer): boolean; dynamic; abstract; function geloest: boolean; dynamic; abstract; procedure randErzeugen; dynamic; abstract; - procedure startfelderFestlegen; dynamic; abstract; + procedure startFelderFestlegen; dynamic; abstract; procedure speichern(var datei: file); dynamic; procedure laden(var datei: file); dynamic; public @@ -83,8 +83,8 @@ type cursorPosition: longint; zellGroesze: extended; uebersetze: tAlphabetFunktion; - FeldFarben: array of tColor; - startfeld: array of boolean; + feldFarben: array of tColor; + startFeld: array of boolean; zuege: array of tZug; procedure anzSEsOnChange(sender: tObject); procedure onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); override; @@ -99,7 +99,7 @@ type procedure relativeInhaltsAenderung(diff: longint); dynamic; abstract; function absoluteInhaltsAenderung(key: word): boolean; dynamic; abstract; procedure gesamtRaenderErzeugen; dynamic; abstract; - procedure startfelderfestlegen; override; + procedure startFelderFestlegen; override; procedure alsZugSpeichern; procedure speichern(var datei: file); override; procedure laden(var datei: file); override; @@ -121,8 +121,8 @@ type {$UNDEF interface} -function farbverlauf(wo: extended): tColor; -function RGB2TColor(R,G,B: Extended): TColor; inline; +function farbVerlauf(wo: extended): tColor; +function rgb2TColor(r,g,b: extended): tColor; inline; const spacing = 2; @@ -143,43 +143,43 @@ function buchstabenAlphabetFunktion(i: longint): string; {$UNDEF buchstaben} {$UNDEF alphabetFunktion} -function farbverlauf(wo: extended): tColor; +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); + 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]); + 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]); + 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)); + result:=rgb2TColor(r[i+1]*wo+r[i]*(1-wo), + g[i+1]*wo+g[i]*(1-wo), + b[i+1]*wo+b[i]*(1-wo)); end; -function RGB2TColor(R,G,B: extended): tColor; +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); + result:=max(0,min($FF,round(r*$100))) or + (max(0,min($FF,round(g*$100))) shl 8) or + (max(0,min($FF,round(b*$100))) shl 16); end; -// tButtonWithArrowkeys ******************************************************** +// tButtonWithArrowKeys ******************************************************** -procedure tButtonWithArrowkeys.WMGetDlgCode(var msg: tWMGetDLGCODE);// message WM_GETDLGCODE; +procedure tButtonWithArrowKeys.wMGetDlgCode(var msg: tWMGetDlgCode);// message wM_GETDLGCODE; begin inherited; - msg.Result := msg.Result or DLGC_WANTARROWS; + msg.result := msg.result or DLGC_WANTARROWS; end; // tSmarterCheckBox ************************************************************ @@ -203,9 +203,9 @@ begin inherited create; randomize; besitzer:=aOwner; - zeichenflaeche:=tImage.create(besitzer); - zeichenflaeche.parent:=besitzer; - zeichenflaeche.onMouseDown:=@onMouseDown; + zeichenFlaeche:=tImage.create(besitzer); + zeichenFlaeche.parent:=besitzer; + zeichenFlaeche.onMouseDown:=@onMouseDown; farbWahlFlaeche:=tImage.create(besitzer); farbWahlFlaeche.parent:=besitzer; farbWahlFlaeche.onMouseDown:=@onFarbWahlMouseDown; @@ -242,29 +242,29 @@ begin zufallSE.value:=random(zufallSE.maxValue+1); zufallSE.showHint:=true; zufallSE.hint:='Nummer'; - progressbar1:=tProgressBar.create(besitzer); - progressbar1.visible:=false; - progressbar1.smooth:=true; - progressbar1.parent:=besitzer; + progressBar1:=tProgressBar.create(besitzer); + progressBar1.visible:=false; + progressBar1.smooth:=true; + progressBar1.parent:=besitzer; end; destructor tRaetsel.destroy; begin - zeichenflaeche.free; + zeichenFlaeche.free; farbWahlFlaeche.free; inherited destroy; end; function tRaetsel.besitzerHoehe: longint; begin - result:=zeichenflaeche.height+zeichenflaeche.top+spacing; + result:=zeichenFlaeche.height+zeichenFlaeche.top+spacing; end; function tRaetsel.besitzerBreite: longint; begin result:= max( - zeichenflaeche.width+zeichenflaeche.left, + zeichenFlaeche.width+zeichenFlaeche.left, ladenBtn.width+ladenBtn.left )+spacing; end; @@ -274,15 +274,15 @@ var i: tImage; begin i:=tImage.create(besitzer); - i.parent:=zeichenflaeche.parent; - i.left:=zeichenflaeche.left; - i.top:=zeichenflaeche.top; - i.width:=zeichenflaeche.width; - i.height:=zeichenflaeche.height; - i.canvas.font.size:=zeichenflaeche.canvas.font.size; - i.onMouseDown:=zeichenflaeche.onMouseDown; - zeichenflaeche.free; - zeichenflaeche:=i; + i.parent:=zeichenFlaeche.parent; + i.left:=zeichenFlaeche.left; + i.top:=zeichenFlaeche.top; + i.width:=zeichenFlaeche.width; + i.height:=zeichenFlaeche.height; + i.canvas.font.size:=zeichenFlaeche.canvas.font.size; + i.onMouseDown:=zeichenFlaeche.onMouseDown; + zeichenFlaeche.free; + zeichenFlaeche:=i; i:=tImage.create(besitzer); i.parent:=farbWahlFlaeche.parent; @@ -300,9 +300,9 @@ end; procedure tRaetsel.onFarbWahlMouseDown(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); begin - if Button<>mbLeft then + if button<>mbLeft then exit; - aktuelleFarbe:=Farbverlauf(X/farbWahlFlaeche.Width); + aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; @@ -310,15 +310,15 @@ procedure tRaetsel.onFarbWahlMouseMove(sender: tObject; shiftState: tShiftState; begin if not(ssLeft in shiftState) then exit; - aktuelleFarbe:=Farbverlauf(X/farbWahlFlaeche.Width); + aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; procedure tRaetsel.onFarbWahlMouseUp(sender: tObject; button: tMouseButton; shiftState: tShiftState; x,y: longint); begin - if Button<>mbLeft then + if button<>mbLeft then exit; - aktuelleFarbe:=Farbverlauf(X/farbWahlFlaeche.Width); + aktuelleFarbe:=farbVerlauf(x/farbWahlFlaeche.width); farbWahlFlaecheBemalen; end; @@ -372,13 +372,13 @@ procedure tRaetsel.farbWahlFlaecheBemalen; var i: integer; begin - farbWahlFlaeche.Canvas.Pen.Color:=aktuelleFarbe; - farbWahlFlaeche.Canvas.Brush.Color:=aktuelleFarbe; - farbWahlFlaeche.Canvas.Rectangle(0,0,farbWahlFlaeche.width,farbWahlFlaeche.height div 2); - For I:=0 to farbWahlFlaeche.width-1 do begin - farbWahlFlaeche.Canvas.Pen.Color:=farbverlauf(I/farbWahlFlaeche.Width); - farbWahlFlaeche.Canvas.Moveto(I,farbWahlFlaeche.height div 2); - farbWahlFlaeche.Canvas.Lineto(I,farbWahlFlaeche.height); + farbWahlFlaeche.canvas.pen.color:=aktuelleFarbe; + farbWahlFlaeche.canvas.brush.color:=aktuelleFarbe; + farbWahlFlaeche.canvas.rectangle(0,0,farbWahlFlaeche.width,farbWahlFlaeche.height div 2); + for i:=0 to farbWahlFlaeche.width-1 do begin + farbWahlFlaeche.canvas.pen.color:=farbVerlauf(i/farbWahlFlaeche.width); + farbWahlFlaeche.canvas.moveTo(i,farbWahlFlaeche.height div 2); + farbWahlFlaeche.canvas.lineTo(i,farbWahlFlaeche.height); end; end; @@ -401,8 +401,8 @@ begin inherited create(aOwner); uebersetze:=alphabetFunktion; cursorPosition:=-1; - setlength(spinEdits,anzInhTypen+1); - setlength(groeszen,length(spinEdits)-1); + setLength(spinEdits,anzInhTypen+1); + setLength(groeszen,length(spinEdits)-1); for i:=0 to length(spinEdits)-1 do begin spinEdits[i]:=tSpinEdit.create(besitzer); spinEdits[i].onKeyDown:=@onKeyDown; @@ -443,8 +443,8 @@ begin farbWahlFlaeche.left:=spacing; farbWahlFlaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; farbWahlFlaeche.height:=16; - zeichenflaeche.left:=spacing; - zeichenflaeche.top:=farbWahlFlaeche.top+farbWahlFlaeche.height+spacing; + zeichenFlaeche.left:=spacing; + zeichenFlaeche.top:=farbWahlFlaeche.top+farbWahlFlaeche.height+spacing; aktualisiereGroesze; end; @@ -467,15 +467,15 @@ end; procedure tFelderRaetsel.onKeyDown(sender: tObject; var key: word; shiftState: tShiftState); begin if ssCtrl in shiftState then begin - if (Key=ord('Z')) and (length(Zuege)>0) then begin - cursorPosition:=Zuege[length(Zuege)-1].Position; - inhalt[cursorPosition]:=Zuege[length(Zuege)-1].Vorher; - FeldFarben[cursorPosition]:=Zuege[length(Zuege)-1].VorherFarbe; - aktuelleFarbe:=Zuege[length(Zuege)-1].VorherMalFarbe; - setlength(Zuege,length(Zuege)-1); + if (key=ord('Z')) and (length(zuege)>0) then begin + cursorPosition:=zuege[length(zuege)-1].position; + inhalt[cursorPosition]:=zuege[length(zuege)-1].vorher; + feldFarben[cursorPosition]:=zuege[length(zuege)-1].vorherFarbe; + aktuelleFarbe:=zuege[length(zuege)-1].vorherMalFarbe; + setLength(zuege,length(zuege)-1); farbWahlFlaecheBemalen; end; - Zeichnen; + zeichnen; exit; end; @@ -529,13 +529,13 @@ begin groeszen[i]:=spinEdits[i+1].value; dim:=dim+groeszen[i]; end; - setlength(inhalt,dim*dim); - setlength(startfeld,dim*dim); - setlength(feldFarben,dim*dim); - setlength(rand,4*dim); + setLength(inhalt,dim*dim); + setLength(startFeld,dim*dim); + setLength(feldFarben,dim*dim); + setLength(rand,4*dim); - NSqrt:=round(sqrt(dim)); - sudokuCB.enabled:=Sqr(NSqrt)=dim; + nSqrt:=round(sqrt(dim)); + sudokuCB.enabled:=Sqr(nSqrt)=dim; if (not sudokuCB.enabled) and sudokuCB.checked then sudokuCB.checked:=false; @@ -550,7 +550,7 @@ var i: longint; begin aktuelleFarbe:=$000000; - setlength(zuege,0); + setLength(zuege,0); for i:=0 to length(inhalt)-1 do begin inhalt[i]:=-1; startFeld[i]:=true; @@ -567,13 +567,13 @@ var i,w: longint; begin p:=permutation(dim*dim); - progressbar1.step:=1; - progressbar1.min:=0; - progressbar1.max:=dim*(dim+4); - progressbar1.position:=0; - progressbar1.visible:=true; + progressBar1.step:=1; + progressBar1.min:=0; + progressBar1.max:=dim*(dim+4); + progressBar1.position:=0; + progressBar1.visible:=true; for i:=0 to length(p)-1 do begin - progressbar1.stepIt; + progressBar1.stepIt; application.processMessages; if inhalt[p[i]]<0 then continue; @@ -585,7 +585,7 @@ begin p:=permutation(dim*4); for i:=0 to length(p)-1 do begin - progressbar1.stepIt; + progressBar1.stepIt; application.processMessages; if rand[p[i]]<0 then continue; w:=rand[p[i]]; @@ -593,22 +593,22 @@ begin if anzLoesungen(-1)<>1 then rand[p[i]]:=w; end; - progressbar1.visible:=false; + progressBar1.visible:=false; end; procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze; begin - zeichenflaeche.canvas.font.size:=schriftGroesze; + zeichenFlaeche.canvas.font.size:=schriftGroesze; zellGroesze:= - 2*spacing + zeichenflaeche.canvas.pen.width + + 2*spacing + zeichenFlaeche.canvas.pen.width + max( - zeichenflaeche.canvas.textWidth(uebersetze(dim)), - zeichenflaeche.canvas.textHeight(uebersetze(dim)) + zeichenFlaeche.canvas.textWidth(uebersetze(dim)), + zeichenFlaeche.canvas.textHeight(uebersetze(dim)) ); - zeichenflaeche.height:=round((dim+2)*zellGroesze); - zeichenflaeche.width:=zeichenflaeche.height; + zeichenFlaeche.height:=round((dim+2)*zellGroesze); + zeichenFlaeche.width:=zeichenFlaeche.height; farbWahlFlaeche.height:=16; - farbWahlFlaeche.width:=zeichenflaeche.width; + farbWahlFlaeche.width:=zeichenFlaeche.width; zeichenFlaecheNeuKreieren; besitzer.height:=besitzerHoehe; besitzer.width:= @@ -617,7 +617,7 @@ begin sudokuCB.left+sudokuCB.width+spacing), spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing ); - progressbar1.width:=besitzer.width; + progressBar1.width:=besitzer.width; zeichnen; end; @@ -645,7 +645,7 @@ var s: string; begin s:=uebersetze(i); - with zeichenflaeche.canvas do begin + with zeichenFlaeche.canvas do begin brush.color:=$FFFFFF; if (x>=0) and (y>=0) and (x<dim) and (y<dim) and (diagonalenCB.checked and ((x=y) or (x+y=dim-1))) then brush.color:=brush.color - $181818; @@ -674,20 +674,20 @@ procedure tFelderRaetsel.zeichnen; var i: longint; begin - zeichenflaeche.canvas.brush.color:=$ffffff; - zeichenflaeche.canvas.rectangle(-10,-10,zeichenflaeche.width+10,zeichenflaeche.height+10); - zeichenflaeche.canvas.pen.width:=3-2*byte(sudokuCB.checked); - zeichenflaeche.canvas.pen.color:=$000000; + zeichenFlaeche.canvas.brush.color:=$ffffff; + zeichenFlaeche.canvas.rectangle(-10,-10,zeichenFlaeche.width+10,zeichenFlaeche.height+10); + zeichenFlaeche.canvas.pen.width:=3-2*byte(sudokuCB.checked); + zeichenFlaeche.canvas.pen.color:=$000000; if diagonalenCB.checked then for i:=1 to dim do begin - zeichenflaeche.canvas.brush.color:=$ffffff - $181818; - zeichenflaeche.canvas.fillRect( + zeichenFlaeche.canvas.brush.color:=$ffffff - $181818; + zeichenFlaeche.canvas.fillRect( round(i*zellGroesze), round(i*zellGroesze), round((i+1)*zellGroesze), round((i+1)*zellGroesze) ); - zeichenflaeche.canvas.fillRect( + zeichenFlaeche.canvas.fillRect( round(i*zellGroesze), round((dim-i+1)*zellGroesze), round((i+1)*zellGroesze), @@ -695,31 +695,31 @@ begin ); end; for i:=0 to dim do - with zeichenflaeche.canvas do begin + with zeichenFlaeche.canvas do begin pen.width:=3-2*byte(sudokuCB.checked and (i mod nSqrt <> 0)); moveTo(round((i+1)*zellGroesze),round(zellGroesze)); lineTo(round((i+1)*zellGroesze),round((dim+1)*zellGroesze)); moveTo(round(zellGroesze),round((i+1)*zellGroesze)); lineTo(round((dim+1)*zellGroesze),round((i+1)*zellGroesze)); end; - zeichenflaeche.canvas.pen.width:=3; - zeichenflaeche.canvas.pen.color:=$8080ff; + zeichenFlaeche.canvas.pen.width:=3; + zeichenFlaeche.canvas.pen.color:=$8080ff; if (cursorPosition>=0) and (dim>0) then begin - zeichenflaeche.canvas.brush.color:= + zeichenFlaeche.canvas.brush.color:= $ffffff - $181818 * byte( diagonalenCB.checked and ( (cursorPosition mod (dim+1)=0) or (cursorPosition mod (dim-1)=0) ) ); - zeichenflaeche.canvas.rectangle( + zeichenFlaeche.canvas.rectangle( round(((cursorPosition mod dim)+1)*zellGroesze), round(((cursorPosition div dim)+1)*zellGroesze), round(((cursorPosition mod dim)+2)*zellGroesze+1), round(((cursorPosition div dim)+2)*zellGroesze+1) ); end; - zeichenflaeche.canvas.brush.color:=$ffffff; + zeichenFlaeche.canvas.brush.color:=$ffffff; for i:=0 to dim-1 do begin schreibeZentriert(i,-1,rand[i]); schreibeZentriert(dim,i,rand[dim+i]); @@ -730,12 +730,12 @@ begin schreibeZentriert(i mod dim,i div dim,inhalt[i]); end; -procedure tFelderRaetsel.startfelderfestlegen; +procedure tFelderRaetsel.startFelderFestlegen; var i: longint; begin for i:=0 to length(inhalt)-1 do - startfeld[i]:=inhalt[i]>=0; + startFeld[i]:=inhalt[i]>=0; end; procedure tFelderRaetsel.alsZugSpeichern; @@ -764,32 +764,32 @@ begin b:=byte(sudokuCB.checked); blockWrite(datei,b,1); i:=length(groeszen); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(groeszen)>0 then - blockWrite(datei,groeszen[0],length(groeszen)*sizeof(groeszen[0])); + blockWrite(datei,groeszen[0],length(groeszen)*sizeOf(groeszen[0])); i:=length(inhalt); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(inhalt)>0 then - blockWrite(datei,inhalt[0],length(inhalt)*sizeof(inhalt[0])); + blockWrite(datei,inhalt[0],length(inhalt)*sizeOf(inhalt[0])); i:=length(rand); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(rand)>0 then - blockWrite(datei,rand[0],length(rand)*sizeof(rand[0])); - blockWrite(datei,dim,sizeof(dim)); - blockWrite(datei,nSqrt,sizeof(nSqrt)); - blockWrite(datei,cursorPosition,sizeof(cursorPosition)); + blockWrite(datei,rand[0],length(rand)*sizeOf(rand[0])); + blockWrite(datei,dim,sizeOf(dim)); + blockWrite(datei,nSqrt,sizeOf(nSqrt)); + blockWrite(datei,cursorPosition,sizeOf(cursorPosition)); i:=length(feldFarben); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(feldFarben)>0 then - blockWrite(datei,feldFarben[0],length(feldFarben)*sizeof(feldFarben[0])); + blockWrite(datei,feldFarben[0],length(feldFarben)*sizeOf(feldFarben[0])); i:=length(startFeld); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(startFeld)>0 then - blockWrite(datei,startFeld[0],length(startFeld)*sizeof(startFeld[0])); + blockWrite(datei,startFeld[0],length(startFeld)*sizeOf(startFeld[0])); i:=length(zuege); - blockWrite(datei,i,sizeof(i)); + blockWrite(datei,i,sizeOf(i)); if length(zuege)>0 then - blockWrite(datei,zuege[0],length(zuege)*sizeof(zuege[0])); + blockWrite(datei,zuege[0],length(zuege)*sizeOf(zuege[0])); inherited speichern(datei); end; @@ -816,32 +816,32 @@ begin blockRead(datei,i,sizeOf(i)); assert(length(groeszen)=i,'Falsche Anzahl freier Paraemeter in gespeichertem Spiel!'); if length(groeszen)>0 then - blockRead(datei,groeszen[0],length(groeszen)*sizeof(groeszen[0])); + blockRead(datei,groeszen[0],length(groeszen)*sizeOf(groeszen[0])); for i:=0 to length(groeszen)-1 do spinEdits[i+1].value:=groeszen[i]; blockRead(datei,i,sizeOf(i)); setLength(inhalt,i); if length(inhalt)>0 then - blockRead(datei,inhalt[0],length(inhalt)*sizeof(inhalt[0])); + blockRead(datei,inhalt[0],length(inhalt)*sizeOf(inhalt[0])); blockRead(datei,i,sizeOf(i)); setLength(rand,i); if length(rand)>0 then - blockRead(datei,rand[0],length(rand)*sizeof(rand[0])); - blockRead(datei,dim,sizeof(dim)); - blockRead(datei,nSqrt,sizeof(nSqrt)); - blockRead(datei,cursorPosition,sizeof(cursorPosition)); + blockRead(datei,rand[0],length(rand)*sizeOf(rand[0])); + blockRead(datei,dim,sizeOf(dim)); + blockRead(datei,nSqrt,sizeOf(nSqrt)); + blockRead(datei,cursorPosition,sizeOf(cursorPosition)); blockRead(datei,i,sizeOf(i)); setLength(feldFarben,i); if length(feldFarben)>0 then - blockRead(datei,feldFarben[0],length(feldFarben)*sizeof(feldFarben[0])); + blockRead(datei,feldFarben[0],length(feldFarben)*sizeOf(feldFarben[0])); blockRead(datei,i,sizeOf(i)); setLength(startFeld,i); if length(startFeld)>0 then - blockRead(datei,startFeld[0],length(startFeld)*sizeof(startFeld[0])); + blockRead(datei,startFeld[0],length(startFeld)*sizeOf(startFeld[0])); blockRead(datei,i,sizeOf(i)); setLength(zuege,i); if length(zuege)>0 then - blockRead(datei,zuege[0],length(zuege)*sizeof(zuege[0])); + blockRead(datei,zuege[0],length(zuege)*sizeOf(zuege[0])); inherited laden(datei); end; @@ -13,12 +13,12 @@ type { tForm1 } tForm1 = class(tForm) - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender: TObject); + procedure formCreate(sender: tObject); + procedure formDestroy(sender: tObject); + procedure formShow(sender: tObject); private { private declarations } - procedure WMGetDlgCode(var msg: tMessage); message WM_GETDLGCODE; + procedure wMGetDlgCode(var msg: tMessage); message wM_GETDLGCODE; procedure onSetCaption(c: string); public { public declarations } @@ -26,7 +26,7 @@ type end; var - Form1: TForm1; + form1: tForm1; implementation @@ -37,7 +37,7 @@ uses // tForm1 ********************************************************************** -procedure tForm1.WMGetDlgCode(var msg: tMessage);// message WM_GETDLGCODE; +procedure tForm1.wMGetDlgCode(var msg: tMessage);// message wM_GETDLGCODE; begin inherited; msg.result := msg.result or DLGC_WANTARROWS; @@ -64,12 +64,12 @@ begin form1.caption:=c; end; -procedure tForm1.FormDestroy(Sender: TObject); +procedure tForm1.formDestroy(sender: tObject); begin raetsel.free; end; -procedure tForm1.FormShow(Sender: TObject); +procedure tForm1.formShow(sender: tObject); begin if assigned(raetsel) then raetsel.zeichnen; @@ -11,9 +11,9 @@ type { TForm2 } - TForm2 = class(TForm) - Button1: TButton; - Button2: TButton; + tForm2 = class(tForm) + button1: tButton; + button2: tButton; private { private declarations } public @@ -21,7 +21,7 @@ type end; var - Form2: TForm2; + form2: tForm2; const mrHochhausraetsel = 314; |