回 帖 发 新 帖 刷新版面

主题:[原创]中国象棋

走法: 
先输入要走棋的坐标,比如说开局时的炮位,b7;然后输入要走到的坐标,比如说中兵后面那个位置,e7;刚开局的炮二平五就输入b7e7.
type 
qp=array[0..9,1..9]of shortint; 
const 
es: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)); 
var 
t,sx,sy,ex,ey,bushu:integer; 
qipan:qp; 
procedure initqp(var a:qp); 
var i,j:integer; 
begin 
fillchar(a,sizeof(a),0); 
for i:=1 to 9 do 
for j:=0 to 9 do 
a[j,i]:=yqp[j,i]; 
end; 
procedure print(q:qp); 
var i,j:integer; 
b:array[1..10,1..9]of string[2]; 
begin 
for i:=1 to 6 do writeln; 
writeln('中国象棋软件[Made by 王禹]'); 
writeln('红:帅仕相車馬炮兵'); 
writeln('黑:将士象车马包卒'); 
writeln; 
for i:=1 to 10 do 
for j:=1 to 8 do 
b[i,j]:='+-'; 
for i:=1 to 10 do 
b[i,9]:='-+'; 
for i:=1 to 10 do 
for j:=1 to 9 do 
if 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; 
begin 
checkred:=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] of 
1:begin 
if (ey=sy)or(ex=sx) then else begin checkred:=false;exit;end; 
if sx=ex then 
begin 
if ey>sy then 
begin 
for i:=sy+1 to ey-1 do 
if a[i,sx]>0 then begin checkred:=false;exit;end; 
end 
else if sy>ey then 
begin 
for i:=sy-1 downto ey+1 do 
if a[i,sx]>0 then begin checkred:=false;exit;end; 
end; 
end 
else 
begin 
if ex>sx then 
begin 
for i:=sx+1 to ex-1 do 
if a[sy,i]>0 then begin checkred:=false;exit;end; 
end 
else if sy>ey then 
begin 
for i:=sx-1 downto ex+1 do 
if a[sy,i]>0 then begin checkred:=false;exit;end; 
end; 
end; 
end; 
2:begin 
i:=ey-sy;j:=ex-sx; 
if ((abs(i)=1)and(abs(j)=2))or((abs(i)=2)and(abs(j)=1)) then 
else begin checkred:=false;exit;end; 
if (j=2) then 
begin 
if a[sy,sx+1]>0 then begin checkred:=false;exit;end; 
end 
else if (j=-2) then 
begin 
if a[sy,sx-1]>0 then begin checkred:=false;exit;end; 
end 
else if (i=2) then 
begin 
if a[sy+1,sx]>0 then begin checkred:=false;exit;end; 
end 
else if (i=-2) then 
begin 
if a[sy-1,sx]>0 then begin checkred:=false;exit;end; 
end; 
end; 
3:begin 
if (ey=sy)or(ex=sx) then else begin checkred:=false;exit;end; 
if sx=ex then 
begin 
if ey>sy then 
begin 
t:=0; 
for i:=sy+1 to ey-1 do 
if a[i,sx]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkred:=false;exit;end; 
end 
else if sy>ey then 
begin 
t:=0; 
for i:=sy-1 downto ey+1 do 
if a[i,sx]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkred:=false;exit;end; 
end; 
end else 
if sy=ey then 
begin 
if ex>sx then 
begin 
t:=0; 
for i:=sx+1 to ex-1 do 
if a[sy,i]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkred:=false;exit;end; 
end 
else if sx>ex then 
begin 
t:=0; 
for i:=sx-1 downto ex+1 do 
if a[sy,i]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkred:=false;exit;end; 
end; 
end; 
end; 
4:begin 
i:=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:begin 
i:=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:begin 
i:=ey-sy;j:=ex-sx; 
if (i=-1)and(j=0) then 
else if (i=0)and(abs(j)=1)and(sy<5) then 
else begin checkred:=false;exit;end; 
end; 
7:begin 
i:=ey-sy;j:=ex-sx; 
if ((abs(i)=1)and(j=0))or((abs(j)=1)and(i=0)) then 
begin 
if (ey in [7..9])and(ex in [4..6]) then else begin checkred:=false;exit;end; 

end 
else 
begin 
if 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; 
begin 
checkblack:=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] of 
8:begin 
if (ey=sy)or(ex=sx) then else begin checkblack:=false;exit;end; 
if sx=ex then 
begin 
if ey>sy then 
begin 
for i:=sy+1 to ey-1 do 
if a[i,sx]>0 then begin checkblack:=false;exit;end; 
end 
else if sy>ey then 
begin 
for i:=sy-1 downto ey+1 do 
if a[i,sx]>0 then begin checkblack:=false;exit;end; 
end; 
end 
else 
begin 
if ex>sx then 
begin 
for i:=sx+1 to ex-1 do 
if a[sy,i]>0 then begin checkblack:=false;exit;end; 
end 
else if sx>ex then 
begin 
for i:=sx-1 downto ex+1 do 
if a[sy,i]>0 then begin checkblack:=false;exit;end; 
end; 
end; 
end; 
9:begin 
i:=ey-sy;j:=ex-sx; 
if ((abs(i)=1)and(abs(j)=2))or((abs(i)=2)and(abs(j)=1)) then 
else begin checkblack:=false;exit;end; 
if (j=2) then 
begin 
if a[sy,sx+1]>0 then begin checkblack:=false;exit;end; 
end 
else if (j=-2) then 
begin 
if a[sy,sx-1]>0 then begin checkblack:=false;exit;end; 
end 
else if (i=2) then 
begin 
if a[sy+1,sx]>0 then begin checkblack:=false;exit;end; 
end 
else if (i=-2) then 
begin 
if a[sy-1,sx]>0 then begin checkblack:=false;exit;end; 
end; 
end; 
10:begin 
if (ey=sy)or(ex=sx) then else begin checkblack:=false;exit;end; 
if sx=ex then 
begin 
if ey>sy then 
begin 
t:=0; 
for i:=sy+1 to ey-1 do 
if a[i,sx]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkblack:=false;exit;end; 
end 
else if sy>ey then 
begin 
t:=0; 
for i:=sy-1 downto ey+1 do 
if a[i,sx]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkblack:=false;exit;end; 
end; 
end; 
if sy=ey then 
begin 
if ex>sx then 
begin 
t:=0; 
for i:=sx+1 to ex-1 do 
if a[sy,i]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkblack:=false;exit;end; 
end 
else if sx>ex then 
begin 
t:=0; 
for i:=sx-1 downto ex+1 do 
if a[sy,i]>0 then inc(t); 
if ((t=0)and(a[ey,ex]=0))or((t=1)and(a[ey,ex]>0)) then 
else begin checkblack:=false;exit;end; 
end; 
end; 
end; 
11:begin 
i:=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:begin 
i:=ey-sy;j:=ex-sx; 
if (abs(i)=2)and(abs(j)=2) then else begin checkblack:=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:begin 
i:=ey-sy;j:=ex-sx; 
if (i=1)and(j=0) then 
else if (i=0)and(abs(j)=1)and(sy>4) then 
else begin checkblack:=false;exit;end; 
end; 
14:begin 
i:=ey-sy;j:=ex-sx; 
if ((abs(i)=1)and(j=0))or((abs(j)=1)and(i=0)) then 
begin 
if (ey in [0..2])and(ex in [4..6]) then else begin checkblack:=false;exit;end; 

end 
else 
begin 
if 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; 
begin 
while true do 
begin 
write('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; 

回复列表 (共10个回复)

沙发

function fenzhi(q:qp):integer; 
var i,j,i1,j1:integer; 
begin 
t:=0; 
for i:=1 to 9 do 
for j:=0 to 9 do 
begin 
if (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] of 
1: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; 
var 
qi1,qi2,hqi:qp; 
i1,i2,i3,i4,j1,j2,j3,j4,t,t1,t2:integer; 
begin 
if dep=0 then 
begin 
panfen:=fenzhi(q); 
exit; 
end; 

t:=-32768; 
for i1:=1 to 9 do 
for i2:=0 to 9 do 
if q[i2,i1] in [8..14] then 
for i3:=1 to 9 do 
for i4:=0 to 9 do 
if checkblack(q,i1,i2,i3,i4) then 
begin 
qi1:=q; 
qi1[i4,i3]:=qi1[i2,i1]; 
qi1[i2,i1]:=0; 
t1:=32767; 
for j1:=1 to 9 do 
for j2:=0 to 9 do 
if q[j2,j1] in [1..7] then 
for j3:=1 to 9 do 
for j4:=0 to 9 do 
if checkred(qi1,j1,j2,j3,j4) then 
begin 
qi2:=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 then 
begin 
t:=t1; 
end; 
end; 
panfen:=t; 
end; 
procedure searchblack(q:qp;var c1,c2,c3,c4:integer); 
var 
qi1,qi2,hqi:qp; 
i1,i2,i3,i4,j1,j2,j3,j4,t,h1,h2,h3,h4,t1,t2:integer; 
begin 
t:=-32768; 
for i1:=1 to 9 do 
for i2:=0 to 9 do 
if q[i2,i1] in [8..14] then 
for i3:=1 to 9 do 
for i4:=0 to 9 do 
if checkblack(q,i1,i2,i3,i4) then 
begin 
qi1:=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 do 
for j2:=0 to 9 do 
if q[j2,j1] in [1..7] then 
for j3:=1 to 9 do 
for j4:=0 to 9 do 
if checkred(qi1,j1,j2,j3,j4) then 
begin 
qi2:=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 then 
begin 
t:=t1;h1:=i1;h2:=i2;h3:=i3;h4:=i4; 
end; 
end; 
c1:=h1;c2:=h2;c3:=h3;c4:=h4; 
end; 
begin 
initqp(qipan); 
print(qipan);bushu:=1; 
while true do 
begin 
getline(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. 

板凳

强悍!!
建议使用CRT单元中的一些函数,可以实现按键操作。输坐标实在是太麻烦了。具体方法可以参考我写的扫雷,在我的BLOG(http://blog.sina.com.cn/u/1077089055)上有代码!

3 楼

我试过,但在crt模式下显示不出汉字,所以我才这样弄

4 楼

可以尝试用图像的方法,呵呵
不过这个我就不会了。。。

5 楼

用图象就太麻烦了,还不如用delphi

6 楼

好厉害啊!!
我也建议用图像单元Graph Unit
其实图像不麻烦。
首先在Turbo Pascal的帮助查找InitGraph过程,然后把里面的例程复制出来,完成图像初始化。
用Line过程画棋盘,
先用bar再用circle画棋子,
用setcolor设置颜色,
可以用Rectangle画光标……
用[url]http://www.programfan.com/club/showbbs.asp?id=104444[/url]显示中文。
只需要把程序的所有write过程改掉,然后用crt unit加入键盘控制(你说试过的,把以前试的代码复制过来就行)。

7 楼

那我尽量试试吧

8 楼


有文件吗?????????????

9 楼

[quote]
writeln('中国象棋软件[Made by 王禹]'); [/quote]

我终于明白angwuy这个词是什么意思了......XD

10 楼

顺便说一下,delphi的中国象棋已经出来了
http://upload.programfan.com/upfile/200708021121971.rar

我来回复

您尚未登录,请登录后再回复。点此登录或注册