gameboard.pas

描述了根据五子规则做出相应的分步预测和胜负判断！也对DELPHI的面向对象的程序开发系统做了相应的阐述!

          end;
      end;

      if NoNeed then continue;
      if ((Sum = 0) or (Sum = 5)) then break;

      if Sum = 4 then
      begin
        ResultImage := Live5Model[1].Edgetypes;
      end else
        if Sum = 3 then
          // for the situation of ( 20101102 ) or ( 20110102 ) @ 2004.05.16
        {  if ( ( (TypeImage[i]=ChessType)
            and ((TypeImage[i-1]=Edge) or (TypeImage[i-1]=OtherType)) )
            or ( (TypeImage[i+4]=ChessType) and ((TypeImage[i+5]=Edge) or (TypeImage[i+5]=OtherType)) ) ) then
              ResultImage := GetEdgeImage( image, Sum, True)  // Closed
          else
              ResultImage := GetEdgeImage( image, Sum, False)  }
          if ((TypeImage[i - 1] = None) and (TypeImage[i + 5] = None)) then
            ResultImage := GetEdgeImage(image, Sum, False) // Open
          else
          begin
            if ((TypeImage[i - 1] <> None) and (TypeImage[i + 6] <> None)) then
            begin
              // for the situation of ( 20101102 ) or ( 20110102 ) @ 2004.05.31
              if ((TypeImage[i] = None) and (TypeImage[i + 5] = None)) then
                ResultImage := GetEdgeImage(image, Sum, False)
              else
                ResultImage := GetEdgeImage(image, Sum, True)
            end
            else
              ResultImage := GetEdgeImage(image, Sum, True);
          end
        else
          if ((TypeImage[i - 1] = Edge) or (TypeImage[i - 1] = OtherType)
            or (TypeImage[i + 5] = Edge) or (TypeImage[i + 5] = OtherType)) then
            ResultImage := GetEdgeImage(image, Sum, True) // Closed
          else
            ResultImage := GetEdgeImage(image, Sum, False);

      for j := i to i + 4 do
        if ResultImage[j - i + 1] > EdgeBoard[ChessType][x + j * dirx, y + j * diry].TypeNum[dir].Edge then
        begin
          EdgeBoard[ChessType][x + j * dirx, y + j * diry].TypeNum[dir].Edge := ResultImage[j - i + 1];
        end;

      break;
    end;
  end; // for i:= -8 to 4

end;

procedure TGameBoard.UpdateEdgeBoard(x, y: integer);
var dir: TDirection;
begin
  for dir := Left to UpperRight do
    UpdateDir(dir, x, y);
end;

//  设置棋盘x, y处的值

function TGameBoard.SetXY(x, y: integer; TypeOfChess: TChessType): boolean;
var score: real;
begin
  Result := False;
  if (inbound(x, 1, BoardWidth) and inBound(y, 1, BoardHeight)) then
  begin
    if ((TypeOfChess <> None) and (Board[x, y] <> None)) then
    begin
      ShowMessage(' Set Wrong!');
      Result := False;
      exit;
    end;
    if ((TypeOfChess <> None) and WinPlace(x, y, TypeOfChess, score)) then
      if score > MaxScore then
        showMessage(GetTypeString(TypeOfChess) + ' Win!');
    Board[x, y] := TypeOfChess;
    UpdateEdgeBoard(x, y);
    Result := True;
  end else
  begin
    ShowMessage(' Set Wrong!');
  end;
end;

function TGameBoard.WinPlace(x, y: integer; TypeOfChess: TChessType; var Score: real): boolean;
var count: array[No..Five] of integer;
  i: integer;
  l: TDirection;
  BestType: TEdgeEnum;
begin
  Result := False;
  for i := No to Five do
    count[i] := 0;
  for l := Left to UpperRight do
  begin
    BestType := EdgeBoard[TypeOfChess][x, y].TypeNum[l].Edge;
    count[BestType] := count[BestType] + 1;
  end;
  if ((count[Five] > 0)) then
  begin
    Result := True;
    Score := MaxScore + 1000000;
  end
    {  else
      if (  (count[Live4]>0) or
         ( (count[Dead4]>1) )
        or ( (count[live3Packed]>0) and (count[Dead4]>0) )
        or ( (count[live3Loose]>0) and (count[Dead4]>0) ) )
      then
      begin
        Result := True;
        Score := 1500;
      end else
      if ( ( (count[live3Loose]>1) )
        or ( (count[live3Loose]>0) and (count[Live3Packed]>0) )
        or ( (count[Live3Packed]>1) ) )
      then
      begin
        Result := True;
        Score := 1000;
      end;
     }
end;

// 产生下一步

procedure TGameBoard.GetNextStep(TypeOfChess: TChessType; var x, y: integer);
var maxX, MaxY: integer;
  Score1, Score2, tMaxScore: real;
  i: TChessType;
  j, k, m, n: integer;
  l: TDirection;
begin
  tMaxScore := -1000;
  maxX := 0;
  maxY := 0;
  i := ReverseType(TypeOfChess);
  for j := 1 to BoardWidth do
    for k := 1 to BoardHeight do
    begin
      if Board[j, k] = None then
      begin
        Score1 := 0;
        Score2 := 0;
        for l := Left to UpperRight do
        begin
          Score1 := Score1 + ConstScore[abs(EdgeBoard[TypeOfChess][j, k].TypeNum[l].Edge)];
        end;
        for l := Left to UpperRight do
          Score2 := Score2 + ConstScore[abs(EdgeBoard[i][j, k].TypeNum[l].Edge)];
        for m := -1 to 1 do
          for n := -1 to 1 do
            if Board[j + m, k + n] in [TypeOfChess, i] then
              Score1 := Score1 + 1;
        Score1 := Score1 + 0.7 * Score2;
        if (Score1 > tMaxScore) then
        begin
          tMaxScore := Score1;
          MaxX := j;
          MaxY := k;
        end;
      end;
    end;
  X := MaxX;
  Y := MaxY;
end;

procedure TGameBoard.GetNextStepWithDepth(TypeOfChess: TChessType; var x, y: integer; depth: integer); //  递归产生下一步
const
  NumPlaces = 12;
  UnderLevelScore = 20;

type
  TPointItem = record
    level: TEdgeEnum;
    Score: integer;
    //    Score, Score1 : real;
    case integer of
      0: (int: integer);
      1: (dx, dy: SmallInt);
  end;

  TBestList = array[Black..White] of array[1..NumPlaces] of TPointItem;

  TWinFlag = array[Black..White] of boolean;

var
  root, Child: TTreeNode;
  res: real;
  BestX, BestY: integer;
  Score, Score1, Score2, BestScore: real;
  l: TDirection;
  bestType: array[Black..White] of TEdgeEnum;
  LoopChessType, MainOtherType: TChessType;
  MainBestPlaces: TBestList;
  MainWinFlag: TWinFlag;
  i, j, k, m: integer;

  function WinPlace(TypeOfChess, TypeTurn: TChessType; var x, y: integer; depth: integer; Tree: TTreeNode;
    EdgeBoard: TEdgeBoard; BestPlaces: TBestList; CutLevel: TEdgeEnum): boolean;

  label RecoverPoint;

  var i, j, k, m: integer;
    NextDepth: integer;
    DeeperLevel: integer;
    Oldx, Oldy: integer;
    Recover, Win1: boolean;
    Score, LevelScore, BestScore: real;
    LoopChessType, OtherType: TChessType;
    Child: TTreeNode;

    procedure UpdateList(x, y: SmallInt; TypeOfChess: TChessType; Delete: Boolean);
    var i, j: integer;
      l: TDirection;
      BestType: TEdgeEnum;
      Score: integer;
    begin
      if Delete then
      begin
        for i := 1 to NumPlaces do
        begin
          if ((BestPlaces[TypeOfChess][i].dx = x) and (BestPlaces[TypeOfChess][i].dy = y)) then
          begin
            for j := i to NumPlaces - 1 do
              BestPlaces[TypeOfChess][j] := BestPlaces[TypeOfChess][j + 1];
            BestPlaces[TypeOfChess][NumPlaces].level := No;
            BestPlaces[TypeOfChess][NumPlaces].int := 0;
            BestPlaces[TypeOfChess][NumPlaces].Score := 0;
            exit;
          end;
        end;
      end else
      begin
        if Board[x, y] <> None then exit;
        BestType := No;
        for l := Left to UpperRight do
        begin
          Score := Score + EdgeBoard[TypeOfChess][x, y].TypeNum[l].Edge;
          if EdgeBoard[TypeOfChess][x, y].TypeNum[l].Edge > BestType then
            BestType := EdgeBoard[TypeOfChess][x, y].TypeNum[l].Edge;
        end;

        // 若已经在列表中则去掉
        for i := 1 to NumPlaces do
          if ((BestPlaces[TypeOfChess][i].dx = x) and (BestPlaces[TypeOfChess][i].dy = y)) then
          begin
            k := i;
            if ((i > 1) and (BestType > BestPlaces[TypeOfChess][i - 1].level)) then
            begin
              k := 1;
              for j := i - 1 downto 1 do
              begin
                if BestType > BestPlaces[TypeOfChess][j].level then
                  BestPlaces[TypeOfChess][j + 1] := BestPlaces[TypeOfChess][j]
                else
                begin
                  k := j + 1;
                  break;
                end;
              end;
            end else
              if ((i < NumPlaces) and (BestType < BestPlaces[TypeOfChess][i + 1].level)) then
              begin
                k := NumPlaces;
                for j := i + 1 to NumPlaces do
                begin
                  if BestType < BestPlaces[TypeOfChess][j].level then
                    BestPlaces[TypeOfChess][j - 1] := BestPlaces[TypeOfChess][j]
                  else
                  begin
                    k := j - 1;
                    break;
                  end;
                end;
              end;

            BestPlaces[TypeOfChess][k].level := BestType;
            BestPlaces[TypeOfChess][k].Score := Score;
            BestPlaces[TypeOfChess][k].dx := x;
            BestPlaces[TypeOfChess][k].dy := y;
            exit;
          end; // if

        if BestPlaces[TypeOfChess][NumPlaces].level >= BestType then
          exit; //  列表已经满
        for i := 1 to NumPlaces do
          if ((BestPlaces[TypeOfChess][i].level < BestType) or
            ((BestPlaces[TypeOfChess][i].level = BestType)
            and (BestPlaces[TypeOfChess][i].Score < Score))) then
          begin
            for j := NumPlaces downto i + 1 do
              BestPlaces[TypeOfChess][j] := BestPlaces[TypeOfChess][j - 1];
            BestPlaces[TypeOfChess][i].level := BestType;
            BestPlaces[TypeOfChess][i].Score := Score;
            BestPlaces[TypeOfChess][i].dx := x;
            BestPlaces[TypeOfChess][i].dy := y;
            exit;
          end;
      end; // else
    end;

    procedure UpdateDir(dir: TDirection; x, y: integer);

    const TypeArrayMax = 9;

    var dirx, diry: integer;
      i: integer;
      ux, uy: integer;
      l: TDirection;
      image: byte;
      Sum: integer;
      ChessType, TheOtherType: TChessType;
      ResultImage: TEdgeImage;
      TypeImage: array[-TypeArrayMax..TypeArrayMax] of TChessType;
      NeedToAdd: array[Black..White] of array[-5..5] of boolean;

      procedure JudgeImage(Minx, Maxx: integer);
      var j: integer;
      begin
        if ((TypeImage[i] = Edge) or (TypeImage[i] = TheOtherType)) then
        begin
          exit;
        end;

        Sum := 0;
        image := 0;
        for j := i to i + 4 do
        begin
          if TypeImage[j] = ChessType then
          begin
            inc(Sum);
            image := image or (1 shl (4 - (j - i)));
          end else
            if ((TypeImage[j] = TheOtherType) or (TypeImage[j] = Edge)) then
            begin
              i := j;
              exit;
            end;
        end;

        //  Don't calculate less than 2 for speed up !!!!!!!!  2004.5.25
        if ((Sum < 2) or (Sum = 5)) then
          exit;

        if Sum = 4 then
        begin
          ResultImage := Live5Model[1].Edgetypes;
        end else
          if Sum = 3 then
            // for the situation of ( 20101102 ) or ( 20110102 ) @ 2004.05.16
      {      if ( ( (TypeImage[i]=ChessType)  and ((TypeImage[i-1]=Edge) or (TypeImage[i-1]=TheOtherType)) )
              or ( (TypeImage[i+4]=ChessType) and ((TypeImage[i+5]=Edge) or (TypeImage[i+5]=TheOtherType)) )
              or ( ((TypeImage[i-1]=Edge) or (TypeImage[i-1]=TheOtherType))
                and ((TypeImage[i+5]=Edge) or (TypeImage[i+5]=TheOtherType)) ) ) then
                ResultImage := GetEdgeImage( image, Sum, True)  // Closed
            else
                ResultImage := GetEdgeImage( image, Sum, False)  }
            if ((TypeImage[i - 1] = None) and (TypeImage[i + 5] = None)) then
              ResultImage := GetEdgeImage(image, Sum, False) // Open
            else
            begin
              if ((TypeImage[i - 1] <> None) and (TypeImage[i + 6] <> None)) then
              begin
                // for the situation of ( 20101102 ) or ( 20110102 ) @ 2004.05.31
                if ((TypeImage[i] = None) and (TypeImage[i + 5] = None)) then
                  ResultImage := GetEdgeImage(image, Sum, False)
                else
                  ResultImage := GetEdgeImage(image, Sum, True)
              end
              else
                ResultImage := GetEdgeImage(image, Sum, True);
            end
          else
            if ((TypeImage[i - 1] = Edge) or (TypeImage[i - 1] = TheOtherType)
              or (TypeImage[i + 5] = Edge) or (TypeImage[i + 5] = TheOtherType)) then
              ResultImage := GetEdgeImage(image, Sum, True) // Closed
            else
              ResultImage := GetEdgeImage(image, Sum, False);

        for j := i to i + 4 do
        begin
          ux := x + j * dirx;
          uy := y + j * diry;
          if ((Board[ux, uy] = None) and inBound(j, Minx, Maxx)) then
            if ResultImage[j - i + 1] > EdgeBoard[ChessType][ux, uy].TypeNum[dir].Edge then
            begin
              EdgeBoard[ChessType][ux, uy].TypeNum[dir].Edge := ResultImage[j - i + 1];
              NeedToAdd[ChessType][j] := True;
            end;