board.pas

来自「用于开发税务票据管理的软件」· PAS 代码 · 共 1,705 行 · 第 1/5 页

  Result := False;

  // A fancy alternative to the commented-out line, but it should be faster as
  // it avoids an 'if' statement
  KingColour := TColour(Turn xor 1);
//  if Turn = 0 then KingColour := cBlack else KingColour := cWhite;

  FindKing(KingPtr, KingColour);

  // Check if the king can move out of danger himself
  for y := -1 to 1 do
  begin
    if ValidMove(KingPtr.Location, Point(KingPtr.X + -1, KingPtr.Y + Y)) then Exit;
    if ValidMove(KingPtr.Location, Point(KingPtr.X, KingPtr.Y + Y)) then Exit;
    if ValidMove(KingPtr.Location, Point(KingPtr.X + 1, KingPtr.Y + Y)) then Exit;
  end;

  // If in double check and the king can't move out, then it's mate
  if PiecesAttackingSquare(KingPtr.Location, TColour(Turn)) > 1 then
  begin
    Result := True;
    Exit;
  end;

  EnemyPtr := nil;

  // It is established that 1 piece is attacking the king, so find it
  for i := 0 to High(Board) do
  begin
    EnemyPtr := Board[i];

    if not ((EnemyPtr = nil) or (EnemyPtr.Captured) or
            (EnemyPtr.Colour = KingColour)) then
      // Have we found it?...
      if PieceCanAttackSquare(EnemyPtr, KingPtr.Location) then Break;
  end;

  // Check for capturing the enemy piece
  for i := 0 to High(Board) do
  begin
    P := Board[i];
    // Find a piece of the attacked king's colour
    if not ((P = nil) or (p.Captured) or (p.Colour <> KingColour)) then
      // Check if it can move to enemy location
      if ValidMove(P.Location, EnemyPtr.Location) then Exit;
  end;

  // Check for blocking the attack - note that knights and pawns cannot be blocked.
  // This code should use the same type of functionality as the PiecesInWay func.
  if not ((EnemyPtr is TKnight) or (EnemyPtr is TPawn)) then
    if (abs(EnemyPtr.X - KingPtr.X) > 1) or
       (abs(EnemyPtr.Y - KingPtr.y) > 1) then
    begin
      // CODE TO CHECK FOR BLOCKING
      ////////////////////////////////////////////////////////////////////////

      if EnemyPtr.X < KingPtr.X then
      begin
        StartPt := EnemyPtr.Location;
        EndPt := KingPtr.Location;
      end
      else
      begin
        StartPt := KingPtr.Location;
        EndPt := EnemyPtr.Location;
      end;

      X := StartPt.X;
      Y := StartPt.Y;

      while ComparePoints(Point(x,y), EndPt) = False do
      begin
        if StartPt.X <> EndPt.X then Inc(X);
        if StartPt.Y <> EndPt.Y then
        begin
          if StartPt.Y < EndPt.Y then Inc(Y) else Dec(Y);
        end;

        for i := 0 to High(Board) do
        begin
          P := Board[i];
          if not ((p = nil) or (P.Captured) or (P.Colour <> KingColour)) then
            if ValidMove(P.Location, Point(X, Y)) then Exit;
        end;
      end;

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

    end;

  Result := True;
end;

// TODO  make this function take into account FUndoCount (CONFIRM THIS IS NEEDED!)
function TChessboard.CheckForRepetition: Boolean;
var
  i: Cardinal;
begin
  Result := False;

  // There must be at least 12 moves for the repetition rule to
  // come into effect
  if UndoList.Count < 12 then Exit;

  // CHECK UNDO LIST FOR REPETITION
  // Test the records in sets of 3:  [0,4,8] [1,5,9] [2,6,10] and [3,7,11] to
  // see if they contain the same data
  i := 0;
  while i < 3 do
  begin
    if (CompareUndoRecords(UndoList[i], UndoList[i + 4]) = False) or
       (CompareUndoRecords(UndoList[i + 4], UndoList[i + 8]) = False) then
      Exit;

    Inc(i);
  end;

  Result := True;
end;

{ Return whether two undo records contain the same data - note the _slightly_
  improved implementation of this function :) !!! }
function TChessboard.CompareUndoRecords(const R1, R2: TUndoRecordPtr): Boolean;
begin
  // All together now - "DUH!"  See below :)
  Result := CompareMem(R1, R2, Sizeof(TUndoRecord));

{  Result := False;

  // THERE ** MUST ** BE A BETTER WAY!!!!!!!
  if (R1^.PromotedPiece = R2^.PromotedPiece) and
     (R1^.LastPawnMoved = R2^.LastPawnMoved) and
     (R1^.MovedRook     = R2^.MovedRook    ) and
     (R1^.CapturedPiece = R2^.CapturedPiece) and
     (R1^.MovedPiece    = R2^.MovedPiece   ) and
     (R1^.Castled       = R2^.Castled      ) and
     (R1^.Capture       = R2^.Capture      ) and
     (R1^.PromotedPawn  = R2^.PromotedPawn ) and
     ((R1^.EnPassant.X = R2^.EnPassant.X) and (R1^.EnPassant.Y = R2^.EnPassant.Y)) and
     ((R1^.WhereTo.X = R2^.WhereTo.X) and (R1^.WhereTo.Y = R2^.WhereTo.Y)) and
     ((R1^.From.X = R2^.From.X) and (R1.From.Y = R2.From.Y)) then
       Result := True;}
end;

{ Tests whether the current position is stalemate - i.e. if all the pieces of
  the currently-to-move cannot move to any board square at all }
function TChessboard.CheckForStalemate: Boolean;
var
  i: Integer;
  KingColour: TColour;
  P: TPiece;
  x, y: Byte;
begin
  Result := False;

  KingColour := TColour(Turn xor 1);
  //if Turn = 0 then KingColour := cBlack else KingColour := cWhite;

  for i := 0 to High(Board) do
  begin
    P := Board[i];
    if not ((P = nil) or (P.Colour <> KingColour) or (P.Captured)) then
      for y := 1 to 8 do
        for x := 1 to 8 do
          if ValidMove(P.Location, Point(x,y)) then Exit;
  end;

  Result := True;
end;

{ This function calls HighlightBoardSquare for each item in the TList
  "FHighlightSquare".  See just below this for HighlightBoardSquare definiton }
procedure TChessboard.HighlightSquares(const HowMany: Cardinal; const MovingEnemy: Boolean);
var
  i: Cardinal;
  Pos: TPoint;
begin
  if not FShowSquareHighlights or (HowMany = 0) then Exit;

  for i := 0 to HowMany - 1 do
  try
    Pos := TPoint(FHighlightSquare[i]^);

    if (InBounds(Pos)) then
      HighlightBoardSquare(Pos, MovingEnemy);
  except
    MessageDlg('There was an invalid amount of squares to highlight', mtError, [mbOK], 0);
  end;
end;

{ This draws an outline around a specified board square, the width determined
  by FHighlightWidth.  The boolean MovingEnemy helps to decide what colour
  to draw it - if false, FHighlightColour is used. Otherwise,
  FHighlightEnemyColour or FHighlightCaptureColour are used depending on context }
procedure TChessboard.HighlightBoardSquare(const Where: TPoint; const MovingEnemy: Boolean);
var
  PieceInSquarePtr: TPiece;
  Pos: TPoint;
//offset: Byte;
begin
  if not FShowSquareHighlights then Exit;

  Canvas.Pen.Color := FHighlightColour;
  Pos := Where;

  // This displays captures in the enemy highlight colour, as well as any
  // enemy piece that one side attempts to move (e.g. white dragging a black piece)
  if FindPiece(PieceInSquarePtr, Pos) then
    if Ord(PieceInSquarePtr.Colour) = FTurn then
    begin
      if MovingEnemy then
        Canvas.Pen.Color := FHighlightEnemyColour
      else
        Canvas.Pen.Color := FHighlightCaptureColour;
    end;

  // Convert the location into the correct places to draw
  Pos.X := Pos.X - 1;
  Pos.Y := 8 - Pos.Y;

  Canvas.Pen.Width := FHighlightWidth;

  // Note: This line drawing may not yet be perfect.  Feel free to fiddle
  // with it.  The Offset variable is for when drawing with/without grid lines,
  // since the lines might encompass different locations
//    if FDrawLines then Offset := 0 else OffSet := 1;
//    offset := 0;

  // Draw the square - the offset is because of the way the grid lines are
  // drawn; the locations for the lines need to be slightly different
  // depending on whether grid lines are visible or not

  // TODO  make this take account of FHighlightWidth

  Canvas.PolyLine( [ Point(FSquareSize * Pos.X + 2,     FSquareSize * Pos.Y + 2),
                     Point(FSquareSize * (Pos.X+1) - 1, FSquareSize * Pos.Y + 2),
                     Point(FSquareSize * (Pos.X+1) - 1, FSquareSize * (Pos.Y+1) - 1),
                     Point(FSquareSize * Pos.X + 2,     FSquareSize * (Pos.Y+1) - 1),
                     Point(FSquareSize * Pos.X + 2,     FSquareSize * Pos.Y + 2) ]);

  Canvas.Pen.Width := FGridlineWidth;
end;

{ Highlights all the squares a given piece can move to, by checking the board
  and adding valid moves into FHighlightSquare.  Either the squares are
  highlighted, or a beep is made for no valid moves available for that piece }
procedure TChessboard.ShowValidMoves(const PieceWhere: TPiece);
var
  x,y: Byte;
  AddPointPtr: ^TPoint;
begin
  // Search through all 64 squares checking for valid moves.  When/if a valid
  // move is found then add it to the list of squares to highlight
  for y := 1 to 8 do
  begin
    for x := 1 to 8 do
    begin
      if ValidMove(PieceWhere.Location, Point(x,y)) then
      begin
        New(AddPointPtr);
        AddPointPtr^ := Point(x,y);
        FHighlightSquare.Add(AddPointPtr);
      end;
    end;
  end;

  // Display all the valid moves for the piece, or beep if there are no moves
  if FHighlightSquare.Count = 0 then
    SysUtils.Beep
  else
    HighlightSquares(FHighlightSquare.Count, Ord(PieceWhere.Colour) = Turn);
end;

{ These two procedures are used so that the player can set up positions on the
  board if they want.  These check that there is not a piece in the way first,
  and if not then the piece is not moved. }

procedure TChessboard.PositionMove(const MoveTo: TPoint);
begin
  if FDragging then
  begin
    // Allow the move if in bounds and another piece is not already there
    if (not InBounds(MoveTo)) or (FPiecesInSquares[MoveTo.X shl 3 + MoveTo.Y - 9]) then
      Screen.Cursor := crNoMove
    else
      Screen.Cursor := crYesMove;
  end;
end;

procedure TChessboard.PositionDrop(const DropLocation: TPoint);
var
  OldLoc: TPoint;
begin
  if FDragging then
  try
    if InBounds(DropLocation) then
      // Only allow dropping here if a piece is not here already
      if FPiecesInSquares[DropLocation.X shl 3 + DropLocation.Y - 9] = False then
      begin
        OldLoc := FDraggedPiece.Location;

        UpdateUndoRecords(OldLoc, DropLocation, True);

        FPiecesInSquares[OldLoc.X shl 3 + OldLoc.Y - 9] := False;
        EraseSquare(FDraggedPiece.Location, nil);
        FDraggedPiece.SetLocation(DropLocation);
        EraseSquare(FDraggedPiece.Location, FDraggedPiece);
        FPiecesInSquares[DropLocation.X shl 3 + DropLocation.Y - 9] := True;

        FPositionDropChanged := True;  // so ResetBoard() drawing doesn't screw up
        if Assigned(FOnPositionMove) then
          FOnPositionMove(FDraggedPiece.Colour, OldLoc, DropLocation);
      end;

  finally
    FDragging := False;
    Screen.Cursor := crDefault;
    FDraggedPiece := nil;
  end;
end;

{ You should be able to work out what this procedure does :)  }
procedure TChessboard.Paint;
var
  i,j: Integer;
  CurrPiecePtr: TPiece;
  SquareIsWhite: Boolean;
  BrushColours: array[Boolean] of TColor;
begin
  inherited Paint;
  SquareIsWhite := True;

  BrushColours[True] := FWhiteC;
  BrushColours[False] := FBlackC;

  // Check if the image needs resizing
  if FStretch then
  begin
    if (FOldWidth <> Width) or (FOldHeight <> Height) then
    begin
      FOldWidth := Width;