1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure loesen;
    procedure schachbrett;
    { Public-Deklarationen }
  end;

const qu_x=8; qu_y=8;
var
  Form1: TForm1;

implementation

{$R *.dfm}

type
Twege= record
  zahlen:array[1..8] of shortint;
end;

const
k_wege:array[0..63] of Twege=
(
//1-8
(zahlen:(1,8,9,-1,-1,-1,-1,-1)),
(zahlen:(0,2,8,9,10,-1,-1,-1)),
(zahlen:(1,3,9,10,11,-1,-1,-1)),
(zahlen:(2,4,10,11,12,-1,-1,-1)),
(zahlen:(3,5,11,12,13,-1,-1,-1)),
(zahlen:(4,6,12,13,14,-1,-1,-1)),
(zahlen:(5,7,13,14,15,-1,-1,-1)),
(zahlen:(6,14,15,-1,-1,-1,-1,-1)),
//9-16
(zahlen:(0,1,9,16,17,-1,-1,-1)),
(zahlen:(0,1,2,8,10,16,17,18)),
(zahlen:(1,2,3,9,11,17,18,19)),
(zahlen:(2,3,4,10,12,18,19,20)),
(zahlen:(3,4,5,11,13,19,20,21)),
(zahlen:(4,5,6,12,14,20,21,22)),
(zahlen:(5,6,7,13,15,21,22,23)),
(zahlen:(6,7,14,22,23,-1,-1,-1)),
//17-24
(zahlen:(8,9,17,24,25,-1,-1,-1)),
(zahlen:(8,9,10,16,18,24,25,26)),
(zahlen:(9,10,11,17,19,25,26,27)),
(zahlen:(10,11,12,18,20,26,27,28)),
(zahlen:(11,12,13,19,21,27,28,29)),
(zahlen:(12,13,14,20,22,28,29,30)),
(zahlen:(13,14,15,21,23,29,30,31)),
(zahlen:(14,15,22,30,31,-1,-1,-1)),
//25-32
(zahlen:(16,17,25,32,33,-1,-1,-1)),
(zahlen:(16,17,18,24,26,32,33,34)),
(zahlen:(17,18,19,25,27,33,34,35)),
(zahlen:(18,19,20,26,28,34,35,36)),
(zahlen:(19,20,21,27,29,35,36,37)),
(zahlen:(20,21,22,28,30,36,37,38)),
(zahlen:(21,22,23,29,31,37,38,39)),
(zahlen:(23,22,30,38,39,-1,-1,-1)),
//33-40
(zahlen:(24,25,33,40,41,-1,-1,-1)),
(zahlen:(24,25,26,32,34,40,41,42)),
(zahlen:(25,26,27,33,35,41,42,43)),
(zahlen:(26,27,28,34,36,42,43,44)),
(zahlen:(27,28,29,35,37,43,44,45)),
(zahlen:(28,29,30,36,38,44,45,46)),
(zahlen:(29,30,31,37,39,45,46,47)),
(zahlen:(31,30,38,46,47,-1,-1,-1)),
//41-48
(zahlen:(32,33,41,48,49,-1,-1,-1)),
(zahlen:(32,33,34,40,42,48,49,50)),
(zahlen:(33,34,35,41,43,49,50,51)),
(zahlen:(34,35,36,42,44,50,51,52)),
(zahlen:(35,36,37,43,45,51,52,53)),
(zahlen:(36,37,38,44,46,52,53,54)),
(zahlen:(37,38,39,45,47,53,54,55)),
(zahlen:(39,38,46,54,55,-1,-1,-1)),
//49-56
(zahlen:(40,41,49,56,57,-1,-1,-1)),
(zahlen:(40,41,42,48,50,56,57,58)),
(zahlen:(41,42,43,49,51,57,58,59)),
(zahlen:(42,43,44,50,52,58,59,60)),
(zahlen:(43,44,45,51,53,59,60,61)),
(zahlen:(44,45,46,52,54,60,61,62)),
(zahlen:(45,46,47,53,55,61,62,63)),
(zahlen:(47,46,54,62,63,-1,-1,-1)),
//56-64
(zahlen:(48,49,57,-1,-1,-1,-1,-1)),
(zahlen:(48,49,50,56,58,-1,-1,-1)),
(zahlen:(49,50,51,57,59,-1,-1,-1)),
(zahlen:(50,51,52,58,60,-1,-1,-1)),
(zahlen:(51,52,53,59,61,-1,-1,-1)),
(zahlen:(52,53,54,60,62,-1,-1,-1)),
(zahlen:(53,54,55,61,63,-1,-1,-1)),
(zahlen:(55,54,62,-1,-1,-1,-1,-1))
);

k_anz:array[0..63] of byte=
(3,5,5,5,5,5,5,3,
 5,8,8,8,8,8,8,5,
 5,8,8,8,8,8,8,5,
 5,8,8,8,8,8,8,5,
 5,8,8,8,8,8,8,5,
 5,8,8,8,8,8,8,5,
 5,8,8,8,8,8,8,5,
 3,5,5,5,5,5,5,3);
var //brett1: array of array of shortint; //2-Dimens. dynamisches Array
    wk,sk,wt,st:int64;



function Bittest (TestZahl : int64;Bitnr: byte):boolean;
//var
//  Bitmaske : int64;
begin
  {Bitmaske := 1 shl BitNr;
  result := TestZahl AND BitMaske <> 0;}
  //result := int64(1) AND BitMaske <> 0;
  //result := testzahl AND (1 shl BitNr) <> 0;
  Result := (testzahl and (Int64(1) shl bitnr)) <> 0;
  //result := int64(1) shl bitnr;
end;


procedure BitSet(var TestZahl : int64;Bitnr: byte);
var bitmaske:int64;
begin
  //TestZahl := testzahl OR (1 shl BitNr);
  bitmaske := Int64(1) shl bitnr;
  testzahl:= bitmaske or testzahl;
end;

procedure BitClear(var TestZahl : int64;Bitnr: byte);
var bitmaske:int64;
begin
  //TestZahl := TestZahl AND NOT(1 shl BitNr);
  bitmaske:= Int64(1) shl bitnr;
  testzahl:= bitmaske xor testzahl;
end;



(*------------------------------------------------------------*)
(*Ein Schachbrett mit Canvas direkt auf das Formular ausgeben *)
(*Einfache Grafikmethode ganz ohne bitmaps                    *)
(*------------------------------------------------------------*)
procedure TForm1.schachbrett;
const a_x=60; a_y=30;
      max_laenge=220;
var feld_lx, feld_ly:Integer; //feld_lx und feld_ly Feldlänge
    z,x,y:byte;

    procedure m(f:shortint);
    begin
      form1.Canvas.TextOut(               //In das Feld die Figur schreiben
        (a_x+x*feld_lx)+(feld_lx div 2)-3,
        (a_y+y*feld_ly)+(feld_ly div 2)-5, inttostr(f));
    end;

begin
  form1.Canvas.Rectangle(a_x-25,a_y-25,a_x+max_laenge+25,a_y+max_laenge+25);
  feld_lx:=max_laenge div qu_x;  // Feldlänge x
  feld_ly:=max_laenge div qu_y;  // Feldlänge y
  for z:=0 to 63 do begin
    y:=((z) div 8);
    x:=((z) mod 8);
  {for y:=1 to 8 do begin
    for x:=1 to 8 do begin
   }

    if (x+y) mod 2=0 then form1.Canvas.Brush.Color:=rgb(180,180,180) else
    form1.Canvas.Brush.Color:=rgb(120,120,120);   //Farbwechsel
    form1.Canvas.rectangle              //das Quadrat auf die Form zeichnen
    (a_x+x*feld_lx,a_y+y*feld_ly,
     a_x+((x+1)*feld_lx)+1,a_y+((y+1)*feld_ly)+1);

     if bittest(wt,z) then m(5);
     if bittest(st,z) then m(-5);
     if bittest(wk,z) then m(1);
     if bittest(sK,z) then m(-1);
     update;

  end;
  //form1.Canvas.Brush.style:=bsclear;
  sleep(700);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  {loesen;}
  wK:=0; sK:=0; wt:=0; st:=0;
  bitset(wK,0);
  bitset(sk,7);
  bitset(wt,63);
  //bitset(sk,15);
  //wK:=wK xor wKa8[1];
  //bitset(wk,9);
  {bitset(wK,41);
  bitset(wK,39);
  bitclear(wk,40);
  bitclear(wK,39);}

  label1.Caption:=inttostr(wk);
  label2.Caption:=inttostr(sk);
  schachbrett;
  loesen;


end;



procedure TForm1.FormCreate(Sender: TObject);
var y:byte;
begin
  // Alles auf 0 setzen
  {for y:=0 to 7 do begin
    leer[y]:=0;
    wk[y]:=0;wd[y]:=0; wt[y]:=0; wl[y]:=0; ws[y]:=0; wb[y]:=0;
    sk[y]:=0;sd[y]:=0; st[y]:=0; sl[y]:=0; ss[y]:=0; sb[y]:=0;
  end; }
  // Initalisieren
  {bitset(wk[7],0);
  bitset(sk[0],0);}
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  //schachbrett; beep;
end;



procedure TForm1.loesen;

type ge=record
          weg:array[1..8] of byte;
        end;
var wk_var,sk_var,wfigart,sfigart:byte;
    leiter, wk_von, sk_von:array of byte;
    maske: array of int64;
    wk_leiterweg: array of ge;
    sk_leiterweg: array of ge;
    wk_bestleiter, sk_bestleiter: array[0..63] of ge;
    aus,guteleiter,gezogen:boolean;
    x,n:byte;
    tiefe,maxtiefe:byte;    //die aktuelle Tiefe, Maxtiefe
begin
  aus:=false;
  maxtiefe:=2;
  tiefe:=0;

  setlength(leiter,maxtiefe+1);
  setlength(wk_von,maxtiefe+1);
  setlength(sk_von,maxtiefe+1);
  setlength(maske,maxtiefe+1);
  setlength(wk_leiterweg,maxtiefe+1);
  setlength(sk_leiterweg,maxtiefe+1);

  (* Init *)
  for n:=0 to 63 do begin
    for x:=1 to 8 do begin
      wk_bestleiter[n].weg[x]:=x;
      sk_bestleiter[n].weg[x]:=x;
    end;
  end;

  for x:=0 to maxtiefe do begin
    leiter[x]:=0;
    maske[x]:=0;
  end;
  for x:=0 to 63 do begin
    if bittest(wk,x) then wK_var:=x;
    if bittest(sk,x) then sK_var:=x;
  end;
  wfigart:=1;
  wk_bestleiter[1].weg[1]:=1;
  wk_bestleiter[1].weg[2]:=3;
  wk_bestleiter[1].weg[3]:=2;

  sk_bestleiter[1].weg[1]:=1;
  sk_bestleiter[1].weg[2]:=3;
  sk_bestleiter[1].weg[3]:=2;

  repeat
    (*  *)
    inc(tiefe);
    //repeat

    if odd(tiefe) then begin //Weiss
      case wfigart of
        (* König *)
      1:begin
          gezogen:=false;
          //repeat
          inc(leiter[tiefe]);
          if leiter[tiefe]<=k_anz[wk_var] then begin
            guteleiter:=true;
            {if k_wege[wk_var].zahlen[leiter[tiefe]]=8 then begin
              guteleiter:=false;
              dec(tiefe);
            end;}
            (* der K soll den anderen K nicht beruehren*)
            for n:=1 to k_anz[wk_var] do begin
              if bittest
              (sk, k_wege [K_wege[wk_var].zahlen[wk_bestleiter[tiefe].weg[leiter[tiefe]]]]. zahlen[n] ) then begin
                guteleiter:=false;
                dec(tiefe);
                break;
              end;
            end;

            if guteleiter then begin
              gezogen:=true;
              maske[tiefe]:=0;

              wk_von[tiefe]:=wk_var;
              (* erstelle Maske *)
              bitset(maske[tiefe],wk_var); //von
              bitset(maske[tiefe],k_wege[wk_var].zahlen[wk_bestleiter[tiefe].weg[leiter[tiefe]]]);//nach

              wk_var:=k_wege[wk_var].zahlen[leiter[tiefe]];  //nach
              //inc(leiter[tiefe]);
              (* Ziehe *)
              wK:=wK xor maske[tiefe];;
              schachbrett;
            end;
          end else begin
            if tiefe=1 then begin
              aus:=true;
            end else begin
              leiter[tiefe]:=0;
              dec(tiefe);
              if gezogen then
              sk:=sK xor maske[tiefe];
              sk_var:=sk_von[tiefe];
              dec(tiefe);
              schachbrett;
            end;
          end;
          //until (guteleiter) or (x=64);
        end;

        {(* Turm *)

        end; }

      end; (*case*)
    end else begin //Schwarz
        (* König *)
        begin
          gezogen:=false;
          //repeat
          inc(leiter[tiefe]);
          if leiter[tiefe]<=k_anz[sk_var] then begin
            guteleiter:=true;

            (* der K soll den anderen K nicht beruehren*)
            for n:=1 to k_anz[sk_var] do begin
              if bittest
              (wk, k_wege [K_wege[sk_var].zahlen[sk_bestleiter[tiefe].weg[leiter[tiefe]]]]. zahlen[n] ) then begin
                guteleiter:=false;
                dec(tiefe);
                break;
              end;
            end;

            if guteleiter then begin
              gezogen:=true;
              maske[tiefe]:=0;

              sk_von[tiefe]:=sk_var;
              (* erstelle Maske *)
              bitset(maske[tiefe],sK_var);  //von
              bitset(maske[tiefe],k_wege[sk_var].zahlen[sk_bestleiter[tiefe].weg[leiter[tiefe]]]);//nach

              sk_var:=k_wege[sk_var].zahlen[leiter[tiefe]]; //nach
              //inc(leiter[tiefe]);
              (* ziehe *)
              sK:=sK xor maske[tiefe];
              schachbrett;
            end;
          end else begin
            leiter[tiefe]:=0;
            dec(tiefe);
            (* zurueck *)
            wK:=wK xor maske[tiefe];
            wk_var:=wK_von[tiefe];

            dec(tiefe);
            schachbrett;
          end;
          //until (guteleiter) or (x=64);;
        end;
      end;
    //until x>63;

    if tiefe=maxtiefe then begin
      if odd(tiefe) then begin
        (* zurueck *)
        wK:=wK xor maske[tiefe];
        wk_var:=wk_von[tiefe];

        dec(tiefe);
        schachbrett;
      end else begin
        (* zurueck *)
        sK:=sK xor maske[tiefe];
        sk_var:=sK_von[tiefe];

        dec(tiefe);
        schachbrett;
      end;
    end;
  until aus;

end;

end.