⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gameboard.pas

📁 描述了根据五子规则做出相应的分步预测和胜负判断!也对DELPHI的面向对象的程序开发系统做了相应的阐述!
💻 PAS
📖 第 1 页 / 共 4 页
字号:
              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;
        end;
      end; // of JudgeImage;

    begin
      GetDirDelta(dir, dirx, diry);
      for i := -TypeArrayMax to TypeArrayMax do
        TypeImage[i] := Edge;
      for i := 0 to TypeArrayMax do
        if Board[x + i * dirx, y + i * diry] <> Edge then
          TypeImage[i] := Board[x + i * dirx, y + i * diry]
        else
          break;
      for i := -1 downto -TypeArrayMax do
        if Board[x + i * dirx, y + i * diry] <> Edge then
          TypeImage[i] := Board[x + i * dirx, y + i * diry]
        else
          break;

      // Update Differ
      ChessType := ReverseType(Board[x, y]);
      begin
        for i := 0 to 5 do
          if TypeImage[i] = Edge then
            break
          else
          begin
            EdgeBoard[ChessType][x + i * dirx, y + i * diry].TypeNum[dir].Edge := No;
            if i <> 0 then
              UpdateList(x + i * dirx, y + i * diry, ChessType, False);
          end;
        for i := -1 downto -5 do
          if TypeImage[i] = Edge then
            break
          else
          begin
            EdgeBoard[ChessType][x + i * dirx, y + i * diry].TypeNum[dir].Edge := No;
            if i <> 0 then
              UpdateList(x + i * dirx, y + i * diry, ChessType, False);
          end;
      end;

      TheOtherType := ReverseType(ChessType);
      i := -9;
      while (i < -4) do
      begin
        JudgeImage(-5, -1);
        inc(i);
      end; // for i:= -9 to -5

      i := 1;
      while (i < 6) do
      begin
        JudgeImage(1, 5);
        inc(i);
      end; // for i:= 1 to 5

      //  Update Same
      ChessType := Board[x, y];
      TheOtherType := ReverseType(ChessType);
      i := -4;
      while i < 1 do
      begin
        JudgeImage(-5, 5);
        inc(i);
      end; // for i:= -4 to 0

      for ChessType := Black to White do
      begin
        for i := -5 to 5 do
        begin
          if NeedToAdd[ChessType][i] then
          begin
            ux := x + i * dirx;
            uy := y + i * diry;

            UpdateList(ux, uy, ChessType, False);
          end;
        end;
      end;

    end; // UpdateDir

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

  begin
    Result := False;
    Oldx := x;
    OldY := y;
    Board[Oldx, Oldy] := TypeOfChess;
    UpdateBoard;
    for i := 1 to NumPlaces do
    begin
      if BestPlaces[TypeOfChess][i].level < CutLevel then break;

      j := BestPlaces[TypeOfChess][i].dx;
      k := BestPlaces[TypeOfChess][i].dy;

      if WinPlace(TypeOfChess, TypeOfChess, j, k, depth, Child, EdgeBoard, BestPlaces, CutLevel) then
      begin
        Result := True;
        break;
      end;
    end;

    Board[OldX, OldY] := None;
  end;

begin
  if depth <= 0 then exit;

  MainOtherType := ReverseType(TypeOfChess);

  for LoopChessType := Black to White do
    for i := 1 to NumPlaces do
    begin
      MainBestPlaces[LoopChessType][i].int := 0;
      MainBestPlaces[LoopChessType][i].level := 0;
    end;

  BestScore := -6000000;
  BestX := 0;
  BestY := 0;
  for i := 1 to BoardWidth do
    for j := 1 to BoardHeight do
    begin
      if ((Board[i, j] = None) and ((EdgeBoard[Black][i, j].int > 0) or (EdgeBoard[White][i, j].int > 0))) then
      begin
        Score1 := 0;
        Score2 := 0;
        bestType[TypeOfChess] := No;
        bestType[MainOtherType] := No;
        for l := Left to UpperRight do
        begin
          if EdgeBoard[TypeOfChess][i, j].TypeNum[l].Edge > bestType[TypeOfChess] then
            bestType[TypeOfChess] := EdgeBoard[TypeOfChess][i, j].TypeNum[l].Edge;
          Score1 := Score1 + ConstScore[EdgeBoard[TypeOfChess][i, j].TypeNum[l].Edge];
        end;
        for l := Left to UpperRight do
        begin
          if EdgeBoard[MainOtherType][i, j].TypeNum[l].Edge > bestType[MainOtherType] then
            bestType[MainOtherType] := EdgeBoard[MainOtherType][i, j].TypeNum[l].Edge;
          Score2 := Score2 + ConstScore[EdgeBoard[MainOtherType][i, j].TypeNum[l].Edge];
        end;

        Score := Score1 + Score2;
        if Score > BestScore then
        begin
          BestScore := Score;
          BestX := i;
          BestY := j;
        end;

        for LoopChessType := Black to White do
        begin

          if (BestType[LoopChessType] > MainBestPlaces[LoopChessType][NumPlaces].level) then
          begin
            k := 1;
            while MainBestPlaces[LoopChessType][k].level > bestType[LoopChessType] do inc(k);
            for m := NumPlaces - 1 downto k do
            begin
              MainBestPlaces[LoopChessType][m + 1] := MainBestPlaces[LoopChessType][m];
            end;
            //            MainBestPlaces[LoopChessType][k].Score := Score1 + Score2;
            //            MainBestPlaces[LoopChessType][k].Score1 := Score;
            MainBestPlaces[LoopChessType][k].dx := i;
            MainBestPlaces[LoopChessType][k].dy := j;
            MainBestPlaces[LoopChessType][k].level := bestType[LoopChessType];
          end;
        end; //  for
      end;
    end; // for

  Form1.StatusBar1.Panels[0].Text := ' ';
  x := 0;
  if WinPlace(TypeOfChess, TypeOfChess, x, y, depth, root, EdgeBoard, MainBestPlaces, Live3Loose) then
  begin
    Form1.StatusBar1.Panels[0].Text := '我赢了! ';
    exit;
  end;

  if MainBestPlaces[MainOtherType][1].level = Five then
  begin
    x := MainBestPlaces[MainOtherType][1].dx;
    y := MainBestPlaces[MainOtherType][1].dy;
    exit;
  end;

  x := 0;
  if WinPlace(MainOtherType, MainOtherType, x, y, depth, root, EdgeBoard, MainBestPlaces, Live3Loose) then
  begin
    begin
      i := 1;
      repeat
        if MainBestPlaces[MainOtherType][i].level = 0 then break;
        j := MainBestPlaces[MainOtherType][i].dx;
        k := MainBestPlaces[MainOtherType][i].dy;
        x := j;
        y := k;
        if not WinPlace(MainOtherType, MainOtherType, j, k, depth, Child, EdgeBoard, MainBestPlaces, Live3Loose) then
          break;
        inc(i);
      until (i > NumPlaces);
    end;

    if ((i > NumPlaces) or (MainBestPlaces[MainOtherType][i].level = 0)) then
    begin
      Form1.StatusBar1.Panels[0].Text := '你赢了! ';
      x := MainBestPlaces[MainOtherType][1].dx;
      y := MainBestPlaces[MainOtherType][1].dy;

    end
    else
      Form1.StatusBar1.Panels[0].Text := '你有可能赢哦! ';
    exit;
  end;

  BestScore := 0;
  for i := 1 to NumPlaces do
  begin
    if MainBestPlaces[TypeOfChess][i].level >= Live3Loose then continue;
    if MainBestPlaces[TypeOfChess][i].level < Live2Loose then break;

    j := MainBestPlaces[TypeOfChess][i].dx;
    k := MainBestPlaces[TypeOfChess][i].dy;
    Score := 0;
    for l := Left to UpperRight do
    begin
      Score := Score + ConstScore[EdgeBoard[TypeOfChess][j, k].TypeNum[l].Edge];
      Score := Score + ConstScore[EdgeBoard[MainOtherType][j, k].TypeNum[l].Edge];
    end;

    if FindMayWinPlace(TypeOfChess, TypeOfChess, j, k, depth, root, EdgeBoard, MainBestPlaces, Live3Loose) then
    begin
      if Score < BestScore then
        continue;

      BestScore := Score;
      x := MainBestPlaces[TypeOfChess][i].dx;
      y := MainBestPlaces[TypeOfChess][i].dy;
    end;
  end;
  if BestScore > 0 then
  begin
    Form1.StatusBar1.Panels[0].Text := '我有可能赢哦! ';
    exit;
  end;



  x := BestX;
  y := BestY;
  //  Form1.StatusBar1.Panels[0].Text := 'Not find WinPlace '+ inttostr(x)+' : '+inttostr(y);

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -