xqdatat.pas

象棋演播室1.6的dephi源码 作者 董世伟

///////////////////////////////////////////////////////////////////////////////
//
// XQStduio Source Code (http://www.qipaile.net/xqstudio)
//
// Copyright (c) 1998-2008, DONG Shiwei (董世伟 or 过河象)
// All rights reserved.
// 
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 
//    1) Redistributions of source code must retain the above copyright
//       notice, this list of conditions and the following disclaimer.
//    2) Redistributions in binary form must reproduce the above copyright
//       notice, this list of conditions and the following disclaimer
//       in the documentation and/or other materials provided with the
//       distribution.
//    3) Neither the name of the XQStudio nor the names of its contributors
//       may be used to endorse or promote products derived from this
//       software without specific prior written permission.
// 
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
// FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
// TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
//
///////////////////////////////////////////////////////////////////////////////
//
// Note: Some characters of this file are Simplified Chinese characters 
//       encoded with GB2312/GB18030 standard
//

unit XQDataT;

interface

uses
  Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, dDelphiS, ClipBrd;

//-------------------------------------------------------------------------
//
//.........................................................................
const
  dCProductName = 'XQStudio';
  dCMainVersion = '1.63';
  dCFileVersion = 18;
  dCBetaVersion = 'Final Beta';
  //dCVersionInfo = dCProductName+' '+dCMainVersion +' ('+dCBetaVersion+')';
  dCVersionInfo = dCProductName+' '+dCMainVersion;

  dCMaxRecNo = 1023;
  dCMaxVarNo = 1023;                            // 最大的变着数

  dCWMOPENXQF   =  9966;

type
  //-----------------------------------------------------------------------
  // 定义象棋类中用到的数据类型
  //.......................................................................
  dTXQPXY = array [0..8, 0..9] of TImage;       // 象棋盘坐标定义: 一个棋盘
                                                // 由90个交叉点'兵站'组成

  dTXQZPic = array [1..14] of TPicture;         // 象棋子的图片, 依次为:
                                                // 红: 车马相士帅炮兵
                                                // 黑: 车马象士将炮兵

  dTWhoPlay = (wpRed, wpBlk, wpNone, wpPause);  // 定义'该谁下'

  dTXQZXY = array [1..32] of dTByte;            // 32个棋子的位置
  // 用单字节坐标表示, 将字节变为十进制数, 十位数为X(0-8)个位数为Y(0-9),
  // 棋盘的左下角为原点(0, 0). 32个棋子的位置从1到32依次为:
  // 红: 车马相士帅士相马车炮炮兵兵兵兵兵 (位置从右到左, 从下到上)
  // 黑: 车马象士将士象马车炮炮卒卒卒卒卒 (位置从右到左, 从下到上)

  procedure dMakeStandardQzXY(var qzXY: dTXQZXY);
  function  IsQzXYSame(var qzXY1, qzXY2: dTXQZXY; bQzNumOnly, bIgnoreYz: Boolean): Boolean;
  function  sGetPlayRecStr(var qzXY:dTXQZXY; XYf,XYt:Byte;
                             bRL:Boolean; bMove: Boolean = True):string;
  function  wGetPlayRecXY (qzXY:dTXQZXY; wp: dTWhoPlay;
                             sRecStr:string):dTWord;
  procedure d90PosCharToXQZXY(var qzXY: dTXQZXY; s90Char: string);
  procedure dXQZXYtoXYfXYt(var XYf, XYt: dTByte; qzXYf, qzXYt: dTXQZXY);
  procedure dMakeQiTuText(var mem: TMemo; sRed, sBlk: String;
              qzXY:dTXQZXY; wp: dTWhoPlay; iMode: integer; bRL: Boolean;
              bBbsColor:Boolean);
  function  isQiziCanAtXY(Idx, XYx, XYy: dTInt32): dTBoolean;

  function  isClipBoardTextQipu: Boolean;
  function  sGetCmdLineXqfName: string;
  procedure dSetSearchQzXYParam(qzXY: dTXQZXY);


//-------------------------------------------------------------------------
// 变量定义
//.........................................................................
var
  dCREDNUM: array [0..9] of String[3] =         // 红方所用的数字系统
             ('0', '一','二','三','四','五','六','七','八','九');
  dCBLKNUM: array [0..9] of String[3] =         // 黑方所用的数字系统
             ('0', '１','２','３','４','５','６','７','８','９');
implementation

//-------------------------------------------------------------------------
// 有棋子坐标变为棋谱记录，同时棋局的局势更新
//.........................................................................
function sGetPlayRecStr(var qzXY:dTXQZXY; XYf,XYt:Byte; bRL:Boolean;
             bMove: Boolean):string;
var
  i, m, n, MN, Xf, Yf, Xt, Yt, Dx, Dy, Da, Db, iQZCount: dTINT32;
  sRec          : string;
  WP            : dTWhoPlay;
  TempXY        : dTXQZXY;
  isKingSafe    : Boolean;
function iGetQZIdxAtXY(XY:dTByte):dTInt32;
var
  i: dTInt32;
begin
  for i:=1 to 32 do
  begin
    if qzXY[i] = XY then begin iGetQZIdxAtXY:=i; Exit; end;
  end;
  iGetQZIdxAtXY := 0;
end;
function sGetRedLine(iX: Integer): String;
begin
  // bRL 为左右对换标志
  if bRL then Result := dCREDNUM[iX+1] else Result := dCREDNUM[9-iX];
end;
function sGetBlkLine(iX: Integer): String;
begin
  // bRL 为左右对换标志
  if bRL then Result := dCBLKNUM[9-iX] else Result := dCBLKNUM[iX+1];
end;

begin
  sGetPlayRecStr := '';

  case iGetQZIdxAtXY(XYf) of
    01..16: WP := wpRed;
    17..32: WP := wpBlk;
    else    Exit;
  end;

  case iGetQZIdxAtXY(XYt) of                    // 不可以吃自己子
    01..16: if (WP = wpRed) then Exit;
    17..32: if (WP = wpBlk) then Exit;
  end;

  Xf:=XYf div 10;  Yf:=XYf mod 10;  Xt:=XYt div 10;  Yt:=XYt mod 10;
  Dx:=Xt - Xf;     Dy:=Yt - Yf;     Da:=Abs(Dx);     Db:=Abs(Dy);

  case iGetQZIdxAtXY(XYf) of
  1, 9, 17, 25: // Che
    Begin
      if ((Dx<>0)and(Dy<>0)) then Exit;
      iQZCount := 0;
      for i:=1 to Da-1 do if (iGetQZIdxAtXY((Xf+i*(Da div Dx))*10+Yf)<>0)
        then iQZCount :=  iQZCount + 1;
      for i:=1 to Db-1 do if (iGetQZIdxAtXY(Xf*10+(Yf+i*(Db div Dy)))<>0)
        then iQZCount :=  iQZCount + 1;
      if (iQZCount<>0) then Exit;

      case WP of
      wpRed:
        begin
          sRec := '车' + sGetRedLine(Xf);

          if qzXY[01] = XYf then
            MN := qzXY[09]
          else
            MN := qzXY[01];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf>n) then sRec:='前车' else sRec:='后车';

          case Dy of
            01..09: sRec := sRec + '进' + dCREDNUM[Db];
            -9..-1: sRec := sRec + '退' + dCREDNUM[Db];
            0     : sRec := sRec + '平' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '车' + sGetBlkLine(Xf);

          if (qzXY[17]=XYf) then MN:=qzXY[25] else MN:=qzXY[17];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf<n) then sRec:='前车' else sRec:='后车';

          case Dy of
            -9..-1: sRec := sRec + '进' + dCBLKNUM[Db];
            01..09: sRec := sRec + '退' + dCBLKNUM[Db];
            0     : sRec := sRec + '平' + sGetBlkLine(Xt);
          end;
        end;
      end;
    end;

  2, 8, 18, 24: // Ma
    begin
      if (((Da<>1)and(Db<>1))or((Da<>2)and(Db<>2))) then Exit;
      m := 0; n := 0; if (Da>Db) then m:=(Dx div 2) else n:=(Dy div 2);
      if(iGetQZIdxAtXY((Xf+m)*10+(Yf+n))<>0) then Exit;

      case WP of
      wpRed:
        begin
          sRec := '马' + sGetRedLine(Xf);

          if (qzXY[02]=XYf) then MN:=qzXY[08] else MN:=qzXY[02];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf>n) then sRec:='前马' else sRec:='后马';
          case Dy of
            01..02: sRec := sRec + '进' + sGetRedLine(Xt);
            -2..-1: sRec := sRec + '退' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '马' + sGetBlkLine(Xf);

          if (qzXY[18]=XYf) then MN:=qzXY[24] else MN:=qzXY[18];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf<n) then sRec:='前马' else sRec:='后马';
          case Dy of
            -2..-1: sRec := sRec + '进' + sGetBlkLine(Xt);
            01..02: sRec := sRec + '退' + sGetBlkLine(Xt);
          end;
        end;
      end;
    end;

  3, 7, 19, 23: // Xiang (OK)
    begin
      if ((Da<>2)or(Db<>2)) then Exit;
      case WP of
        wpRed: if (not(XYt in [02, 20, 24, 42, 60, 64, 82])) then Exit;
        wpBlk: if (not(XYt in [07, 25, 29, 47, 65, 69, 87])) then Exit;
      end;
      m:=(Dx div 2); n:=(Dy div 2);
      if(iGetQZIdxAtXY((Xf+m)*10+(Yf+n))<>0) then Exit;

      case WP of
      wpRed:
        begin
          sRec := '相' + sGetRedLine(Xf);

          //if qzXY[03]=XYf then MN:=qzXY[07]else MN:=qzXY[03];
          //m := MN div 10;  n := MN mod 10;
          //if (m=Xf) then if (Yf>n) then sRec:='前相' else sRec:='后相';

          case Dy of
            01..02: sRec := sRec + '进' + sGetRedLine(Xt);
            -2..-1: sRec := sRec + '退' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '象' + sGetBlkLine(Xf);

          //if qzXY[19]=XYf then MN:=qzXY[23] else MN:=qzXY[19];
          //m := MN div 10;  n := MN mod 10;
          //if (m=Xf) then if (Yf<n) then sRec:='前象' else sRec:='后象';

          case Dy of
            -2..-1: sRec := sRec + '进' + sGetBlkLine(Xt);
            01..02: sRec := sRec + '退' + sGetBlkLine(Xt);
          end;
        end;
      end;

    end;

  4, 6, 20, 22: // Shi (OK)
    begin
      if ((Da<>1)or(Db<>1)) then Exit;
      case WP of
        wpRed: if (not(XYt in [30, 32, 41, 50, 52])) then Exit;
        wpBlk: if (not(XYt in [37, 39, 48, 57, 59])) then Exit;
      end;

      case WP of
      wpRed:
        begin
          sRec := '士' + sGetRedLine(Xf);

          //if qzXY[04] = XYf then MN:=qzXY[06] else MN:=qzXY[04];
          //m := MN div 10;  n := MN mod 10;
          //if (m=Xf) then if (Yf>n) then sRec:='前士' else sRec:='后士';

          case Dy of
            01..02: sRec := sRec + '进' + sGetRedLine(Xt);
            -2..-1: sRec := sRec + '退' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '士' + sGetBlkLine(Xf);

          //if qzXY[20]=XYf then MN:=qzXY[22] else MN:=qzXY[20];
          //m := MN div 10;  n := MN mod 10;
          //if (m=Xf) then if (Yf<n) then sRec:='前士' else sRec:= '后士';

          case Dy of
            -2..-1: sRec := sRec + '进' + sGetBlkLine(Xt);
            01..02: sRec := sRec + '退' + sGetBlkLine(Xt);
          end;
        end;
      end;

    end;

  5, 21: // Jiang (OK)
    begin
      if (((Da<>0)and(Db<>0))or((Da<>1)and(Db<>1))) then Exit;
      case WP of
        wpRed: if (not(XYt in [30,31,32,40,41,42,50,51,52])) then Exit;
        wpBlk: if (not(XYt in [37,38,39,47,48,49,57,58,59])) then Exit;
      end;

      case WP of
      wpRed:
        begin
          sRec := '帅' + sGetRedLine(Xf);
          case Dy of
            01..09: sRec := sRec + '进' + dCREDNUM[Db];
            -9..-1: sRec := sRec + '退' + dCREDNUM[Db];
            0     : sRec := sRec + '平' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '将' + sGetBlkLine(Xf);
          case Dy of
            -9..-1: sRec := sRec + '进' + dCBLKNUM[Db];
            01..09: sRec := sRec + '退' + dCBLKNUM[Db];
            0     : sRec := sRec + '平' + sGetBlkLine(Xt);
          end;
        end;
      end;
    end;

  10,11,26,27: // Pao (OK)
    begin
      if ((Dx<>0)and(Dy<>0)) then Exit;
      iQZCount := 0;
      for i:=1 to Da-1 do if (iGetQZIdxAtXY((Xf+i*(Da div Dx))*10+Yf)<>0)
        then iQZCount :=  iQZCount + 1;
      for i:=1 to Db-1 do if (iGetQZIdxAtXY(Xf*10+(Yf+i*(Db div Dy)))<>0)
        then iQZCount :=  iQZCount + 1;
      if (iQZCount>1) then Exit;
      if ((iGetQZIdxAtXY(XYt)=0)and(iQZCount=1)) or
         ((iGetQZIdxAtXY(XYt)<>0)and(iQZCount=0)) then Exit;

      case WP of
      wpRed:
        begin
          sRec := '炮' + sGetRedLine(Xf);

          if qzXY[10] = XYf then MN:=qzXY[11] else MN:=qzXY[10];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf>n) then sRec:='前炮' else sRec:='后炮';

          case Dy of
            01..09: sRec := sRec + '进' + dCREDNUM[Db];
            -9..-1: sRec := sRec + '退' + dCREDNUM[Db];
            0     : sRec := sRec + '平' + sGetRedLine(Xt);
          end;
        end;
      wpBlk:
        begin
          sRec := '炮' + sGetBlkLine(Xf);
          if qzXY[26] = XYf then MN := qzXY[27] else MN := qzXY[26];
          m := MN div 10;  n := MN mod 10;
          if (m=Xf) then if (Yf<n) then sRec:='前炮' else sRec:= '后炮';

          case Dy of
            -9..-1: sRec := sRec + '进' + dCBLKNUM[Db];
            01..09: sRec := sRec + '退' + dCBLKNUM[Db];
            0     : sRec := sRec + '平' + sGetBlkLine(Xt);
          end;
        end;
      end
    end;

  12..16, 28..32: // Bing
    begin
      if (((Da<>0)and(Db<>0))or((Da<>1)and(Db<>1))) then Exit;