Free pascal 中国象棋源代码[By angwuy]中国象棋的源程序，中文模式下方可使用。

update：对修改程序向原作者angwuy道歉程序代码：typeqp=array[0..9,1..9]of shortint;constes:array['a'..'i']of byte=(1,2,3,4,5,6,7,8,9);se:array[ 1 .. 9 ]of char=('a','b','c','d','e','f','g','h','i'); ci:array['0'..'9']of byte=(0,1,2,3,4,5,6,7,8,9);qz:array[ 1 ..14 ]of string[2]=('車','馬','炮','仕','相','兵','帅','车','马','包','士','象','卒','将');yqp:qp=(( 8, 9,12,11,14,11,12, 9, 8),( 0, 0, 0, 0, 0, 0, 0, 0, 0),( 0,10, 0, 0, 0, 0, 0,10, 0),(13, 0,13, 0,13, 0,13, 0,13),( 0, 0, 0, 0, 0, 0, 0, 0, 0),( 0, 0, 0, 0, 0, 0, 0, 0, 0),( 6, 0, 6, 0, 6, 0, 6, 0, 6),( 0, 3, 0, 0, 0, 0, 0, 3, 0),( 0, 0, 0, 0, 0, 0, 0, 0, 0),( 1, 2, 5, 4, 7, 4, 5, 2, 1));vart,sx,sy,ex,ey,bushu:integer;qipan:qp;procedure initqp(var a:qp);var i,j:integer;beginfillchar(a,sizeof(a),0);for i:=1 to 9 dofor j:=0 to 9 doa[j,i]:=yqp[j,i];end;procedure print(q:qp);var i,j:integer;b:array[1..10,1..9]of string[2];beginwriteln;writeln('中国象棋[By angwuy]');writeln('红:帅仕相車馬炮兵');writeln('黑:将士象车马包卒');writeln;for i:=1 to 10 dofor j:=1 to 8 dob[i,j]:='+-';for i:=1 to 10 dob[i,9]:='-+';for i:=1 to 10 dofor j:=1 to 9 doif q[i-1,j]>0 then b[i,j]:=qz[q[i-1,j]];writeln(' a b c d e f g h i');writeln('0',b[1,1],'--',b[1,2],'--',b[1,3],'--',b[1,4],'--',b[1,5],'--',b[1 ,6],'--',b[1,7],'--',b[1,8],'-',b[1,9]);writeln(' | | | | \ | / | | | |');writeln('1',b[2,1],'--',b[2,2],'--',b[2,3],'--',b[2,4],'--',b[2,5],'--',b[2 ,6],'--',b[2,7],'--',b[2,8],'-',b[2,9]);writeln(' | | | | / | \ | | | |');writeln('2',b[3,1],'--',b[3,2],'--',b[3,3],'--',b[3,4],'--',b[3,5],'--',b[3 ,6],'--',b[3,7],'--',b[3,8],'-',b[3,9]);writeln(' | | | | | | | | |');writeln('3',b[4,1],'--',b[4,2],'--',b[4,3],'--',b[4,4],'--',b[4,5],'--',b[4 ,6],'--',b[4,7],'--',b[4,8],'-',b[4,9]);writeln(' | | | | | | | | |');writeln('4',b[5,1],'--',b[5,2],'--',b[5,3],'--',b[5,4],'--',b[5,5],'--',b[5 ,6],'--',b[5,7],'--',b[5,8],'-',b[5,9]);writeln(' | 楚河汉界 |');writeln('5',b[6,1],'--',b[6,2],'--',b[6,3],'--',b[6,4],'--',b[6,5],'--',b[6 ,6],'--',b[6,7],'--',b[6,8],'-',b[6,9]);writeln(' | | | | | | | | |');writeln('6',b[7,1],'--',b[7,2],'--',b[7,3],'--',b[7,4],'--',b[7,5],'--',b[7 ,6],'--',b[7,7],'--',b[7,8],'-',b[7,9]);writeln(' | | | | | | | | |');writeln('7',b[8,1],'--',b[8,2],'--',b[8,3],'--',b[8,4],'--',b[8,5],'--',b[8 ,6],'--',b[8,7],'--',b[8,8],'-',b[8,9]);writeln(' | | | | \ | / | | | |');writeln('8',b[9,1],'--',b[9,2],'--',b[9,3],'--',b[9,4],'--',b[9,5],'--',b[9,6],'--',b[9,7],'--',b[9,8],'-',b[9,9]);writeln(' | | | | / | \ | | | |');writeln('9',b[10,1],'--',b[10,2],'--',b[10,3],'--',b[10,4],'--',b[10,5],'--',b[10,6],'--',b[10,7],'--',b[10,8],'-',b[10,9]);end;function checkred(a:qp;sx,sy,ex,ey:integer):boolean;var i,j,t:integer;begincheckred:=true;if not(a[sy,sx] in [1..7]) then begin checkred:=false;exit;end; if a[ey,ex] in [1..7] then begin checkred:=false;exit;end;if (ey=sy)and(ex=sx) then begin checkred:=false;exit;end;case a[sy,sx] of1:beginif (ey=sy)or(ex=sx) then else begin checkred:=false;exit;end; if sx=ex thenbeginif ey>sy thenbeginfor i:=sy+1 to ey-1 doif a[i,sx]>0 then begin checkred:=false;exit;end;endelse if sy>ey thenbeginfor i:=sy-1 downto ey+1 doif a[i,sx]>0 then begin checkred:=false;exit;end;end;endelsebeginif ex>sx thenbeginfor i:=sx+1 to ex-1 doif a[sy,i]>0 then begin checkred:=false;exit;end;endelse if sy>ey thenbeginfor i:=sx-1 downto ex+1 doif a[sy,i]>0 then begin checkred:=false;exit;end;end;end;end;2:begini:=ey-sy;j:=ex-sx;if ((abs(i)=1)and(abs(j)=2))or((abs(i)=2)and(abs(j)=1)) thenelse begin checkred:=false;exit;end;if (j=2) thenbeginif a[sy,sx+1]>0 then begin checkred:=false;exit;end;endelse if (j=-2) thenbeginif a[sy,sx-1]>0 then begin checkred:=false;exit;end;endelse if (i=2) thenbeginif a[sy+1,sx]>0 then begin checkred:=false;exit;end;endelse if (i=-2) thenbeginif a[sy-1,sx]>0 then begin checkred:=false;exit;end;end;end;3:beginif (ey=sy)or(ex=sx) then else begin checkred:=false;exit;end; if sx=ex thenbeginif ey>sy thenbegint:=0;for i:=sy+1 to ey-1 doif a[i,sx]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkred:=false;exit;end;endelse if sy>ey thenbegint:=0;for i:=sy-1 downto ey+1 doif a[i,sx]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkred:=false;exit;end;end;end elseif sy=ey thenbeginif ex>sx thenbegint:=0;for i:=sx+1 to ex-1 doif a[sy,i]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkred:=false;exit;end;endelse if sx>ex thenbegint:=0;for i:=sx-1 downto ex+1 doif a[sy,i]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkred:=false;exit;end;end;end;end;4:begini:=ey-sy;j:=ex-sx;if (abs(i)=1)and(abs(j)=1) then else begin checkred:=false;exit;end;if (ey in [7..9])and(ex in [4..6]) then else begin checkred:=false;exit;end;end;5:begini:=ey-sy;j:=ex-sx;if (abs(i)=2)and(abs(j)=2) then else begin checkred:=false;exit;end;if a[(ey+sy)div 2,(ex+sx)div 2]>0 then begin checkred:=false;exit;end;if (ey in [9,7,5])and(ex in [1,3,5,7,9]) then else begin checkred:=false;exit;end;end;6:begini:=ey-sy;j:=ex-sx;if (i=-1)and(j=0) thenelse if (i=0)and(abs(j)=1)and(sy<5) thenelse begin checkred:=false;exit;end;end;7:begini:=ey-sy;j:=ex-sx;if ((abs(i)=1)and(j=0))or((abs(j)=1)and(i=0)) thenbeginif (ey in [7..9])and(ex in [4..6]) then else begin checkred:=false;exit;end;endelsebeginif a[ey,ex]<>14 then begin checkred:=false;exit;end;for i:=sy-1 downto ey+1 do if a[i,ex]>0 then begin checkred:=false;exit;end;end;end;end;end;function checkblack(a:qp;sx,sy,ex,ey:integer):boolean;var i,j,t:integer;begincheckblack:=true;if not(a[sy,sx] in [8..14]) then begin checkblack:=false;exit;end; if a[ey,ex] in [8..14] then begin checkblack:=false;exit;end;if (ey=sy)and(ex=sx) then begin checkblack:=false;exit;end;case a[sy,sx] of8:beginif (ey=sy)or(ex=sx) then else begin checkblack:=false;exit;end;if sx=ex thenbeginif ey>sy thenbeginfor i:=sy+1 to ey-1 doif a[i,sx]>0 then begin checkblack:=false;exit;end; endelse if sy>ey thenbeginfor i:=sy-1 downto ey+1 doif a[i,sx]>0 then begin checkblack:=false;exit;end; end;endelsebeginif ex>sx thenbeginfor i:=sx+1 to ex-1 doif a[sy,i]>0 then begin checkblack:=false;exit;end; endelse if sx>ex thenbeginfor i:=sx-1 downto ex+1 doif a[sy,i]>0 then begin checkblack:=false;exit;end; end;end;end;9:begini:=ey-sy;j:=ex-sx;if ((abs(i)=1)and(abs(j)=2))or((abs(i)=2)and(abs(j)=1)) thenelse begin checkblack:=false;exit;end;if (j=2) thenbeginif a[sy,sx+1]>0 then begin checkblack:=false;exit;end;endelse if (j=-2) thenbeginif a[sy,sx-1]>0 then begin checkblack:=false;exit;end;endelse if (i=2) thenbeginif a[sy+1,sx]>0 then begin checkblack:=false;exit;end;endelse if (i=-2) thenbeginif a[sy-1,sx]>0 then begin checkblack:=false;exit;end;end;end;10:beginif (ey=sy)or(ex=sx) then else begin checkblack:=false;exit;end;if sx=ex thenbeginif ey>sy thenbegint:=0;for i:=sy+1 to ey-1 doif a[i,sx]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkblack:=false;exit;end;endelse if sy>ey thenbegint:=0;for i:=sy-1 downto ey+1 doif a[i,sx]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkblack:=false;exit;end;end;end;if sy=ey thenbeginif ex>sx thenbegint:=0;for i:=sx+1 to ex-1 doif a[sy,i]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkblack:=false;exit;end;endelse if sx>ex thenbegint:=0;for i:=sx-1 downto ex+1 doif a[sy,i]>0 then inc(t);if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) thenelse begin checkblack:=false;exit;end;end;end;end;11:begini:=ey-sy;j:=ex-sx;if (abs(i)=1)and(abs(j)=1) then else begin checkblack:=false;exit;end;if (ey in [0..2])and(ex in [4..6]) then else begin checkblack:=false;exit;end;end;12:begini:=ey-sy;j:=ex-sx;if (abs(i)=2)and(abs(j)=2) then else begincheckblack:=false;exit;end;if a[(ey+sy)div 2,(ex+sx)div 2]>0 then begin checkblack:=false;exit;end;if (ey in [0,2,4])and(ex in [1,3,5,7,9]) then else begin checkblack:=false;exit;end;end;13:begini:=ey-sy;j:=ex-sx;if (i=1)and(j=0) thenelse if (i=0)and(abs(j)=1)and(sy>4) thenelse begin checkblack:=false;exit;end;end;14:begini:=ey-sy;j:=ex-sx;if ((abs(i)=1)and(j=0))or((abs(j)=1)and(i=0)) thenbeginif (ey in [0..2])and(ex in [4..6]) then else begin checkblack:=false;exit;end;endelsebeginif a[ey,ex]<>7 then begin checkblack:=false;exit;end;for i:=sy+1 to ey-1 do if a[i,ex]=0 then begin checkblack:=false;exit;end;end;end;end;end;procedure getline(var c1,c2,c3,c4:integer);var st:string;beginwhile true dobeginwrite('red:');readln(st);if not(st[1] in ['a'..'i']) then continue;if not(st[2] in ['0'..'9']) then continue;if not(st[3] in ['a'..'i']) then continue;if not(st[4] in ['0'..'9']) then continue;if copy(st,1,2)=copy(st,3,2) then continue;c1:=es[st[1]];c2:=ci[st[2]];c3:=es[st[3]];c4:=ci[st[4]];if checkred(qipan,c1,c2,c3,c4) then break;end;end;function fenzhi(q:qp):integer;var i,j,i1,j1:integer;begint:=0;for i:=1 to 9 dofor j:=0 to 9 dobeginif (q[j,i]=8)and(i in [2,4,6,8])and(bushu<30) then inc(t,10); if (q[i,j]=8)and(j in [1,4,6,7]) then inc(t,10);if (q[i,j]=8)and(j=3) then dec(t,5);if (q[j,i]=yqp[j,i])and(q[j,i] in [8..14])and(bushu<50) then dec(t,2);if (q[j,i] in [8..10,13])and(j>5)and(bushu>10) then inc(t,(14-q[j,i]));if (q[j,i]=13)and(q[j+2,i]=6)and(q[j+3,i]=2) then inc(t,10); if (q[j,i]=13)and(q[j-2,i]=9)and(q[j+2,i]=6) then inc(t,10); if (q[j,i]=8)and(j=1)and(i=5) then dec(t,40);case q[j,i] of1:dec(t,100);2:if bushu<30 then dec(t,40) else dec(t,50);3:if bushu<50 then dec(t,50) else dec(t,40);4,5:dec(t,20);6:if bushu<50 then dec(t,10)else if (j>5)or(j=0) then dec(t,20)else dec(t,30);7:dec(t,10000);8:inc(t,100);9:if bushu<30 then inc(t,40) else inc(t,50);10:if bushu<50 then inc(t,50) else inc(t,40);11,12:inc(t,20);13:if bushu<50 then inc(t,10)else if (j>5)or(j=0) then inc(t,20)else inc(t,30);14:inc(t,10000);end;end;if q[1,5] in[8,9,10,14] then dec(t,10);if (bushu<50)and(q[0,5]<>14) then dec(t,18);if (q[3,5]=3)and checkred(q,5,3,5,1) and (bushu<50) then dec(t,30); if (q[4,5]=3)and checkred(q,5,4,5,1) and (bushu<50) then dec(t,30); if (q[5,5]=3)and checkred(q,5,5,5,1) and (bushu<50) then dec(t,30); if (q[6,5]=3)and checkred(q,5,6,5,1) and (bushu<50) then dec(t,30); if (q[7,5]=3)and checkred(q,5,7,5,1) and (bushu<50) then dec(t,30);if (q[2,1]=12) then dec(t,18);if (q[2,9]=12) then dec(t,18);if (q[2,5]=12) then inc(t,10);if (q[2,5] in [1..9,10..13,14])and(q[4,5]=13)and(q[7,5] in [0,3]) then dec(t,10);if (bushu<10)and(q[2,5]=10) then inc(t,15);if (q[0,1]=8) then dec(t,25);if (q[0,9]=8) then dec(t,25);if (q[0,2]=9) then dec(t,18);if (q[0,8]=9) then dec(t,18);if (q[2,1]=9)and(q[2,9]=9) then dec(t,10);fenzhi:=t;end;function panfen(q:qp;dep:integer):integer;varqi1,qi2,hqi:qp;i1,i2,i3,i4,j1,j2,j3,j4,t,t1,t2:integer;beginif dep=0 thenbeginpanfen:=fenzhi(q);exit;end;t:=-32768;for i1:=1 to 9 dofor i2:=0 to 9 doif q[i2,i1] in [8..14] thenfor i3:=1 to 9 dofor i4:=0 to 9 doif checkblack(q,i1,i2,i3,i4) thenbeginqi1:=q;qi1[i4,i3]:=qi1[i2,i1];qi1[i2,i1]:=0;t1:=32767;for j1:=1 to 9 dofor j2:=0 to 9 doif q[j2,j1] in [1..7] thenfor j3:=1 to 9 dofor j4:=0 to 9 doif checkred(qi1,j1,j2,j3,j4) thenbeginqi2:=qi1;qi2[j4,j3]:=qi2[j2,j1];qi2[j2,j1]:=0;t2:=panfen(qi2,0);if t2<=t1 then begin t1:=t2;hqi:=qi2;end;end;if t1<-5000 then continue;t1:=panfen(hqi,dep-1);if t1>t thenbegint:=t1;end;end;panfen:=t;end;procedure searchblack(q:qp;var c1,c2,c3,c4:integer);varqi1,qi2,hqi:qp;i1,i2,i3,i4,j1,j2,j3,j4,t,h1,h2,h3,h4,t1,t2:integer;begint:=-32768;for i1:=1 to 9 dofor i2:=0 to 9 doif q[i2,i1] in [8..14] thenfor i3:=1 to 9 dofor i4:=0 to 9 doif checkblack(q,i1,i2,i3,i4) thenbeginqi1:=q;qi1[i4,i3]:=qi1[i2,i1];qi1[i2,i1]:=0;if fenzhi(qi1)>5000 then begin c1:=i1;c2:=i2;c3:=i3;c4:=i4;exit;end;t1:=32767;for j1:=1 to 9 dofor j2:=0 to 9 doif q[j2,j1] in [1..7] thenfor j3:=1 to 9 dofor j4:=0 to 9 doif checkred(qi1,j1,j2,j3,j4) thenbeginqi2:=qi1;qi2[j4,j3]:=qi2[j2,j1];qi2[j2,j1]:=0;t2:=panfen(qi2,0);if t2<=t1 then begin t1:=t2;hqi:=qi2;end;end;if t1<-5000 then continue;t1:=panfen(hqi,1);if t1>t thenbegint:=t1;h1:=i1;h2:=i2;h3:=i3;h4:=i4;end;end;c1:=h1;c2:=h2;c3:=h3;c4:=h4;end;beginwriteln('使用说明：输入包括4个字符，分别为字母和数字，字母数字'); writeln('前面两个表示你要移动的那个子现在的坐标，后面代表目标坐标'); initqp(qipan);print(qipan);bushu:=1;while true dobegingetline(sx,sy,ex,ey);qipan[ey,ex]:=qipan[sy,sx];qipan[sy,sx]:=0;writeln('busy...');searchblack(qipan,sx,sy,ex,ey);writeln('black:',se[sx],sy,se[ex],ey);qipan[ey,ex]:=qipan[sy,sx];qipan[sy,sx]:=0;inc(bushu,2);print(qipan);end;end.。