From 69310448c9bec42541def7813c3019d8cab0724c Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Fri, 15 Jul 2016 21:12:30 +0200 Subject: initial Commit - nicht lauffähig, enthält aber auch noch das Original MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitignore | 20 + RaetselFileUnit.pas | 274 ++++++ ori_Unit1.pas | 2384 +++++++++++++++++++++++++++++++++++++++++++++++++++ raetsel.ico | Bin 0 -> 137040 bytes raetsel.lpi | 79 ++ raetsel.lpr | 21 + raetsel.lps | 115 +++ raetselFileUnit.pas | 274 ++++++ unit1.lfm | 8 + unit1.pas | 26 + 10 files changed, 3201 insertions(+) create mode 100644 .gitignore create mode 100644 RaetselFileUnit.pas create mode 100644 ori_Unit1.pas create mode 100644 raetsel.ico create mode 100644 raetsel.lpi create mode 100644 raetsel.lpr create mode 100644 raetsel.lps create mode 100644 raetselFileUnit.pas create mode 100644 unit1.lfm create mode 100644 unit1.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a3eab2e --- /dev/null +++ b/.gitignore @@ -0,0 +1,20 @@ +*.exe +*.dat +*.cfg +*.dof +*.dpr +*.drc +*.dsk +*.map +*.res +*.rsm +*.zip +*.~* +*.dcu +*.ddp +*.dfm +*.bsr + +*.bak +lib/* +raetsel diff --git a/RaetselFileUnit.pas b/RaetselFileUnit.pas new file mode 100644 index 0000000..1a389ab --- /dev/null +++ b/RaetselFileUnit.pas @@ -0,0 +1,274 @@ +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)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 new file mode 100644 index 0000000..b05de6b --- /dev/null +++ b/ori_Unit1.pas @@ -0,0 +1,2384 @@ +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.Width0) 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:=I0 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:=ISpalte) 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]) 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]) 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]) 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]) 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 + (HaHa 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 (Za0 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 + (HaHa 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 (Za0 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 + (HaHa 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 (Za0 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 + (HaHa 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 (Za0); + 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.ico b/raetsel.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/raetsel.ico differ diff --git a/raetsel.lpi b/raetsel.lpi new file mode 100644 index 0000000..70967d1 --- /dev/null +++ b/raetsel.lpi @@ -0,0 +1,79 @@ + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="raetsel.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="raetsel"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/raetsel.lpr b/raetsel.lpr new file mode 100644 index 0000000..2f603cd --- /dev/null +++ b/raetsel.lpr @@ -0,0 +1,21 @@ +program raetsel; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/raetsel.lps b/raetsel.lps new file mode 100644 index 0000000..04c7bd4 --- /dev/null +++ b/raetsel.lps @@ -0,0 +1,115 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="9"/> + <BuildModes Active="Default"/> + <Units Count="6"> + <Unit0> + <Filename Value="raetsel.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="20"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + <CursorPos X="83" Y="8"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit1> + <Unit2> + <Filename Value="Unit1.pas"/> + <EditorIndex Value="-1"/> + <CursorPos X="3" Y="17"/> + <UsageCount Value="10"/> + </Unit2> + <Unit3> + <Filename Value="RaetselFileUnit.pas"/> + <UnitName Value="raetselFileUnit"/> + <EditorIndex Value="-1"/> + <UsageCount Value="10"/> + </Unit3> + <Unit4> + <Filename Value="raetselFileUnit.pas"/> + <EditorIndex Value="1"/> + <CursorPos X="28" Y="11"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit4> + <Unit5> + <Filename Value="ori_Unit1.pas"/> + <UnitName Value="Unit1"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="2"/> + <CursorPos X="15" Y="13"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit5> + </Units> + <JumpHistory Count="14" HistoryIndex="13"> + <Position1> + <Filename Value="unit1.pas"/> + <Caret Line="9" Column="4"/> + </Position1> + <Position2> + <Filename Value="unit1.pas"/> + <Caret Line="8" Column="83"/> + </Position2> + <Position3> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="13" Column="15"/> + </Position3> + <Position4> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="132" Column="14" TopLine="96"/> + </Position4> + <Position5> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1532" Column="18" TopLine="1496"/> + </Position5> + <Position6> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1579" Column="15" TopLine="1544"/> + </Position6> + <Position7> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1727" Column="15" TopLine="1692"/> + </Position7> + <Position8> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1891" Column="30" TopLine="1855"/> + </Position8> + <Position9> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="13" Column="15"/> + </Position9> + <Position10> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="132" Column="14" TopLine="96"/> + </Position10> + <Position11> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1532" Column="18" TopLine="1496"/> + </Position11> + <Position12> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1579" Column="15" TopLine="1544"/> + </Position12> + <Position13> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1727" Column="15" TopLine="1692"/> + </Position13> + <Position14> + <Filename Value="ori_Unit1.pas"/> + <Caret Line="1891" Column="30" TopLine="1855"/> + </Position14> + </JumpHistory> + </ProjectSession> +</CONFIG> diff --git a/raetselFileUnit.pas b/raetselFileUnit.pas new file mode 100644 index 0000000..1a389ab --- /dev/null +++ b/raetselFileUnit.pas @@ -0,0 +1,274 @@ +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/unit1.lfm b/unit1.lfm new file mode 100644 index 0000000..e6d4251 --- /dev/null +++ b/unit1.lfm @@ -0,0 +1,8 @@ +object Form1: TForm1 + Left = 1690 + Height = 240 + Top = 197 + Width = 320 + Caption = 'Form1' + LCLVersion = '1.6.0.4' +end diff --git a/unit1.pas b/unit1.pas new file mode 100644 index 0000000..79a1d82 --- /dev/null +++ b/unit1.pas @@ -0,0 +1,26 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, raetselFileUnit; + +type + TForm1 = class(TForm) + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +end. + -- cgit v1.2.3-70-g09d2