unit4.pas.~2~

这个软件是用Delphi 7开发的。 原本它是两个人在纸面上玩的益智游戏

{ *********************************************************************** }
{ 打飞机V1.0人机对奕版  电脑对奕程序单元                                  }
{                                                                         }
{
作者:wqy
QQ:466798985
E-Mail:[e-mail]
你可以随意传播该源码，但请保证源码完整以及该文件头的存在
}


unit Unit4; //Computer

interface
uses Math, Graphics, Dialogs;
const
   DPlaneBody: array[1..4, 0..9, 0..1] of smallint = (
      ((0, 0), (-1, -2), (-1, -1), (-1, 0), (-1, 1), (-1, 2), (-2, 0), (-3, -1), (-3, 0), (-3, 1)),
      ((0, 0), (-2, 1), (-1, 1), (0, 1), (1, 1), (2, 1), (0, 2), (-1, 3), (0, 3), (1, 3)),
      ((0, 0), (1, -2), (1, -1), (1, 0), (1, 1), (1, 2), (2, 0), (3, 1), (3, 0), (3, -1)),
      ((0, 0), (-2, -1), (-1, -1), (0, -1), (1, -1), (2, -1), (0, -2), (-1, -3), (0, -3), (1, -3)));
   AroundNoPlane: array[1..36, 0..2] of smallint = (
      (-3, -1, 2), (-3, 0, 2), (-3, 1, 2),
      (-2, -1, 3), (-2, 0, 2), (-2, 1, 1),
      (-1, -2, 2), (-1, -1, 2), (-1, -1, 3), (-1, 0, 2), (-1, 1, 1), (-1, 1, 2), (-1, 2, 2),
      (0, -3, 3), (0, -2, 3), (0, -1, 3), (0, 1, 1), (0, 2, 1), (0, 3, 1),
      (1, -2, 4), (1, -1, 4), (1, -1, 3), (1, 0, 4), (1, 1, 1), (1, 1, 4), (1, 2, 4),
      (2, -1, 3), (2, 0, 4), (2, 1, 1),
      (3, -1, 4), (3, 0, 4), (3, 1, 4),
      (0, 0, 1), (0, 0, 2), (0, 0, 3), (0, 0, 4)
      ); //0..2 : delta y ; delta x ; direction;  //一个格子不是飞机机体，周围哪些格子不可能有什么方向的飞机
   AroundBePlane: array[1..36, 0..2] of smallint = (
      (2, 1, 1), (-1, 2, 2), (-2, -1, 3), (1, -2, 4),
      (1, 1, 1), (-1, 1, 2), (-1, -1, 3), (1, -1, 4),
      (0, 1, 1), (-1, 0, 2), (0, -1, 3), (1, 0, 4),
      (-1, 1, 1), (-1, -1, 2), (1, -1, 3), (1, 1, 4),
      (-2, 1, 1), (-1, -2, 2), (2, -1, 3), (1, 2, 4),
      (0, 2, 1), (-2, 0, 2), (0, -2, 3), (2, 0, 4),
      (1, 3, 1), (-3, 1, 2), (-1, -3, 3), (3, -1, 4),
      (0, 3, 1), (-3, 0, 2), (0, -3, 3), (3, 0, 4),
      (-1, 3, 1), (-3, -1, 2), (1, -3, 3), (3, 1, 4)
      ); //0..2 : delta y ; delta x ; direction;  //delta y在前  //一个格子是飞机机体，周围哪些格子能有什么方向的飞机

type
   TPos = record
      x, y: Byte;
   end;
   PTPlane2 = ^TPlane2;
   TPlane2 = record
      Available: Boolean;  //可能存在与否
      HeadPos: TPos;
      Direction: Byte;
      Possibility: Byte; //机身周围有多少个点确认是机身
      OfOnePlaneBody: Boolean;
   end;

   TComputer = class
   public
      planes: packed array[0..19, 0..19, 1..4] of TPlane2;  //planes[x,y,z]表示飞机头在(x,y)，朝向为z的飞机
      planesIdx: array[1..1600] of PTPlane2;
      PossiblePlaneCou: word;
      ToAskPos: TPos;

      Con_Play: Boolean;
      PlaneCou, ComputerLefePlane: Byte;
      GridState: packed array[0..19, 0..19] of 0..3; //0.Unknown 1.not body 2.An unknown plane's body 3.existing plane's body

      ThinkEnded: Boolean;
      inRisk: Boolean;
      constructor Create;
      procedure NewGameInit;
      procedure GeneratePlanes;

      procedure HitOnePlaneHead(x, y: Byte);
      procedure HitOnePlaneBody(x, y: Byte);
      procedure HitBlankGrid(x, y: Byte);
      procedure GrayAPlane(idx: Byte);
      function AskGridHitType(x, y: Byte): Byte;
      procedure SetPlanesAroundOneGridFalse(x, y: Byte);
      procedure AskAGrid(x, y: Byte; Randomly: Boolean);
      procedure Think;
      procedure SearchBodyGrids;
      procedure SearchOnlyOnePlane;
      function ChkDeadGrid(x, y: Byte): Boolean;
      procedure SearchPlanes;
      procedure MakeToAskPos;
   end;
function CheckPoint(x, y: smallint): Boolean;

implementation
uses Unit1;
var DrawPanel, GuessPanel: PTPlanePanel;

constructor TComputer.Create();
begin
   DrawPanel := @frmMain.GridPanel1;
   GuessPanel := @frmMain.GridPanel2;
end;

procedure TComputer.NewGameInit;
var x, y, k: Byte; i: word;
begin
   PlaneCou := 0;
   ComputerLefePlane := in_PlaneCou;
   inRisk := False;
   for y := 0 to 19 do
      for x := 0 to 19 do begin
         GridState[y, x] := 0; //unknown
         for k := 1 to 4 do
            with planes[y, x, k] do begin
               Available := False;
               Possibility := 0;
               OfOnePlaneBody := False;
               HeadPos.y := y;
               HeadPos.x := x;
               Direction := k;
            end;
      end;
   GridState[0, 0] := 1;
   GridState[0, in_GridCount - 1] := 1;
   GridState[in_GridCount - 1, 0] := 1;
   GridState[in_GridCount - 1, in_GridCount - 1] := 1;

   PossiblePlaneCou := (in_GridCount - 4) * (in_GridCount - 3) * 4;
   i := 0;
   for y := 0 to in_GridCount - 4 do
      for x := 2 to in_GridCount - 3 do begin
         inc(i);
         planesIdx[i] := @Planes[y, x, 2];
         planesIdx[i]^.Available := True;
         inc(i);
         planesIdx[i] := @Planes[y + 3, x, 4];
         planesIdx[i]^.Available := True;
      end;
   for y := 2 to in_GridCount - 3 do
      for x := 0 to in_GridCount - 4 do begin
         inc(i);
         planesIdx[i] := @Planes[y, x, 3];
         planesIdx[i]^.Available := True;
         inc(i);
         planesIdx[i] := @Planes[y, x + 3, 1];
         planesIdx[i]^.Available := True;
      end;
   ToAskPos.x := 0;
   ToAskPos.y := 0;
end;

procedure TComputer.GeneratePlanes;
var i, x, y, Direction: Byte; nowPX, nowPY: Smallint; Result: Boolean;
   GPlanes: PTArr_Planes; GGridState: PTArr_GridState;
begin
   GuessPanel^.PlaneDraw.AppointedPlaneCou := DrawPanel^.PlaneDraw.AppointedPlaneCou;
   //GeneratePlanes(PlaneCou, @GuessPanel.Planes, @GuessPanel.GridState);  }
   GPlanes := @GuessPanel.Planes;
   GGridState := @GuessPanel.GridState;
   PlaneCou := 0;
   while PlaneCou < in_PlaneCou do begin
      Randomize;
      x := RandomRange(1, in_GridCount - 2);
      y := RandomRange(1, in_GridCount - 2);
      Direction := RandomRange(1, 4);
      Result := True;
      for i := 0 to 9 do begin
         nowPX := X + DPlaneBody[Direction, i, 0];
         nowPY := Y + DPlaneBody[Direction, i, 1];
         if CheckPoint(nowPX, nowPY) then begin
            with GPlanes[PlaneCou + 1] do begin
               TenPoints[i].X := nowPX;
               TenPoints[i].Y := nowPY;
            end;
            if GGridState[nowPY, nowPX].GridType <> 0 then begin
               Result := False; //A Plane is not available
               break;
            end;
         end else begin
            Result := False; //A Plane is not available
            break;
         end;
      end;
      if Result = False then continue;
      GPlanes[PlaneCou + 1].Dirction := Direction;
      GGridState[Y, X].GridType := 1;
      GGridState[Y, X].HoldPlaneIdx := PlaneCou + 1;
      for i := 1 to 9 do begin
         nowPX := X + DPlaneBody[Direction, i, 0];
         nowPY := Y + DPlaneBody[Direction, i, 1];
         GGridState[nowPY, nowPX].GridType := 2;
      end;
      inc(PlaneCou);
   end;
end;

function TComputer.AskGridHitType(x, y: Byte): Byte;
begin
   frmMain.FlashTimer.Enabled := True;
   Result := DrawPanel^.GridState[y, x].GridType; //0.Plain Grid 1.Plane Head 2.Plane Body
   frmMain.BeginFlash(@DrawPanel^.Grids[y, x], in_GridFlashType, Result);
end;

procedure TComputer.SetPlanesAroundOneGridFalse(x, y: Byte);
var i: Byte; nowX, nowY: Byte;
begin
   for i := 1 to 36 do begin
      nowX := x + AroundNoPlane[i, 1];
      nowY := y + AroundNoPlane[i, 0];
      if CheckPoint(nowX, nowY) then
         planes[y + AroundNoPlane[i, 0], x + AroundNoPlane[i, 1], AroundNoPlane[i, 2]].Available := False;
   end;
end;

procedure TComputer.GrayAPlane(idx: Byte);
var i: Byte;
begin
   with DrawPanel^.Planes[idx] do
      for i := 0 to 9 do begin
         GridState[TenPoints[i].y, TenPoints[i].x] := 3;
         SetPlanesAroundOneGridFalse(TenPoints[i].x, TenPoints[i].y);
         with DrawPanel^.Grids[TenPoints[i].y, TenPoints[i].x] do begin
            Brush.Color := clGray;
            Pen.Width := 1;
         end;
      end;
end;

procedure TComputer.HitOnePlaneHead(x, y: Byte);
begin
   dec(ComputerLefePlane);
   GrayAPlane(DrawPanel^.GridState[y, x].HoldPlaneIdx);
   GuessPanel^.ComputerHitPlayerPlaneHead;
   if ComputerLefePlane = 0 then
      GuessPanel^.ComputerWin;
end;

procedure TComputer.HitOnePlaneBody(x, y: Byte);
var i: Byte;
begin
   GridState[y, x] := 2;
   for i := 1 to 4 do
      planes[y, x, i].Available := False; //以这个点做机头的飞机删除
end;

procedure TComputer.HitBlankGrid(x, y: Byte);
begin
   GridState[y, x] := 1; //not body
   SetPlanesAroundOneGridFalse(x, y);
end;

function TComputer.ChkDeadGrid(x, y: Byte): Boolean;
var i: Byte;
begin
   Result := True;
   for i := 1 to 4 do
      if Planes[y, x, i].Available = True then begin
         Result := False;
         exit;
      end;
end;

procedure TComputer.AskAGrid(x, y: Byte; Randomly: Boolean);//询问某一格子的状态
var t: Byte;
begin
   if Randomly = True then begin
      Randomize;
      repeat
         x := RandomRange(1, in_GridCount - 1);
         y := RandomRange(1, in_GridCount - 1);
      until (GridState[y, x] = 0) and (ChkDeadGrid(x, y) = False); //unknown
   end;
   t := AskGridHitType(x, y);
   if inRisk then begin
      if ((t = 0) or (t = 2)) or ((t = 1) and (ComputerLefePlane - 1 <> 0)) then
         frmMain.LocalGameShowResult(1) //Player win
      else begin
         GrayAPlane(DrawPanel^.GridState[y, x].HoldPlaneIdx);
         frmMain.LocalGameShowResult(3); //Tie
      end;
   end else
      case t of
         0: HitBlankGrid(x, y);
         1: HitOnePlaneHead(x, y);
         2: HitOnePlaneBody(x, y);
      end;
end;

{
游戏电脑的AI实现原理是：
某一格G(x,y)已被确认是飞机的机身，则把可能以这个格子为机身的飞机权数都加一，最后用 MakeToAskPos
过程找到权数最大的飞机，作为下一个电脑询问的格子。
某一格G(x,y)已被确认不是飞机的机身，则将这个飞机删除。
}

procedure TComputer.SearchBodyGrids; //检查已确认是飞机机体的格子
var _y, _x, i, d: Byte; nowX, nowY: smallint;
   tmpArr: array[1..36] of Boolean; ArrCou: Byte;
begin
   for _y := 0 to in_GridCount - 1 do begin
      for _x := 0 to in_GridCount - 1 do begin
         if GridState[_y, _x] <> 2 then continue;
         ArrCou := 0; Fillchar(tmpArr, sizeof(tmpArr), False);
         for i := 1 to 36 do begin
            nowX := _x + AroundBePlane[i, 1];
            nowY := _y + AroundBePlane[i, 0];
            if CheckPoint(nowX, nowY) = False then continue;
            d := AroundBePlane[i, 2];
            with planes[nowY, nowX, d] do begin
               if Available = False then continue;
               tmpArr[i] := True;
               inc(ArrCou);
            end;
         end;
         for i := 1 to 36 do begin
            if tmpArr[i] = False then continue;
            inc(Planes[_y + AroundBePlane[i, 0], _x + AroundBePlane[i, 1], AroundBePlane[i, 2]].Possibility, 36 div ArrCou);
         end;
      end;
   end;
end;

procedure TComputer.SearchOnlyOnePlane;
var _y, _x, d: Byte; nowX, nowY: smallint; i: word; flag: Boolean;
label jump;
begin
   flag := False;
   for _y := 0 to in_GridCount - 1 do
      for _x := 0 to in_GridCount - 1 do begin
         if GridState[_y, _x] <> 2 then continue;
         flag := True;
         for i := 1 to 36 do begin
            nowX := _x + AroundBePlane[i, 1];
            nowY := _y + AroundBePlane[i, 0];
            if CheckPoint(nowX, nowY) = False then continue;
            d := AroundBePlane[i, 2];
            Planes[nowY, nowX, d].OfOnePlaneBody := True;
         end;
         goto jump;
      end;
   jump:
   if flag = False then exit;
   for i := 1 to PossiblePlaneCou do
      if planesIdx[i]^.OfOnePlaneBody = False then
         planesIdx[i]^.Available := False;
end;

procedure TComputer.SearchPlanes;
var i: Integer; t: Byte; nowPX, nowPY: smallint; bool: Boolean;
begin
   for i := 1 to PossiblePlaneCou do
      with planesIdx[i]^ do begin
         Possibility := 0;
         if Available = False then continue;
         bool := True;
         for t := 0 to 9 do begin
            nowPX := HeadPos.X + DPlaneBody[Direction, t, 0];
            nowPY := HeadPos.Y + DPlaneBody[Direction, t, 1];
            if GridState[nowPY, nowPX] in [1, 3] then begin
               bool := False;
               Break;
            end;
         end;
         if bool = False then begin
            Available := False;
            continue;
         end;
      end;
end;

procedure TComputer.MakeToAskPos;
var i, MaxP: Byte; MaxPossibilityIdx: word;
begin
   MaxP := planesIdx[1]^.Possibility; MaxPossibilityIdx := 1;
   for i := 2 to PossiblePlaneCou do
      if (planesIdx[i]^.Available = True) and (planesIdx[i]^.Possibility > MaxP) then begin
         MaxPossibilityIdx := i;
         MaxP := planesIdx[i]^.Possibility;
      end;
   if MaxP = 0 then begin
      ToAskPos.x := 0; ToAskPos.y := 0;
   end else
      ToAskPos := planesIdx[MaxPossibilityIdx]^.HeadPos;
end;

procedure TComputer.Think;
begin
   ThinkEnded := False;
   if (ToAskPos.x = 0) and (ToAskPos.y = 0) then
      AskAGrid(0, 0, True)
   else
      AskAGrid(ToAskPos.x, ToAskPos.y, False);
   if ComputerLefePlane = 0 then exit;
   SearchPlanes;
   SearchBodyGrids;
   if ComputerLefePlane = 1 then SearchOnlyOnePlane;
   MakeToAskPos;
   ThinkEnded := True;
   if in_FlashEnd then
      GuessPanel^.Mode := 3;
end;

////////////////////////////////////////////////////////////////////////////////

function CheckPoint(x, y: smallint): Boolean;
begin
   if (x in [0..in_GridCount - 1]) and (y in [0..in_GridCount - 1]) then Result := True else Result := False;
end;

end.