主题:[原创]中国象棋
先输入要走棋的坐标,比如说开局时的炮位,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;