buchstabenunit.pas,hochhausunit.pas -> raetselunit.inc

1 files changed, 439 insertions, 0 deletions

diff --git a/raetselunit.inc b/raetselunit.inc
new file mode 100644
index 0000000..57e68fd
--- /dev/null
+++ b/raetselunit.inc
@@ -0,0 +1,439 @@
+{$IFDEF interface}
+
+type
+{$IFDEF hochhaus}
+  tHochhausRaetsel = class(tFelderRaetsel)
+{$ENDIF}
+{$IFDEF buchstaben}
+  tBuchstabenRaetsel = class(tFelderRaetsel)
+{$ENDIF}
+  private
+//    procedure relativeInhaltsAenderung(diff: longint); override;
+//    function absoluteInhaltsAenderung(key: word): boolean; override;
+  public
+    {$IFDEF buchstaben}
+    NBuchst,
+    NLeer,
+    {$ENDIF}
+    NSqrt:               integer;
+    AMoeglich,EMoeglich: array of boolean;
+    constructor create(aOwner: tForm);
+    destructor destroy; override;
+    procedure gesamtRaenderErzeugen;
+(*    function  passtZumZeichnen(Spalte,Zeile: integer): boolean;
+    procedure Zeichnen;
+    procedure schreibe(was: String; Spalte,Zeile: integer); *)
+    function  passt(spalte,zeile: integer): boolean; override;
+//    function  Loesen(lPos: integer): boolean;
+    function  geloest: boolean;
+(*    procedure leeren;
+    procedure RandErzeugen;
+    function  anzLoesungen(lPos: integer): integer;
+    procedure Image2Bemalen; *)
+  end;
+
+{$IFDEF hochhaus}
+function zahlenAlphabetFunktion(i: longint): string;
+{$ENDIF}
+{$IFDEF buchstaben}
+function buchstabenAlphabetFunktion(i: longint): string;
+{$ENDIF}
+        
+{$ENDIF}
+
+{$IFDEF alphabetFunktion}
+// function *AlphabetFunktion(i: longint): string;
+begin
+  if i<0 then
+    result:=''
+  else if i=0 then
+    result:='-'
+{$IFDEF hochhaus}
+  else
+    result:=inttostr(i);
+{$ENDIF}
+{$IFDEF buchstaben}
+  else begin
+    result:='';
+    while i>0 do begin
+      dec(i);
+      result:=char(ord('A')+(i mod 26))+result;
+      i:=i div 26;
+    end;
+  end;
+{$ENDIF}
+end;
+{$ENDIF}
+
+{$IFDEF create}
+// constructor tHochhausRaetsel.create(aOwner: tForm);
+begin
+{$IFDEF hochhaus}
+  inherited create(aOwner,1,@zahlenAlphabetFunktion);
+  spinEdits[1].showHint:=true;
+  spinEdits[1].hint:='Anzahl Spalten';
+  spinEdits[1].value:=5;
+{$ENDIF}
+{$IFDEF buchstaben}
+  inherited create(aOwner,2,@buchstabenAlphabetFunktion);
+  spinEdits[1].showHint:=true;
+  spinEdits[1].hint:='Anzahl Buchstaben';
+  spinEdits[1].value:=5;
+  spinEdits[2].showHint:=true;
+  spinEdits[2].hint:='Anzahl Leerfelder';
+  spinEdits[2].value:=1;
+{$ENDIF}
+  aktualisiereGroesze;
+end;
+{$ENDIF}
+
+{$IFDEF destroy}
+// destructor tHochhausRaetsel.destroy;
+begin
+  inherited destroy;
+end;
+{$ENDIF}
+
+{$IFDEF passt}
+// function  tHochhausRaetsel.passt(spalte,zeile: integer): boolean;
+var
+  I,KZ,KS: Integer;
+  W,S,K:   Longint;
+begin
+  W:=0;
+  S:=0;
+  K:=0;
+  if sudokuCB.checked then begin
+    KZ:=(Zeile div dim)*dim;
+    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;
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      W:=W*(dim+1)+inhalt[Zeile*dim+I];
+      S:=S*(dim+1)+inhalt[I*dim+Spalte];
+      K:=K*(dim+1)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)];
+      {$ENDIF}
+    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]];
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      AMoeglich[K*(dim+1)] and
+      EMoeglich[S*(dim+1)+Rand[Spalte]] and
+      AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
+      AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
+      EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
+      {$ENDIF}
+  end
+  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;
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      W:=W*(dim+1)+inhalt[Zeile*dim+I];
+      S:=S*(dim+1)+inhalt[I*dim+Spalte];
+      {$ENDIF}
+    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]];
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      EMoeglich[S*(dim+1)+Rand[Spalte]] and
+      AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
+      AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
+      EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
+      {$ENDIF}
+  end;
+  if diagonalenCB.checked then begin
+    if Zeile=Spalte then 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)];
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      for I:=0 to dim-1 do
+        W:=W*(dim+1)+inhalt[I*(dim+1)];
+      result:=result and AMoeglich[W*(dim+1)];
+      {$ENDIF}
+    end;
+    if Zeile+Spalte=dim-1 then 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)];
+      {$ENDIF}
+      {$IFDEF hochhaus}
+      for I:=0 to dim-1 do
+        W:=W*(dim+1)+inhalt[(I+1)*(dim-1)];
+      Result:=Result and AMoeglich[W*(dim+1)];
+      {$ENDIF}
+    end;
+  end;
+end;
+{$ENDIF}
+
+{$IFDEF geloest}
+// function  tHochhausRaetsel.geloest: boolean;
+var
+  i,j: integer;
+begin
+  result:=false;
+  for i:=0 to dim-1 do
+    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)
+    {$ENDIF}
+    then exit;
+  result:=true;
+end;
+{$ENDIF}
+
+{$IFDEF gesamtRaenderErzeugen}
+// procedure tHochhausRaetsel.gesamtRaenderErzeugen;
+var
+  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;
+  dat:               File of Cardinal;
+  lw1,lw2,L:         Cardinal;
+
+const dat_name =
+{$IFDEF buchstaben}
+  'Buchstabenraetsel.dat';
+{$ENDIF}
+{$IFDEF hochhaus}
+  'Hochhausraetsel.dat';
+{$ENDIF}
+
+function calcNums(I: Longint): tLongintArray;
+var
+  J: Integer;
+begin
+  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;
+var
+  j: integer;
+begin
+  Result:=0;
+  For j:=0 to dim-1 do
+    Result:=Result*Basis + Nums[dim-J-1];
+end;
+
+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;
+  end;
+end;
+
+begin
+  {$IFDEF buchstaben}
+  Basis:=NBuchst+2;
+  Faktor:=NBuchst+1;
+  {$ENDIF}
+  {$IFDEF hochhaus}
+  Basis:=dim+1;
+  Faktor:=dim+1;
+  {$ENDIF}
+  AK:=round(power(Basis,dim)*Faktor);
+
+  if (length(AMoeglich) = AK) and
+     (length(EMoeglich) = AK) then
+    exit;
+
+  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;
+
+  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 buchstaben}
+    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);
+    {$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]);
+    end;
+    {$ENDIF}
+    if B then begin
+      EK:=swapIndex(AK);
+      AR:=0;
+      {$IFNDEF buchstaben}
+      AZ:=0;
+      {$ENDIF}
+      For I:=0 to dim-1 do begin
+        {$IFDEF buchstaben}
+        if Nums[I]>1 then begin
+          AR:=Nums[I]-1;
+          break;
+        end;
+        {$ENDIF}
+        {$IFDEF hochhaus}
+        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)*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;
+      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);
+            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;
+
+  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);
+end;
+{$ENDIF}