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 public procedure loesen; procedure schachbrett; 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= ( (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)), (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)), (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)), (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)), (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)), (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)), (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)), (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 wk,sk,wt,st:int64;
function Bittest (TestZahl : int64;Bitnr: byte):boolean; begin Result := (testzahl and (Int64(1) shl bitnr)) <> 0; end;
procedure BitSet(var TestZahl : int64;Bitnr: byte); var bitmaske:int64; begin bitmaske := Int64(1) shl bitnr; testzahl:= bitmaske or testzahl; end;
procedure BitClear(var TestZahl : int64;Bitnr: byte); var bitmaske:int64; begin bitmaske:= Int64(1) shl bitnr; testzahl:= bitmaske xor testzahl; end;
procedure TForm1.schachbrett; const a_x=60; a_y=30; max_laenge=220; var feld_lx, feld_ly:Integer; z,x,y:byte;
procedure m(f:shortint); begin form1.Canvas.TextOut( (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; feld_ly:=max_laenge div qu_y; for z:=0 to 63 do begin y:=((z) div 8); x:=((z) mod 8);
if (x+y) mod 2=0 then form1.Canvas.Brush.Color:=rgb(180,180,180) else form1.Canvas.Brush.Color:=rgb(120,120,120); form1.Canvas.rectangle (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; sleep(700); end;
procedure TForm1.Button1Click(Sender: TObject); begin wK:=0; sK:=0; wt:=0; st:=0; bitset(wK,0); bitset(sk,7); bitset(wt,63);
label1.Caption:=inttostr(wk); label2.Caption:=inttostr(sk); schachbrett; loesen;
end;
procedure TForm1.FormCreate(Sender: TObject); var y:byte; begin end;
procedure TForm1.FormPaint(Sender: TObject); begin 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; 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);
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); if odd(tiefe) then begin case wfigart of 1:begin gezogen:=false; inc(leiter[tiefe]); if leiter[tiefe]<=k_anz[wk_var] then begin guteleiter:=true; 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; bitset(maske[tiefe],wk_var); bitset(maske[tiefe],k_wege[wk_var].zahlen[wk_bestleiter[tiefe].weg[leiter[tiefe]]]); wk_var:=k_wege[wk_var].zahlen[leiter[tiefe]]; 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; end;
end; end else begin begin gezogen:=false; inc(leiter[tiefe]); if leiter[tiefe]<=k_anz[sk_var] then begin guteleiter:=true;
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; bitset(maske[tiefe],sK_var); bitset(maske[tiefe],k_wege[sk_var].zahlen[sk_bestleiter[tiefe].weg[leiter[tiefe]]]); sk_var:=k_wege[sk_var].zahlen[leiter[tiefe]]; sK:=sK xor maske[tiefe]; schachbrett; end; end else begin leiter[tiefe]:=0; dec(tiefe); wK:=wK xor maske[tiefe]; wk_var:=wK_von[tiefe];
dec(tiefe); schachbrett; end; end; end; if tiefe=maxtiefe then begin if odd(tiefe) then begin wK:=wK xor maske[tiefe]; wk_var:=wk_von[tiefe];
dec(tiefe); schachbrett; end else begin sK:=sK xor maske[tiefe]; sk_var:=sK_von[tiefe];
dec(tiefe); schachbrett; end; end; until aus;
end;
end. |