象棋(双人版)Freepascal源代码
type Coordinate = (X, Y); //自定义横纵坐标类型
Players = -1..1; //将选手分为-1和1两种类型
const ChessBoard: array[-9..9, -9..9] of shortstring
=((' ','╔','═','╤','═','╤','═','╤','═','╤','═','╤','═','╤','═','╤','═','╗',' '),
(' ','║',' ','│',' ','│',' ','│','＼','│','／','│',' ','│',' ','│',' ','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','╳','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║','┘','│','└','│',' ','│','／','│','＼','│',' ','│','┘','│','└','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║','┐','│','┌','│',' ','│',' ','│',' ','│',' ','│','┐','│','┌','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║',' ','│',' ','│',' ','│',' ','│',' ','│',' ','│',' ','│',' ','║',' '),
(' ','╟','─','┴','─','┴','─','┴','─','┴','─','┴','─','┴','─','┴','─','╢',' '),
(' ','║',' ',' ','楚',' ','河',' ',' ',' ',' ',' ','汉',' ','界',' ',' ','║',' '),
(' ','╟','─','┬','─','┬','─','┬','─','┬','─','┬','─','┬','─','┬','─','╢',' '),
(' ','║',' ','│',' ','│',' ','│',' ','│',' ','│',' ','│',' ','│',' ','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║','┘','│','└','│',' ','│',' ','│',' ','│',' ','│','┘','│','└','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║','┐','│','┌','│',' ','│','＼','│','／','│',' ','│','┐','│','┌','║',' '),
(' ','╟','─','┼','─','┼','─','┼','─','╳','─','┼','─','┼','─','┼','─','╢',' '),
(' ','║',' ','│',' ','│',' ','│','／','│','＼','│',' ','│',' ','│',' ','║',' '),
(' ','╚','═','╧','═','╧','═','╧','═','╧','═','╧','═','╧','═','╧','═','╝',' '));
Chesses: array[-9..9] of shortstring
= ('〗','〖','卒','士','象','马','炮','车','将',' ',
'帥','車','炮','馬','象','士','兵','【','】'); //方框代表选中,正负代表不同阵营
var Chess: array[-11..11, -10..10] of shortint; //记录是否存在棋子,存在那种棋子,外围多出两层用于减少下标范围测量
SelectCdn: array[Players, Coordinate] of shortint; //记录对应选手所选
中的棋子坐标
GoNumber: array[1..17, Coordinate] of shortint; //记录所选棋子可走的步伐,最多不超过17种可走情况
GoBefore: array[1..17] of shortint; //记录被可走步伐代码取代的原有棋子
Player: Players; //记录当前执棋玩家是谁
Step: word; //记录帅方以走步数
Ways: byte; //Ways记录已选棋子可移动位置总可能性个数
{ 重新开盘, 整理棋子 }
Procedure MakeUp;
var I: shortint;
begin
fillchar(Chess, sizeof(Chess), 0); //0代表无棋子
SelectCdn[-1, X] := 0; SelectCdn[1, X] := 0;
SelectCdn[-1, Y] :=-9; SelectCdn[1, Y] := 9; //初始化选中棋子的方框,这些会被当做数组下标来使用
Chess[-9, 0] := -1; Chess[9 , 0] := 1; Chess[-3, 0] := -7; Chess[3 , 0] := 7;
Chess[-9, -2] := -6; Chess[9 , -2] := 6; Chess[-9, 2] := -6; Chess[9 , 2] := 6;
Chess[-9, -4] := -5; Chess[9 , -4] := 5; Chess[-9, 4] := -5; Chess[9 , 4] := 5;
Chess[-9, -6] := -4; Chess[9 , -6] := 4; Chess[-9, 6] := -4; Chess[9 , 6] := 4;
Chess[-9, -8] := -2; Chess[9 , -8] := 2; Chess[-9, 8] := -2; Chess[9 , 8] := 2;
Chess[-5, -6] := -3; Chess[5 , -6] := 3; Chess[-5, 6] := -3; Chess[5 , 6] := 3;
Chess[-3, -8] := -7; Chess[3 , -8] := 7; Chess[-3, 8] := -7; Chess[3 , 8] := 7;
Chess[-3, -4] := -7; Chess[3 , -4] := 7; Chess[-3, 4] := -7; Chess[3 , 4] := 7; //初始化棋子坐标
end;
{ 输出棋盘和棋子 }
procedure OutPut;
var I, T: shortint;
begin
writeln;
for I := -9 to 9 do
begin
write(' ');
for T := -9 to 9 do
if Chess[I, T] = 0 then write(ChessBoard[I, T]) //判断是否不存在棋子，Chess[I, T]=0则不存在并输出棋盘字符
else
if Chess[I, T] > 10 then
begin
if Chess[I, T] < 20 then write('*', Chess[I, T] mod 10) //输出准备选择的棋子代号
else write(Chess[I, T] - 10);
end
else write(Chesses[Chess[I, T]]); //判断是否存在棋子，Chess[I, T]<>0则存在并输出棋子字符
writeln;
end;
writeln; writeln;
end;
{ 清除原先选中的棋子方框 }
procedure ClearSquare;
var X1, X2: boolean;
begin
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]-1] := 0;
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]+1] := 0;
if (SelectCdn[Player, Y] = SelectCdn[-Player, Y]) then //判断是否在同一行
begin
if SelectCdn[Player, X] = SelectCdn[-Player, X] + 2 then
begin
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]-1] := -Player * 9; //对方选中棋子在左边则
在离开时恢复对方右方框防止方框丢失
X1 := false;
end;
if SelectCdn[Player, X] = SelectCdn[-Player, X] - 2 then
begin
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]+1] := -Player * 8; //对方选中棋子在右边则在离开时恢复对方左方框防止方框丢失
X2 := false;
end;
end;
end;
{ 选择棋子 }
{Const XX: array[1..9] of shortint = (-8,-6,-4,-2,0,2,4,6,8);
YY: array[1..10] of shortint = (-9,-7,-5,-3,-1,1,3,5,7,9);}
procedure Select(Player: Players);
var Cdn: array[1..5, Coordinate] of shortint; //记录所选类型的棋子坐标,一种类型最多5个棋子
SelectType, M, I, T, K: shortint; //记录所选的棋子类型-7到7
begin
repeat
if Player = -1 then
begin
writeln(' 1.将; 2.車; 3.炮; 4.馬; 5.象; 6.士; 7.卒; 将方已走 ',Step - 1,' 步');
write('请 将方 输入以上数字后按回车键: ');
end
else
begin
writeln(' 1.帥; 2.車; 3.炮; 4.馬; 5.象; 6.士; 7.兵; 帥方已走 ',Step,' 步');
write('请 帥方 输入以上数字后按回车键: ');
end;
readln(SelectType);
until (0 < SelectType) and (SelectType < 8);
SelectType := Player * SelectType; //将SelectType转换为对应选手的棋子代号
K := 10; I := -9;
while I <= 9 do
begin
T := -8;
while T <= 8 do
begin
if Chess[I, T] = SelectType then
begin
inc(K);
Chess[I, T] := K; //判断是否存在所选择的棋子,是则写入棋子代号
Cdn[K mod 10, Y] := i;
Cdn[K mod 10, X] := T;
end;
inc(T, 2);
end;
inc(I, 2);
end;
if K = 10 then
begin
writeln('无法移动此棋子');
Select(Player);
end
else
if K = 11 then
begin
ClearSquare;
Chess[Cdn[1, Y], Cdn[1, X]] := SelectType; //恢复所转换棋子类型为对应的字符
SelectCdn[Player, Y] := Cdn[1, Y];
SelectCdn[Player, X] := Cdn[1, X]; //记录选中棋子坐标
Chess[Cdn[1, Y], Cdn[1, X]-1] := Player * 8;
Chess[Cdn[1, Y], Cdn[1, X]+1] := Player * 9; //重新写入方框
end
else
begin
OutPut;
writeln;
repeat
write('请输入要移动的棋子代号(输入0重新选择): '); readln(M);
until (0 <= M) and (M <= K mod 10);
for T := 1 to K mod 10 do
Chess[Cdn[T, Y], Cdn[T, X]] := SelectType; //恢复所转换棋子类型为对应的字符
if M <> 0 then
begin
ClearSquare;
SelectCdn[Player, Y] := Cdn[M, Y];
SelectCdn[Player, X] := Cdn[M, X]; //记录选中棋子坐标
Chess[SelectCdn[Player, Y], SelectCdn[Play
er, X]-1] := Player * 8;
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]+1] := Player * 9; //重新写入方框
end
else
begin
OutPut;
Select(Player);
end;
end;
end;
procedure MoveBing;
const XX: array[1..3] of shortint = (-2,2,0);
YY: array[1..3] of shortint = ( 0,0,2);
var I, A, B: byte;
begin
Ways := 0; A := 3; B := 3;
if SelectCdn[Player, Y] * Player <= 0 then A := 1; //判断是否进入对方区域
if (abs(SelectCdn[Player, Y] - 2*Player) > 9) then B := 2; //判断是否到最后一行
for I := A to B do
if (abs(SelectCdn[Player, X] + XX[I]) <= 8)
and (Chess[SelectCdn[Player, Y] - Player * YY[I], SelectCdn[Player, X] + XX[I]] * Player <= 0) then //判断前进方向是否不存在自己的棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] - Player * YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + XX[I]; //记录可移动的坐标
GoBefore[Ways] := Chess[GoNumber[Ways, Y], GoNumber[Ways, X]]; //记录被代号取代的原有棋子
end;
end;
procedure MovePao;
const Xxx: array[1..4] of shortint = ( 0,0,-2, 2);
Yyy: array[1..4] of shortint = (-2,2, 0, 0);
var XX, YY: shortint;
I, T: byte;
begin
Ways := 0;
for I := 1 to 4 do
begin
XX := Xxx[I]; YY := Yyy[I];
for T := 1 to 2 do
begin
while (abs(SelectCdn[Player, X] + XX) <= 8)
and (abs(SelectCdn[Player, Y] + YY) <= 9) //判断是否跃出边界
and (Chess[SelectCdn[Player, Y] + YY, SelectCdn[Player, X] + XX] = 0) do //判断前方是否有棋子
begin
if T = 1 then
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY;
GoNumber[Ways, X] := SelectCdn[Player, X] + XX; //不存在则记录可移动位置
GoBefore[Ways] := Chess[GoNumber[Ways, Y], GoNumber[Ways, X]]; //记录被代号取代的原有棋子
end;
inc(YY, Yyy[I]); inc(XX, Xxx[I]);
end;
inc(YY, Yyy[I]); inc(XX, Xxx[I]);
end;
dec(YY, Yyy[I]); dec(XX, Xxx[I]);
if (abs(SelectCdn[Player, X] + XX) <= 8)
and (abs(SelectCdn[Player, Y] + YY) <= 9)
and (Chess[SelectCdn[Player, Y] + YY, SelectCdn[Player, X] + XX] * Player < 0) then
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY;
GoNumber[Ways, X] := SelectCdn[Player, X] + XX; //不存在则记录可移动位置
GoBefore[Ways] := Chess[GoNumber[Ways, Y], GoNumber[Ways, X]]; //记录被代号取代的原有棋子
end;
end;
end;
procedure MoveChe;
const Xxx: array[1..4] of
shortint = ( 0,0,-2, 2);
Yyy: array[1..4] of shortint = (-2,2, 0, 0);
var XX, YY: shortint;
I, T: byte;
begin
Ways := 0;
for I := 1 to 4 do
begin
XX := Xxx[I]; YY := Yyy[I];
while (abs(SelectCdn[Player, X] + XX) <= 8)
and (abs(SelectCdn[Player, Y] + YY) <= 9) //判断是否跃出边界
and (Chess[SelectCdn[Player, Y] + YY, SelectCdn[Player, X] + XX] = 0) do //判断前方是否有棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY;
GoNumber[Ways, X] := SelectCdn[Player, X] + XX; //不存在则记录可移动位置
GoBefore[Ways] := Chess[GoNumber[Ways, Y], GoNumber[Ways, X]]; //记录被代号取代的原有棋子
inc(YY, Yyy[I]); inc(XX, Xxx[I]);
end;
if (abs(SelectCdn[Player, X] + XX) <= 8)
and (abs(SelectCdn[Player, Y] + YY) <= 9)
and (Chess[SelectCdn[Player, Y] + YY, SelectCdn[Player, X] + XX] * Player < 0) then
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY;
GoNumber[Ways, X] := SelectCdn[Player, X] + XX; //不存在则记录可移动位置
GoBefore[Ways] := Chess[GoNumber[Ways, Y], GoNumber[Ways, X]]; //记录被代号取代的原有棋子
end;
end;
end;
procedure MoveMa;
const XX: array[1..8] of shortint = (-2,2,-2, 2,-4,-4,4, 4);
YY: array[1..8] of shortint = ( 4,4,-4,-4, 2,-2,2,-2);
var I: byte;
begin
Ways := 0;
for I := 1 to 8 do
if (abs(SelectCdn[Player, X] + XX[I]) <= 8) and (abs(SelectCdn[Player, Y] + YY[I]) <= 9) //判断马是否越界
and (Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]] * Player <= 0) then //判断是否不存在自己的棋子
begin
if I < 5 then
begin
if Chess[SelectCdn[Player, Y] + YY[I] div 2, SelectCdn[Player, X]] * Player = 0 then //判断象脚是否不存在棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + XX[I]; //不存在则记录可移动位置
GoBefore[Ways] := Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]]; //记录被代号取代的原有棋子
end;
end
else
if Chess[SelectCdn[Player, Y], SelectCdn[Player, X] + XX[I] div 2] * Player = 0 then //判断象脚是否不存在棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + XX[I]; //不存在则记录可移动位置
GoBefore[
Ways] := Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]]; //记录被代号取代的原有棋子
end;
end;
end;
procedure MoveXiang;
const XX: array[1..4] of shortint = (-2,2,-2, 2);
YY: array[1..4] of shortint = ( 2,2,-2,-2);
var I: byte;
begin
Ways := 0;
for I := 1 to 4 do
if (abs(SelectCdn[Player, X] + XX[I]) <= 8) and (abs(SelectCdn[Player, Y] + YY[I]) <= 9)
and ((SelectCdn[Player, Y] + YY[I] ) * Player > 0) then //判断将帅是否越界
if Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]] * Player = 0 then //判断象脚是否不存在棋子
if Chess[SelectCdn[Player, Y] + 2*YY[I], SelectCdn[Player, X] + 2*XX[I]] * Player <= 0 then //判断目标位置是否不存在自己的棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + 2*YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + 2*XX[I]; //不存在则记录可移动位置
GoBefore[Ways] := Chess[SelectCdn[Player, Y] + 2*YY[I], SelectCdn[Player, X] + 2*XX[I]]; //记录被代号取代的原有棋子
end;
end;
procedure Moveshi;
const XX: array[1..4] of shortint = (-2,2,-2, 2);
YY: array[1..4] of shortint = ( 2,2,-2,-2);
var I: shortint;
begin
Ways := 0;
if SelectCdn[Player, X] <> 0 then //判断士是否在中间位置
begin
if Chess[7*Player, 0] * Player <= 0 then //判断中间位置是否不存在自己的棋子
begin
inc(Ways);
GoNumber[Ways, Y] := 7*Player;
GoNumber[Ways, X] := 0; //不存在则记录可移动位置
GoBefore[Ways] := Chess[7*Player, 0]; //记录被代号取代的原有棋子
end;
end
else
for I := 1 to 4 do
if Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]] * Player <= 0 then //判断目标位置是否不存在自己的棋子
begin
inc(Ways);
GoNumber[Ways, Y] := SelectCdn[Player, Y] + YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + XX[I]; //不存在则记录可移动位置
GoBefore[Ways] := Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]]; //记录被代号取代的原有棋子
end;
end;
procedure MoveJiang;
const XX: array[1..4] of shortint = (0, 0,-2, 2);
YY: array[1..4] of shortint = (2,-2, 0, 0);
var I: byte;
begin
Ways := 0;
for I := 1 to 4 do
if (abs(SelectCdn[Player, Y] + YY[I]) >= 5)
and (abs(SelectCdn[Player, Y] + YY[I]) <= 9)
and (abs(SelectCdn[Player, X] + XX[I]) <= 2)
and (Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]] * Player <= 0) then //判断外侧是否不存在自己的棋子
begin
inc(Ways);
GoNumber
[Ways, Y] := SelectCdn[Player, Y] + YY[I];
GoNumber[Ways, X] := SelectCdn[Player, X] + XX[I]; //不存在则记录可移动位置
GoBefore[Ways] := Chess[SelectCdn[Player, Y] + YY[I], SelectCdn[Player, X] + XX[I]]; //记录被代号取代的原有棋子
end;
end;
procedure Choose;
begin
Select(Player);
case Chess[SelectCdn[Player, Y], SelectCdn[Player, X]] of
1, -1: MoveJiang;
2, -2: MoveChe;
3, -3: MovePao;
4, -4: MoveMa;
5, -5: MoveXiang;
6, -6: MoveShi;
7, -7: MoveBing;
end;
end;
procedure Move;
var I, M: byte;
begin
for I := 1 to Ways do
Chess[GoNumber[I, Y], GoNumber[I, X]] := i + 10; //写入可选位置编号
OutPut;
writeln;
if Ways <> 0 then
begin
repeat
write('请输入要要移动的位置(输入0重新选择): '); readln(M);
until (0 <= M) and (M <= Ways);
if M <> 0 then
begin
Chess[GoNumber[M, Y], GoNumber[M, X]] := Chess[SelectCdn[Player, Y], SelectCdn[Player, X]]; //棋子目的移动位置写入字符
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]] := 0; //清除棋子原有位置字符
ClearSquare;
SelectCdn[Player, Y] := GoNumber[M, Y];
SelectCdn[Player, X] := GoNumber[M, X]; //记录选中棋子坐标
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]-1] := Player * 8;
Chess[SelectCdn[Player, Y], SelectCdn[Player, X]+1] := Player * 9; //重新写入方框
for I := 1 to Ways do
if I <> M then Chess[GoNumber[I, Y], GoNumber[I, X]] := GoBefore[I]; //将编号恢复成原有字符
OutPut;
end
else
begin
for I := 1 to Ways do
Chess[GoNumber[I, Y], GoNumber[I, X]] := GoBefore[I];
OutPut;
Choose;
Move;
end;
end
else
begin
writeln('无法移动此棋子');
Choose;
Move;
end;
end;
function Win: boolean;
var YY, XX: shortint;
begin
Win := true;
YY := -9;
while YY <= 9 do
begin
XX := -2;
while XX <= 2 do
begin
if Chess[YY, XX] = Player then Win := false;
inc(XX, 2);
end;
inc(YY, 2);
end;
end;
begin
MakeUp;
OutPut;
Player := 1;
repeat
Choose;
Move;
if Player = 1 then inc(Step);
Player := -Player;
until win;
writeln;
write('You Win');
readln;
end.
{ 编译生成的exe文件可以运行 }