From 8f2e5f01f9dc3a6813bd8431f2c0c9172a83af4d Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Tue, 2 Oct 2018 11:30:30 +0200 Subject: Style + remove obsolete files --- RaetselFileUnit.pas | 274 ------ ori_Unit1.pas | 2384 --------------------------------------------------- raetsel.lpr | 8 +- raetsel.lps | 117 +-- raetselFileUnit.pas | 274 ------ raetselunit.inc | 529 ++++++------ raetselunit.pas | 276 +++--- unit1.pas | 16 +- unit2.pas | 8 +- 9 files changed, 478 insertions(+), 3408 deletions(-) delete mode 100644 RaetselFileUnit.pas delete mode 100644 ori_Unit1.pas delete mode 100644 raetselFileUnit.pas 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)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.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.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 @@ - - + + @@ -18,7 +18,9 @@ - + + + @@ -29,26 +31,26 @@ - - + + - - - + + + - - - + + + @@ -87,11 +89,10 @@ - + - @@ -157,122 +158,122 @@ - + - - + + - - + + - - + + - - + + - - + + - + - - + + - + - - + + - + - + - - + + - - + + - + + - - + - - + + - - + + - + - + - + - + - - + + - + - + - + - + - - + + - + - - + + 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)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 (spalteZeile) 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 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; diff --git a/unit1.pas b/unit1.pas index 05b97d8..84cda28 100644 --- a/unit1.pas +++ b/unit1.pas @@ -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; diff --git a/unit2.pas b/unit2.pas index 11e7551..8c30ae8 100644 --- a/unit2.pas +++ b/unit2.pas @@ -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; -- cgit v1.2.3-70-g09d2