📄 xqdatat.pas
字号:
// 取得棋谱记录的最后一位数字的值
iNum := Ord(sRecStr[4]) - Ord('0');
if ((iNum<1)or(iNum>9)) then Exit;
// 根据移动的方向计算目标点的坐标
case sRecStr[3] of
'.': // Traverse (平移)
begin
case wp of
wpRed: Xt := 9 - iNum;
wpBlk: Xt := iNum - 1;
end;
end;
'+', '-': // Advance, Retreat (前进或后退)
begin
// 设置进退步数的乘法因子
iDy := 0;
case sRecStr[3] of
'+': iDy := +1;
'-': iDy := -1;
end;
case sRecStr[1] of
'R','r','K','k','C','c','P','p','+','-':
begin // 车将炮兵
case wp of
wpRed: Yt := Yt + iDy*iNum;
wpBlk: Yt := Yt - iDy*iNum;
end;
end;
'H', 'h': // 马
begin
case wp of
wpRed:
begin
iDx := (9-iNum) - Xt;
// 判断水平方向移动的距离
case abs(iDx) of
1: begin Xt := 9 - iNum; Yt := Yt + iDy*2; end;
2: begin Xt := 9 - iNum; Yt := Yt + iDy*1; end;
else Exit;
end;
end;
wpBlk:
begin
iDx := (iNum-1) - Xt;
case abs(iDx) of
1: begin Xt := iNum - 1; Yt := Yt - iDy*2; end;
2: begin Xt := iNum - 1; Yt := Yt - iDy*1; end;
else Exit;
end;
end;
end;
end;
'E', 'e': // 象
begin
case wp of
wpRed: begin Xt := 9 - iNum; Yt := Yt + iDy*2; end;
wpBlk: begin Xt := iNum - 1; Yt := Yt - iDy*2; end;
end;
end;
'A', 'a': // 士
begin
case wp of
wpRed: begin Xt := 9 - iNum; Yt := Yt + iDy*1; end;
wpBlk: begin Xt := iNum - 1; Yt := Yt - iDy*1; end;
end;
end;
end;
end;
else Exit;
end;
XYf := Xf * 10 + Yf;
XYt := Xt * 10 + Yt;
if (sGetPlayRecStr(qzXY, XYf, XYt, False)='') then Exit;
Result := XYf;
Result := Result shl 8;
Result := Result + XYt;
end;
//-------------------------------------------------------------------------
// 中国象棋大师用的格式
// BZxjZcCZZZZZZBZZZZZZZmZZZZZZZZZbZZZZZZZZZZZZZ
// ZZZZZZZZZPZZZBZZZZXZZZZZZZXZZZZbZZZZZZZJZZZbZ
// B : Bing
// Z :
// x : Xiang
// s : Shi;
// j : Jiang
// c : Che
// m : Ma
// p : Pao
//.........................................................................
procedure d90PosCharToXQZXY(var qzXY: dTXQZXY; s90Char: string);
var
i, j, x, y, XY: dTInt32;
begin
for i:=1 to 32 do qzXY[i] := $FF;
for i:=1 to 90 do
begin
x := (i-1) mod 9;
y := 9 - (i-1) div 9;
XY := x*10 + y;
case s90Char[i] of
'C': if (qzXY[01]=$FF) then qzXY[01]:=XY else qzXY[09]:=XY;
'M': if (qzXY[02]=$FF) then qzXY[02]:=XY else qzXY[08]:=XY;
'X': if (qzXY[03]=$FF) then qzXY[03]:=XY else qzXY[07]:=XY;
'S': if (qzXY[04]=$FF) then qzXY[04]:=XY else qzXY[06]:=XY;
'J': qzXY[05]:=XY;
'P': if (qzXY[10]=$FF) then qzXY[10]:=XY else qzXY[11]:=XY;
'B': for j:=12 to 16 do if qzXY[j]=$FF then
begin
qzXY[j]:=XY; break;
end;
'c': if (qzXY[17]=$FF) then qzXY[17]:=XY else qzXY[25]:=XY;
'm': if (qzXY[18]=$FF) then qzXY[18]:=XY else qzXY[24]:=XY;
'x': if (qzXY[19]=$FF) then qzXY[19]:=XY else qzXY[23]:=XY;
's': if (qzXY[20]=$FF) then qzXY[20]:=XY else qzXY[22]:=XY;
'j': qzXY[21]:=XY;
'p': if (qzXY[26]=$FF) then qzXY[26]:=XY else qzXY[27]:=XY;
'b': for j:=28 to 32 do if qzXY[j]=$FF then
begin
qzXY[j]:=XY; break;
end;
'Z': begin end;
else
begin
ShowMessage('Error Character');
end;
end;
end;
end;
//-------------------------------------------------------------------------
// 从两个局势的差别计算出棋子移动的坐标
//.........................................................................
procedure dXQZXYtoXYfXYt(var XYf, XYt: dTByte; qzXYf, qzXYt: dTXQZXY);
var
i: dTInt32;
begin
XYf:=$FF; XYt:=$FF;
for i:=1 to 32 do
begin
if (qzXYf[i] <> qzXYt[i]) then
begin
if (qzXYt[i]<>$FF) then
begin
XYf := qzXYf[i]; XYt := qzXYt[i]; Exit;
end;
end;
end;
end;
procedure dMakeQiTuText(var mem: TMemo; sRed, sBlk: String;
qzXY:dTXQZXY; wp: dTWhoPlay; iMode: integer; bRL: Boolean;
bBbsColor:Boolean);
var
i : integer;
s, sBlank: string[128];
sMemText : string;
procedure dInsertQiZiToQiTuText(iIdx, iPos: integer);
var
iTopLine, iLeftLine : integer;
sQZName : string[6];
sQPLine : string[128];
iX,iY, iC: integer;
begin
case iIdx of
01,09,17,25: sQZName := '车';
02,08,18,24: sQZName := '马';
03,07 : sQZName := '相';
19,23 : sQZName := '象';
04,06,20,22: sQZName := '士';
05 : sQZName := '帅';
21 : sQZName := '将';
10,11,26,27: sQZName := '炮';
12..16 : sQZName := '兵';
28..32 : sQZName := '卒';
else Exit;
end;
case iIdx of
1..16: sQZName := '-(' + sQZName + ')-';
17..32: sQZName := '-[' + sQZName + ']-';
end;
iTopLine := 3;
iLeftLine := 0;
iX := iPos div 10; if bRL then iX := 8 - iX;
iX := iX * 4 + iLeftLine;
iY := iPos mod 10; iY := (9-iY) * 2 + iTopLine;
sQPLine := mem.Lines[iY];
for iC :=1 to Length(sQZName) do
begin
if ((sQPLine[iX + iC]=' ') and (sQZName[iC]='-')) then Continue;
if (sQPLine[iX + iC] in ['(',')','[',']']) then Continue;
sQPLine[iX + iC] := sQZName[iC];
end;
mem.Lines[iY] := sQPLine;
end;
begin
// 设置文本的宽度，用空白行表示
case iMode of
0: sBlank := ' ';
1: sBlank := ' ';
end;
mem.Lines.Add('');
// 加入黑方棋手姓名
sBlk := '黑方 ' + sBlk; sBlk := Trim(sBlk);
if (Length(sBlk) >= Length(sBlank)) then
begin
s := sBlk;
end
else
begin
s := sBlank;
Insert(sBlk, s, (Length(s)-Length(sBlk)) div 2 + 1);
SetLength(S, Length(s) - Length(sBlk));
end;
mem.Lines.Add(s);
mem.Lines.Add(sBlank); // 加入空行
// 设置棋盘的格式
mem.Lines.Add(' ┌─┬─┬─┬─┬─┬─┬─┬─┐ ');
mem.Lines.Add(' │ │ │ │＼│／│ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─※─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │／│＼│ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─┼─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │ │ │ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─┼─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │ │ │ │ │ │ ');
mem.Lines.Add(' ├─┴─┴─┴─┴─┴─┴─┴─┤ ');
mem.Lines.Add(' │ │ ');
mem.Lines.Add(' ├─┬─┬─┬─┬─┬─┬─┬─┤ ');
mem.Lines.Add(' │ │ │ │ │ │ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─┼─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │ │ │ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─┼─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │＼│／│ │ │ │ ');
mem.Lines.Add(' ├─┼─┼─┼─※─┼─┼─┼─┤ ');
mem.Lines.Add(' │ │ │ │／│＼│ │ │ │ ');
mem.Lines.Add(' └─┴─┴─┴─┴─┴─┴─┴─┘ ');
mem.Lines.Add(sBlank);
// 加入红方棋手姓名
sRed := '红方 ' + sRed; sRed := Trim(sRed);
if (Length(sRed) >= Length(sBlank)) then
begin
s := sRed;
end
else
begin
s := sBlank;
Insert(sRed, s, (Length(s)-Length(sRed)) div 2 + 1);
SetLength(S, Length(s) - Length(sRed));
end;
mem.Lines.Add(s);
// 设置32个棋子的位置(使用标准格式，带有[]和()的文本格式)
for i:=1 to 32 do
begin
if (qzXY[i] = $FF) then Continue;
dInsertQiZiToQiTuText(i, qzXY[i]);
end;
// 根据不同的格式重新调整显示
case iMode of
0: // 标准格式
begin
//for i:=0 to 22 do
//begin
// mem.Lines[i] := '| ' + mem.Lines[i];
//end;
end;
1: // 纯汉字表示
begin
s := ' ';
mem.Lines[ 1] := mem.Lines[ 1] + s;
mem.Lines[ 2] := mem.Lines[ 2] + s;
mem.Lines[22] := mem.Lines[22] + s;
mem.Lines[23] := mem.Lines[23] + s;
for i:=21 downto 3 do
begin
if ((i Mod 2)=0) then
begin
mem.Lines.Delete(i);
Continue;
end;
s := mem.Lines[i];
s := StringReplace(s, '(车)', '砗', [rfReplaceAll]);
s := StringReplace(s, '(马)', '码', [rfReplaceAll]);
s := StringReplace(s, '[炮]', '包', [rfReplaceAll]);
s := StringReplace(s, '(士)', '仕', [rfReplaceAll]);
s := StringReplace(s, '[', '', [rfReplaceAll]);
s := StringReplace(s, ']', '', [rfReplaceAll]);
s := StringReplace(s, '(', '', [rfReplaceAll]);
s := StringReplace(s, ')', '', [rfReplaceAll]);
s := StringReplace(s, ' ', '', [rfReplaceAll]);
s := StringReplace(s, '─', '', [rfReplaceAll]);
s := StringReplace(s, '-', '', [rfReplaceAll]);
case i of
3: s := s + ' 红 黑 ';
5: s := s + ' ─ ─ ';
7: s := s + ' 砗 车 ';
9: s := s + ' 码 马 ';
11: s := s + ' 相 象 ';
13: s := s + ' 仕 士 ';
15: s := s + ' 帅 将 ';
17: s := s + ' 炮 包 ';
19: s := s + ' 兵 卒 ';
21:
begin
case wp of
wpRed: s := s + ' (红方行棋)';
wpBlk: s := s + ' (黑方行棋)';
end;
end;
end;
mem.Lines[i] := s;
end; // End of for;
mem.Lines.Insert(1, '───────────────');
mem.Lines.Append( '───────────────');
end;
end;
// 将半角的空格替换为全角的空格
for i:= 0 to (mem.Lines.Count - 1) do
begin
s := mem.Lines[i];
s := StringReplace(s, ' ', ' ', [rfReplaceAll]);
mem.Lines[i] := s;
end;
if (bBbsColor) then
begin
sMemText := mem.Text;
case iMode of
0: // 标准格式
begin
sMemText := StringReplace(sMemText, '[', #27#27'[1;32m[', [rfReplaceAll]);
sMemText := StringReplace(sMemText, ']', ']'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '(', #27#27'[1;31m(', [rfReplaceAll]);
sMemText := StringReplace(sMemText, ')', ')'#27#27'[0m', [rfReplaceAll]);
end;
1: // 纯汉字表示
begin
sMemText := StringReplace(sMemText, '砗', #27#27'[1;31m砗'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '码', #27#27'[1;31m码'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '相', #27#27'[1;31m相'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '仕', #27#27'[1;31m仕'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '帅', #27#27'[1;31m帅'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '炮', #27#27'[1;31m炮'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '兵', #27#27'[1;31m兵'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '车', #27#27'[1;32m车'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '马', #27#27'[1;32m马'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '象', #27#27'[1;32m象'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '士', #27#27'[1;32m士'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '将', #27#27'[1;32m将'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '包', #27#27'[1;32m包'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '卒', #27#27'[1;32m卒'#27#27'[0m', [rfReplaceAll]);
end;
end;
// 解决网格问题
sMemText := StringReplace(sMemText, '┌', #27#27'[1;33m┌'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┬', #27#27'[1;33m┬'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┐', #27#27'[1;33m┐'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '├', #27#27'[1;33m├'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┼', #27#27'[1;33m┼'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '※', #27#27'[1;33m※'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┤', #27#27'[1;33m┤'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '└', #27#27'[1;33m└'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┴', #27#27'[1;33m┴'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '┘', #27#27'[1;33m┘'#27#27'[0m', [rfReplaceAll]);
// 大棋图专用
sMemText := StringReplace(sMemText, '─', #27#27'[1;33m─'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '＼', #27#27'[1;33m＼'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '／', #27#27'[1;33m／'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '│', #27#27'[1;33m│'#27#27'[0m', [rfReplaceAll]);
sMemText := StringReplace(sMemText, '-', #27#27'[1;33m-'#27#27'[0m', [rfReplaceAll]);
mem.Text := sMemText;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -