From 667f65d6f46dc71482e307ee483e994f8f78b522 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Mon, 1 Oct 2018 13:46:00 +0200 Subject: mehr Fortschritt --- raetsel.lps | 148 ++++++++++++++++++++++++++++---------------------- raetselunit.inc | 164 ++++++++++++++++++++++++++------------------------------ raetselunit.pas | 13 +++-- 3 files changed, 168 insertions(+), 157 deletions(-) diff --git a/raetsel.lps b/raetsel.lps index 81ab4d0..67fe025 100644 --- a/raetsel.lps +++ b/raetsel.lps @@ -9,7 +9,7 @@ - + @@ -19,8 +19,8 @@ - - + + @@ -33,18 +33,17 @@ - + - - - - + + + @@ -63,19 +62,19 @@ - + - + - + @@ -84,9 +83,9 @@ - - - + + + @@ -95,7 +94,7 @@ - + @@ -103,143 +102,164 @@ - + - + + - - + + + - - + + - - + + - - + + - - + + - + - + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + - + - + - + - - + + - - + + - - + + - + - + - + - + - + - + - + - + - - + + + + + + + + + + + + + + + + + + + + + diff --git a/raetselunit.inc b/raetselunit.inc index 5d40b2d..6c796ce 100644 --- a/raetselunit.inc +++ b/raetselunit.inc @@ -13,16 +13,12 @@ type function passtZumZeichnen(spalte,zeile: integer): boolean; override; function passt(spalte,zeile: integer): boolean; override; function geloest: boolean; override; + procedure gesamtRaenderErzeugen; override; public - {$IFDEF buchstaben} - NBuchst, - NLeer, - {$ENDIF} NSqrt: integer; AMoeglich,EMoeglich: array of boolean; constructor create(aOwner: tForm); destructor destroy; override; - procedure gesamtRaenderErzeugen; // function Loesen(lPos: integer): boolean; // procedure leeren; // procedure RandErzeugen; @@ -106,9 +102,9 @@ begin KS:=(Spalte div dim)*dim; for I:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1; - S:=S*(NBuchst+2)+inhalt[I*dim+Spalte]+1; - K:=K*(NBuchst+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)+inhalt[Zeile*dim+I]; @@ -118,11 +114,11 @@ begin end; result:= {$IFDEF buchstaben} - AMoeglich[K*(NBuchst+1)] and - EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and - AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and - AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and - EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]]; + AMoeglich[K*(groeszen[0]+1)] and + EMoeglich[S*(groeszen[0]+1)+Rand[Spalte]] and + AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] and + AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] and + EMoeglich[W*(groeszen[0]+1)+Rand[3*dim+Zeile]]; {$ENDIF} {$IFDEF hochhaus} AMoeglich[K*(dim+1)] and @@ -135,8 +131,8 @@ begin else begin for I:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1; - S:=S*(NBuchst+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)+inhalt[Zeile*dim+I]; @@ -145,10 +141,10 @@ begin end; result:= {$IFDEF buchstaben} - EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and - AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and - AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and - EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]]; + EMoeglich[S*(groeszen[0]+1)+Rand[Spalte]] and + AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] and + AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] and + EMoeglich[W*(groeszen[0]+1)+Rand[3*dim+Zeile]]; {$ENDIF} {$IFDEF hochhaus} EMoeglich[S*(dim+1)+Rand[Spalte]] and @@ -162,8 +158,8 @@ begin W:=0; {$IFDEF buchstaben} for I:=0 to dim-1 do - W:=W*(NBuchst+2)+inhalt[I*(dim+1)]+1; - Result:=Result and AMoeglich[W*(NBuchst+1)]; + 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 @@ -175,8 +171,8 @@ begin W:=0; {$IFDEF buchstaben} for I:=0 to dim-1 do - W:=W*(NBuchst+2)+inhalt[(I+1)*(dim-1)]+1; - Result:=Result and AMoeglich[W*(NBuchst+1)]; + 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 @@ -218,8 +214,9 @@ var B: Boolean; Basis,Faktor: Integer; Schritt: Longint; - dat: File of Cardinal; - lw1,lw2,L: Cardinal; + dat: file; + buff: array of byte; + lw: Cardinal; const dat_name = {$IFDEF buchstaben} @@ -262,8 +259,8 @@ end; begin {$IFDEF buchstaben} - Basis:=NBuchst+2; - Faktor:=NBuchst+1; + Basis:=groeszen[0]+2; + Faktor:=groeszen[0]+1; {$ENDIF} {$IFDEF hochhaus} Basis:=dim+1; @@ -277,36 +274,25 @@ begin if fileexists(extractfilepath(application.exename)+dat_name) then begin assignfile(dat,extractfilepath(application.exename)+dat_name); - reset(dat); + reset(dat,1); while not eof(dat) do begin - read(dat,lw1); - if lw1=AK then begin + blockread(dat,lw,sizeof(lw)); + if lw=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; + 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)); + 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); exit; end else - Seek(dat,Filepos(dat)+((lw1-1) div 32 +1)*2); + seek(dat,filepos(dat)+2*((lw + 7) div 8)); end; closefile(dat); end; @@ -315,6 +301,7 @@ begin Progressbar1.Min:=0; Progressbar1.Max:=1000; Progressbar1.Position:=0; + Application.ProcessMessages; Setlength(AMoeglich,AK); Setlength(EMoeglich,AK); @@ -326,12 +313,14 @@ begin 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; + if AK mod Schritt = 0 then begin + progressbar1.stepIt; + application.processMessages; + end; Nums:=calcNums(AK); B:=true; {$IFDEF buchstaben} - Nullen:=NLeer; + Nullen:=groeszen[1]; For I:=0 to length(Nums)-1 do begin B:=B and (Nums[I]<>0); @@ -381,8 +370,10 @@ begin 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 - Progressbar1.StepIt; + if AK mod Schritt = 0 then begin + progressbar1.stepIt; + application.processMessages; + end; Nums:=calcNums(AK); J:=Nullen; For I:=0 to dim-1 do @@ -408,30 +399,27 @@ begin Progressbar1.Visible:=False; assignfile(dat,extractfilepath(application.exename)+dat_name); - if Fileexists(extractfilepath(application.exename)+dat_name) then begin - reset(dat); - Seek(dat,Filesize(dat)); + if fileexists(extractfilepath(application.exename)+dat_name) then begin + reset(dat,1); + 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; + rewrite(dat,1); + lw:=length(AMoeglich); + 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 + buff[i]:=buff[i] or (byte(AMoeglich[8*i+j]) shl j); 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; + blockWrite(dat,buff[0],length(buff)); + for i:=0 to length(buff)-1 do begin + buff[i]:=0; + for j:=0 to min(7,length(EMoeglich)-8*i-1) do + buff[i]:=buff[i] or (byte(EMoeglich[8*i+j]) shl j); end; + blockWrite(dat,buff[0],length(buff)); closefile(dat); end; {$ENDIF} @@ -442,21 +430,21 @@ var I,KS,KZ: Integer; W,S: Longint; begin + result:=false; {$IFDEF buchstaben} - if inhalt[Zeile*dim+Spalte]=-1 then begin + if inhalt[Zeile*dim+Spalte]=-1 then + exit; {$ENDIF} {$IFDEF hochhaus} - if inhalt[Zeile*dim+Spalte]=0 then begin - {$ENDIF} - result:=false; + if inhalt[Zeile*dim+Spalte]=0 then exit; - end; + {$ENDIF} W:=0; S:=0; for I:=0 to dim-1 do begin {$IFDEF buchstaben} - W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1; - S:=S*(NBuchst+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)+inhalt[Zeile*dim+I]; @@ -465,10 +453,10 @@ begin end; Result:= {$IFDEF buchstaben} - (EMoeglich[S*(NBuchst+1)+Rand[Spalte]] or not EMoeglich[S*(NBuchst+1)]) and - (AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] or not AMoeglich[W*(NBuchst+1)]) and - (AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] or not AMoeglich[S*(NBuchst+1)]) and - (EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]] or not EMoeglich[W*(NBuchst+1)]); + (EMoeglich[S*(groeszen[0]+1)+Rand[Spalte]] or not EMoeglich[S*(groeszen[0]+1)]) and + (AMoeglich[W*(groeszen[0]+1)+Rand[dim+Zeile]] or not AMoeglich[W*(groeszen[0]+1)]) and + (AMoeglich[S*(groeszen[0]+1)+Rand[2*dim+Spalte]] or not AMoeglich[S*(groeszen[0]+1)]) and + (EMoeglich[W*(groeszen[0]+1)+Rand[3*dim+Zeile]] or not EMoeglich[W*(groeszen[0]+1)]); {$ENDIF} {$IFDEF hochhaus} (EMoeglich[S*(dim+1)+Rand[Spalte]] or not EMoeglich[S*(dim+1)]) and @@ -478,7 +466,7 @@ begin {$ENDIF} {$IFDEF buchstaben} if inhalt[Zeile*dim+Spalte]=0 then - W:=NLeer + W:=groeszen[1] else {$ENDIF} W:=1; diff --git a/raetselunit.pas b/raetselunit.pas index b0cea36..6c77ce6 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -18,10 +18,11 @@ type tRaetsel = class private - besitzer: tForm; - zeichenflaeche: tImage; - erzeugeBtn: tButtonWithArrowKeys; - progressbar1: tProgressBar; + besitzer: tForm; + farbWahlFlaeche, + zeichenflaeche: tImage; + erzeugeBtn: tButtonWithArrowKeys; + progressbar1: tProgressBar; function besitzerHoehe: longint; dynamic; function besitzerBreite: longint; dynamic; procedure zeichenFlaecheNeuKreieren; @@ -60,6 +61,7 @@ type procedure schreibeZentriert(x,y,i: longint); procedure relativeInhaltsAenderung(diff: longint); dynamic; abstract; function absoluteInhaltsAenderung(key: word): boolean; dynamic; abstract; + procedure gesamtRaenderErzeugen; dynamic; abstract; public constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion); destructor destroy; override; @@ -285,6 +287,7 @@ begin setlength(rand,4*(dim+1)); loeschen; cursorPosition:=0; + gesamtRaenderErzeugen; aktualisiereZeichenflaechenGroesze; end; @@ -367,7 +370,7 @@ begin s:=uebersetze(i); with zeichenflaeche.canvas do begin brush.color:=$FFFFFF - $181818*byte(diagonalenCB.checked and ((x=y) or (x+y=dim+1))); - if not passtZumZeichnen(x,y) then + if (x>=0) and (y>=0) and (x