board.pas

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

  // and possibly move the piece
  if FDragging then
  begin
    if FHighlightStartSquare then
      EraseSquare(FDraggedPiece.Location, FDraggedPiece);

    // Remove any previous highlights by calling EraseSquare
    if FHighlightSquare.Count > 0 then
    repeat
      FindPiece(CurrPiecePtr, TPoint(FHighlightSquare.First^));
      EraseSquare(TPoint(FHighlightSquare.First^), CurrPiecePtr);

      Dispose(FHighlightSquare.First);
      FHighlightSquare.Delete(0);
    until FHighlightSquare.Count = 0;

    { If in position mode, call PositionDrop instead }
    if FPositionMode then
    begin
      PositionDrop(FindNewLocation(Msg.XPos, Msg.YPos));
      inherited;
      Exit;
    end;

    // If the move is valid...
    if Screen.Cursor = crYesMove then
    begin
      Curr := FDraggedPiece.Location;
      // Get board square from message x & y positions
      GetPos := FindNewLocation(Msg.XPos, Msg.YPos);

      if MovePiece(FDraggedPiece, GetPos) then
        SendEndTurnEvent;

      { Reset all information variables }
      FCaptureOn := False;
      FEnPassant := point(0,0);
      FCastling := csNone;
    end;

    { Reset all drag-drop information variables }
    Screen.Cursor := crDefault;
    FDragging := False;
    FDraggedPiece := nil;

    { Remember that you need to implement this for all the move functions if
      you intend to use this component elsewhere (I think) }
//          if Assigned(OnEndDrag) then OnEndDrag(FDraggedPiece^, Self, Msg.XPos, Msg.YPos);
//          etc for all other drag functions - TELL ME IF THIS IS NOT CORRECT
  end;

  CheckForGameEnd;

  inherited;
end;

{ Check for game ending positions - i.e. Checkmate, Stalemate and draw-by-
  repetition.  If these are found, finish the current game }
function TChessboard.CheckForGameEnd: Boolean;
var
  Finished,
  ResetGame: Boolean;
begin
  ResetGame := False;
  Finished := False;

  // Check for checkmate, stalemate and repetition
  if FCheck then
  begin
    if CheckForCheckmate then                 // Is player in checkmate?
    begin
      Finished := True;                       // prevents undo/redo until reset
      FGameRunning := False;
      if Assigned(FOnCheckmate) then FOnCheckMate(TColour(FTurn), ResetGame);
    end;
  end
  else
  if CheckForStalemate then                   // Is player in stalemate?
  begin
    Finished := True;
    FGameRunning := False;
    if Assigned(FOnDraw) then FOnDraw(True, False, ResetGame);
  end
  else
  if CheckForRepetition then                  // 3 move repetition draw?
  begin
    Finished := True;
    FGameRunning := False;
    if Assigned(FOnDraw) then FOnDraw(False, True, ResetGame);
  end;

  if Finished then
  begin
    if ResetGame then
      ResetBoard
    else
    begin
      FGameRunning := True;               // so finishcurrentgame does something
      FinishCurrentGame;
    end;
  end;

  Result := Finished;
end;

// TODO  possibly make this procedure into several, to improve readability

{ Handle WM_MOUSEMOVE, testing whether to respond by dragging pieces }
procedure TChessboard.WMMouseMove(var Msg: TWMMouseMove);
var
  PieceAtMouse,                 // Piece in current square, if any
  FindPiecePtr: TPiece;
  i: Integer;
  AtStartSquare,                // Is location over FDraggedPiece's start square?
  MoveIsValid: Boolean;
  NewLoc,                       // Square mouse is currently over
  OldHighlight: TPoint;         // Used to store old highlights & then erase them
  AddLoc: ^TPoint;              // create a new point for adding to highlight list
  AddHighlightHere: Boolean;    // add highlight outline at current square?
  oldColour: TColor;            // used for temp. swapping highlight colours
  TempOldLoc: TPoint;           // change this later...
begin
  if FGameRunning then
  begin
    NewLoc := FindNewLocation(Msg.XPos, Msg.YPos);

    if FDragging then
    begin
      // Check if moving over the same square as last time - if so, nothing
      // has changed.  This check gives a nice boost in efficiency.  Just
      // look at the amount of code this can ignore!
      if ComparePoints(NewLoc, FOldDragLoc) then
      begin
        inherited;
        Exit;
      end;

      TempOldLoc := FOldDragLoc;

      // Update this to be the most recent square dragged over
      FOldDragLoc := NewLoc;

      { If in position mode, call PositionMove instead }
      if FPositionMode then
      begin
        PositionMove(NewLoc);
        inherited;
        Exit;
      end;

      if (InBounds(NewLoc)) then
        AddHighlightHere := not FSquaresHighlighted[NewLoc.X shl 3 + NewLoc.Y - 9]
      else
        AddHighlightHere := False;

      AtStartSquare := ComparePoints(NewLoc, FDraggedPiece.Location);

      if AtStartSquare and not FHighlightStartSquare then
      begin
        inherited;
        Exit;
      end;

      MoveIsValid := ValidMove(FDraggedPiece.Location, NewLoc);

      // The following block is used for ShowValidMoves mode.  It checks to
      // see if the new square is a valid one by checking the highlight list.
      // If it is, it sets the previously highlighted square back to the
      // default highlight colour, changes the current square and sets the
      // current square to be the last highlighted square to be changed.

      if FShowValidMoves then
      begin
        if MoveIsValid then
        begin
          // Unhighlight the previously "current" square
          if not AtStartSquare then
            if ComparePoints(FLastValidMoveLoc, FDraggedPiece.Location) = False then
              HighlightBoardSquare(FLastValidMoveLoc, Ord(FDraggedPiece.Colour) = Turn);

          // Highlight the new location with "current" move colour
          for i := 0 to FHighlightSquare.Count - 1 do
          begin
            if ComparePoints(NewLoc, TPoint(FHighlightSquare[i]^)) then
            begin
              OldColour := FHighlightColour;
              FHighlightColour := FValidMoveDragColour;

              HighlightBoardSquare(NewLoc, Ord(FDraggedPiece.Colour) = Turn);

              FHighlightColour := OldColour;
              Break;
            end;
          end;

          FLastValidMoveLoc := NewLoc;
        end
        else
          // If not a valid move, unhighlight the last valid square
          if ComparePoints(FLastValidMoveLoc, FDraggedPiece.Location) = False then
            HighlightBoardSquare(FLastValidMoveLoc, Ord(FDraggedPiece.Colour) = FTurn);

        AddHighlightHere := False;
      end;

      // This block is for the default type of highlighting, when a piece is
      // dragged over a new location.

      if AddHighlightHere then
      begin
        // Create a new square for the highlight list
        New(AddLoc);
        AddLoc^ := NewLoc;

        // Clear any old highlights on the board - note that this does not
        // affect the original dragged location, which will be cleared when
        // the drag-drop has finished
        if FHighlightSquare.Count > 0 then
        repeat
          OldHighlight := TPoint(FHighlightSquare.First^);
          FindPiece(FindPiecePtr, OldHighlight);

          // Don't unhighlight the original square!
          if FindPiecePtr <> FDraggedPiece then
              EraseSquare(OldHighlight, FindPiecePtr);

          FSquaresHighlighted[ OldHighlight.X shl 3 + OldHighlight.Y - 9] := False;

          Dispose(FHighlightSquare.First);
          FHighlightSquare.Delete(0);

        until FHighlightSquare.Count = 0;

        // Adding it to the list so it can be cleared either by a later
        // mouse move or when the drag-drop has finished
        FHighlightSquare.Insert(0, AddLoc);

        // NOW to highlight the square (finally!).  If the current move is
        // valid, or highlighting the original square, then display using
        // the "valid move" colour (default of clYellow).  Otherwise, display
        // using the "ememy/invalid" colour (default of clRed).  Note that
        // HighlightBoardSquare may decide to display the square using the
        // "emeny capture" colour (clLime) if there is an enemy piece to
        // capture.  See also HighlightBoardSquare

        OldColour := FHighlightColour;

        if (MoveIsValid) or ( AtStartSquare and
                              (Ord(FDraggedPiece.Colour) <> Turn) ) then
        begin
          if AtStartSquare then
            FHighlightColour := FStartDragColour;
          HighlightBoardSquare(AddLoc^, False);
        end
        else
        begin
          FHighlightColour := FHighlightEnemyColour;
          HighlightBoardSquare(AddLoc^, True);
        end;

        FHighlightColour := OldColour;

        FSquaresHighlighted[AddLoc^.X shl 3 + AddLoc^.Y - 9] := True;

//        Dispose(AddLoc);
//        FHighlightSquare.Delete(0);
      end;

      // Change screen cursor to either accept or decline piece
      if MoveIsValid then
        Screen.Cursor := crYesMove
      else
        Screen.Cursor := crNoMove;
    end
    else
    // Not dragging the piece, so show the piece hint instead
    if FShowHints then
    begin
      if FindPiece(PieceAtMouse, NewLoc) then
        Hint := PieceAtMouse.Hint
      else
        Hint := '';
    end;
  end;

  inherited;
end;

{ This procedure calculates all of the relevant details for the set of special
  cases that the OnEndTurn event needs.  Once this is complete, it then calls
  the OnEndTurn event, passing in the new parameters.  MAKE SURE TO CALL THIS
  AFTER A CALL TO MOVEPIECE IF YOU WANT THE EVENT "OnEndTurn" TO BE CALLED! }
procedure TChessboard.SendEndTurnEvent;
var
  MoveDetails: TSetOfSpecials;
  r: TUndoRecordPtr;
  PiecePtr: TPiece;
begin
  if Assigned(FOnEndTurn) then
  begin
    MoveDetails := [];

    if FCheck then Include(MoveDetails, spCheck);

    if FCastling <> csNone then
    begin
      if FCastling = csQueenSideCastling then
        Include(MoveDetails, spQueenSideCastling)
      else
        Include(MoveDetails, spKingSideCastling);
    end
    else
      if FCaptureOn then Include(MoveDetails, spCapture);

    if (FEnPassant.X <> 0) then Include(MoveDetails, spEnPassant);
    R := UndoList[FUndoCount];

    if R^.PromotedPiece <> nil then
    begin
      Include(MoveDetails, spPromoting);
      PiecePtr := R^.PromotedPiece;
    end
    else
      PiecePtr := R^.MovedPiece;

    OnEndTurn(PiecePtr, R.From, R.WhereTo, MoveDetails);
  end;
end;

{ Return whether the current position is checkmate or not }
function TChessboard.CheckforCheckmate: Boolean;
var
  x,y: Integer;
  KingPtr,
  P,                     // meaningful variable name :) Used for temp. checking each piece
  EnemyPtr: TPiece;      // if 1 piece is attacking the king, it's stored in here
  KingColour: TColour;   // The colour of the king under attack
  i: Integer;
  StartPt,               // Used for calculating blocking positions
  EndPt: TPoint;         // Same here
begin