board.pas

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

unit Board;

{ Chessboard component for Delphi (written partly in Delphi 1, before I moved
  to Delphi 3 and finished it) by Alistair Keys

  This component encapsulates all the rules of chess (hopefully), including
  such gits as castling, en passant, check and promotion of pawns from the
  final rank of their colour.  Pieces are moved by drag-dropping them.

  To use this component, drop it onto something then either call the function
  'ResetBoard', or 'LoadGame' with a valid load file to see the pieces.

  This code was downloaded from http://www.dundee.ac.uk/~arkeys/
  Get more free code from there, or read one of many tutorials!

  Notes: the following converts a location (TPoint) into a number from 0 to 63
     SomePoint.x shl 3 + SomePoint.y - 9

  e.g. point(1,1) = 1 shl 3 (8) + 1 - 9 = 0
       point(1,2) = 1 shl 3 (8) + 2 - 9 = 1
       ...
       point(1,8) = 1 shl 3 (8) + 8 - 9 = 7

       point(2,1) = 2 shl 3 (16) + 1 - 9 = 8
       point(2,2) = 2 shl 3 (16) + 2 - 9 = 9

  So you can see that each row takes up the correct 8 slots, in sequence.  Don't
  be intimidated when you see this a lot, since it is used for the TBits to
  quickly find whether a location holds something.

  Also, the following:

    if (Point1.x - Point2.x) or (Point1.y - Point2.Y) = 0 then ...

  is the same as "if (Point.X = Point2.X) and (Point1.Y = Point2.Y) then", but
  I think it is a bit faster.  You might see more odd code like this... like
  when I start a loop at the highest value and dec() downwards, because
  dec()ing to zero is typically a quick instruction.

  --- this code is an example of premature optimisation ;).  Looking back, it
      was probably not very cunning of me.  However, I was young and foolish
      back then so forgive me.  Think about optimising the piece finding.
      Also, I think if the board was changed to 64 squares instead of 48
      (16 pieces each + 8 promotions each) it will probably be possible to
      speed up things further

  For more information about the optimisations used in this code, go to:
  http://www.azillionmonkeys.com/qed/optimize.html/

  DISCLAIMER: I (Alistair Keys) am not responsible for any harm caused by
  the use or misuse of this code, either in its or original form or any
  modified form.  If you do not agree to this, then you are not permitted to
  use this code, so get outta here!  This code is provided "as is".

  P.S.  If you do use this code, give me a mention please!

  Important notes:

  # USE "FORCEREDRAW" INSTEAD OF "INVALIDATE".  Because the board only redraws
    itself when something has changed, calling invalidate will result in the
    last bitmap drawn to be used instead, which will almost certainly be out-of-
    date.  ForceRedraw is provided to correctly redraw the entire image.

  # The pieces load their pictures from a sub-directory called 'Pictures', using
    the format of 'name of piece' + W or B (colour) + '.bmp'.  For example,
    'RookW.Bmp'.  If these pictures aren't available then you will not see
    any pieces.

  # You can set the undo limit to whatever you feel is appropriate.  Its default
    value is 0, meaning no limit.  However, note that if you put it at less than
    12 then the 3-move repetition rule will not be available.  This is because
    the board uses the undo list to check if the moves were the same.  The value
    of 12 comes from 6 moves each for black and white, where the six moves are
    moving back and forth from the same squares 3 times. ALSO, I have only
    tested the board with its default undo limit of 0 (unlimited).  It may or
    may not function correctly with other values, but you shouldn't need to
    change it anyway.

  # The board uses a form called 'frmPawnPromote' in the unit 'Promote' to get
    which piece to promote the pawn to.  If this is not present, then you'll
    have to create your own.  It uses a radiogroupbox's itemindex (called
    rgpPieces) to decide which piece to add:
                 0 = Queen, 1 = Rook, 2 = Bishop, 3 = Knight
    If the itemindex is not in this range, the board uses an EInvalidType
    exception (see below) to display this information to you.

  Things you will want to know about
  ----------------------------------

  PROCEDURES/FUNCTIONS
    DrawCapturedPieces - this draws the pieces captured for a colour, allowing
                         you to specify the pieces per row, width and height of
                         drawing
    FinishCurrentGame - Stops the game, preventing drag-drop of pieces, etc.
    ForceRedraw - Call this instead of Invalidate to redraw the board
    GetPointsTotal - Get the rough piece values for a side
    LoadGame - Just what you'd expect; loads a game
    Pause - Sets the game timer to 0 interval, for time-enabled games
    Redo - this reapplies the last undone move
    ResetBoard - this sets up the standard position, wiping everything out
    SaveGame - Again, pretty obvious.
    Undo - this removes the last move from the board.
    Unpause - Sets the game timer back to 1000 interval, for time-enabled games

  EVENTS
    OnCheckmate - Only info is the winner's colour
    OnDraw - Contains whether the draw was stalemate or repetition
    OnEndTurn - Do what you want when the end of the turn is done.  It contains
              info about the piece moved, from and where to, as well as special
              cases like captures, checks, en passant, etc.  Like this:

              TSpecials = (spKingSideCastling, spQueenSideCastling, spEnPassant,
                           spPromoting, spCapture, spCheck);
              TSetOfSpecials = set of TSpecials;
    OnPositionMove - if PositionMode is true, this will be called when a piece
                     is moved
    OnTimeLoss - If one side loses on time, this is called

  ( As well as standard ones, like onMouseDown, etc.)

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

  (* Denotes a run-time (public) property)

  PROPERTIES
    Author: String              There is no escape from the credit to me!! Read-only, of course.
    BackgroundColour: TColor    Colour of background outwith board (no effect if pic selected)
    BlackSquareColour: TColor   Colour for black squares
  * Check: Boolean              Read-only property, reports whether current player is in check
    DrawLines: Boolean          Should grid lines be drawn?
  * GameRunning: Boolean        Is there a game running just now or not?
    GridLineColour: TColor      Colour of grid lines (duh :)
    GridLineWidth: Cardinal     Width of the grid lines (default 1)
    HighlightCaptureColour,     Colour when square holds enemy piece that can be captured
    HighlightColour: TColor     Colour when selecting your pieces
    HighlightEnemyColour:TColor Colour when selecting enemy piece, or capture square
    HighlightWidth: Cardinal    Width of highlight around square
  * PointsBlack: Byte           Total amount of points for Black (Using rough values)
  * PointsWhite: Byte           Total amount of points for White
    Picture: TPicture           Draws this picture on the background if selected
    PieceFilter: ShortString    Changes the filter used by pieces - see "piece.pas"
  * PositionMode: Boolean       Use this to toggle between game movement & positioning pieces
  * RedoPossible: Boolean       Whether the board can redo any moves
    ShowPieceHints: Boolean     Set the hint for all the pieces on the board
    ShowSquareHighlights,       Should squares be outlined for highlighting?
    ShowValidMovesMode: Boolean Whether to display valid squares when dragging a piece
    SmoothPieces: Boolean       Whether to apply a filter to pieces to smooth them
    StartDragColour: TColor     Colour for beginning a drag-drop move of a piece
    Stretch: Boolean            Stretch the board when it is resized?
    StretchPicture: Boolean     Stretch the background picture?
    TimeBlack: Cardinal         The time black has used up (in seconds)
    TimeLimit: Cardinal         The total time allowed for each side (in seconds)
    TimeLimitEnabled: Boolean   Use the time limit or not?
    TimeWhite: Cardinal         The time white has used up (in seconds)
  * Turn: byte                  Read-only, shows which player should move (0-black, 1-white, ONLY THOSE VALUES)
  * TurnNumber: Cardinal        Read-only, shows the current turn number
    UndoLimit: Byte             Sets the amount of undo records to keep (default 0, i.e. no limit)
  * UndoPossible: Boolean       Whether the board can undo the last move
    ValidMoveDragColour: TColor If moving a piece, valid squares use this colour
    WhiteSquareColour: TColor   Colour for white squares
    WidthOfSquares: Cardinal    If Stretch is false, this is the size of square to use

  ( As well as standard ones like Enabled, Visible, Hint, Align, etc. )

  EXCEPTIONS
    ECapturePieceNotThere
         Mainly raised when capturing a piece in the drag drop function, sometimes in
         drag over too (corresponds to protected MovePiece() and ValidMove() functions).
         If FindPiece returns false at unexpected, crucial times, expect this error

    EInvalidType
         Raised when loading a file, and the type when trying to create a piece is not
         recognised (i.e., not 'Pawn', 'Rook', etc.).  Also raised when promoting a
         pawn and an invalid (not 0 - 3) piece number is given back.  Not raised any other
         time.

    EPieceNotFoundInSquare
         Raised mainly if a piece is placed on the board manually, so that its owner is
         a chessboard but it is not part of the board.  The board tries to find a piece
         in its collection in the square, but can't.  May be thrown sometimes after something
         goes weird in a load file that isn't covered by an exception (unlikely), cannot
         be certain.  If FindPiece returns false at unexpected, crucial times, expect this
         error as well.

  FUTURE IMPROVEMENTS
    Obviously, AI is the most important of these.  I was thinking about trying
    some of the following tactics for this:

    #  Keeping text files that show characteristic openings, such as Sicilian, Caro-Kann,
       Guioco Piano, Ruy Lopez, etc.  The AI would check these for the first few moves, and
       if it finds a match it could read the long term strategy from here (e.g., Alekhine's
       Defence would be to provoke a centre too far forward from white, then attack from
       flanks/try to mess up centre.  You get the idea).

    #  Analysing moves by checking the total points value for each side, the number of
       checks, the number of major pieces, etc.  It would then put these moves into
       several categories (maybe TLists of records similar to TUndoRecords, perhaps?) such
       as AI_Sacrifice, AI_Silly, AI_Development, AI_Threat, whatever else.  Which one the
       move is selected from would depend on the AI's 'level' - probably a byte.  This would
       make it a bit easier to implement AI skill levels.

    #  Of course, use standard AI tricks like creating trees and analysing several
       moves down, etc. }

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, TimerRX,
  Forms, Dialogs, Piece, King, Queen, Rook, Bishop, Knight, Pawn, Promote,
  {HyperStr, } Math{, DIBUltra, DIBType};

type
//  TPiecePtr = ^TPiece;

  TSpecials = (spKingSideCastling, spQueenSideCastling, spEnPassant,
               spPromoting, spCapture, spCheck);
  TSetOfSpecials = set of TSpecials;

  TCastled = (csNone, csQueenSideCastling, csKingSideCastling);
  TPromotedPiece = (prQueen, prRook, prBishop, prKnight);

  TNotifyEndTurn = procedure(MovedPiece: TPiece; const From, WhereTo: TPoint;
                                  SpecialCases: TSetOfSpecials) of object;
  TNotifyCheckMate = procedure(Winner: TColour; var ResetGame: Boolean) of object;
  TNotifyTimeLoss = procedure(Loser: TColour; var ResetGame: Boolean) of object;
  TNotifyDraw = procedure(Stalemate, Repetition: Boolean; var ResetGame: Boolean) of object;
  TNotifyPositionMove = procedure(MovedColour: TColour; const From, WhereTo: TPoint) of object;

  { This stores everything that is needed to undo a move, as given in the
    functions Undo, AddUndoRecord and DropUndoRecords (and Redo) }
  TUndoRecord = packed record
              From: TPoint;
              WhereTo: TPoint;
              EnPassant: TPoint;
              PromotedPawn: TPawn;
              Capture: Boolean;
              Check: Boolean;
              Castled: TCastled;
              MovedPiece: TPiece;
              CapturedPiece: TPiece;
              MovedRook: TRook;
              LastPawnMoved: TPawn;
              PromotedPiece: TPiece;
              PositionMode: Boolean;
  end;

  TUndoRecordPtr = ^TUndoRecord;

  // Used to count the amount of each piece type in the following order:
  // Rook, Knight, Bishop, Queen, Pawn, King
  TPiecesCountArray = Array[0..5] of Byte;
  PPiecesCountArray = ^TPiecesCountArray;

  ECapturePieceNotThere = class(Exception);
  EPieceNotFoundInSquare = class(Exception);
  EInvalidType = class(Exception);

  PChessboard = ^TChessboard;
  TChessboard = class(TGraphicControl)
  private
    { Private declarations }
    Board: Array[0..47] of TPiece; // stores all of the pieces (inc. empty slots for promotions)
    FBackgroundC: TColor;           // Background Colour
    FBitmap: TBitmap;//TDIBUltra;             // Buffer to draw everything on
    FCaptureOn,                     // was the move a capture?
    FCheck: Boolean;                // was the move a check?
    FCastling: TCastled;            // King-side, Queen-side or none

    { These two are needed since I implement drag-drop in a peculiar way.  I handle
      the Windows mouse-move messages directly, since this allows the board to
      control drawing the pieces in a quicker fashion.  Doing this reduces flicker.
      I did implement this in a sensible way first (i.e. by having the pieces visible
      and responding to the drag themselves) but that wasn't as pretty. }
    FDragging: Boolean;
    FDraggedPiece: TPiece;

    FGridlineWidth,                 // Board grid line width (default 1)
    FHighlightWidth: Cardinal;      // Square highlight width (default 2)

    FDrawLines: Boolean;            // Draw the grid-lines
    FEnPassant: TPoint;             // (0,0) if not available, otherwise square of captured pawn
    FGameRunning: Boolean;          // So user can't drag pieces after finish of a game
    FGridLineColour,
    FHighlightColour,
    FHighlightEnemyColour,
    FHighlightCaptureColour: TColor;
    FHighlightSquare: TList;        // When a piece is dragged, this signals where from (for highlighting)
    FHighlightStartSquare: Boolean; // Whether to display a highlight at the piece's initial location
    FLastPawnMoved: TPawn;          // Holds location for any en-passant viable 2-move pawn
    FLastValidMoveLoc: TPoint;      // Used to correctly draw squares in ShowValidMoves mode
    FLoading: Boolean;              // Used to stop drawing while loading
    FOldDragLoc: TPoint;            // Used to optimise mouse dragging
    FOldHeight,                     // These two are used to check if the board...
    FOldWidth: Cardinal;            // ...has been resized since last drawn
    FPic: TPicture;                 // Background picture.  If not used, background colour is used instead
    FPicChanged: Boolean;           // used to decide whether to redraw everything or use old bitmap
    FPiecesInSquares: TBits;        // Used to quickly determine if a piece is in a square
    FPositionDropChanged,           // Prevents PositionMode messing up ResetBoard redrawing
    FPositionMode,                  // Used if player wants to position pieces rather than play game
    FShowHints,                     // Display piece hints as board's hint on MouseOver?
    FShowSquareHighlights,          // Display square outlines as appropriate?
    FShowValidMoves,                // Toggle whether to display all valid moves when piece is dragged
    FSmoothPieces: Boolean;         // whether to apply a filter to the pieces or not
    FStartDragColour: TColor;       // When use starts dragging a piece, use this colour
    FStretch,                       // Should board be stretched on resizing of board?
    FStretchPic: Boolean;           // Stretch the background pic if applicable?
    FSquareSize: Cardinal;          // Size of board squares: min(width, height) / 8 if FStretch is true
    FSquaresHighlighted: TBits;     // Used to quickly determine if a square is highlighted already
    FPromotePawnType: String;       // Set when loading and a pawn gets promoted - see promotion routines

    { Time limit variables }
    FTimeLimit,                     // The limit for each side (in minutes)
    FTimeBlack,                     // Black's time left
    FTimeWhite: Cardinal;           // White's time left
    FTimerClock: TRXTimer;          // The timer to update game time
    FTimerEnabled: Boolean;         // Whether to use the time limit or not

    FTurnNumber: Cardinal;          // Game turn number
    FTurn: Byte;                    // 0 or 1 for white or black to move
    UndoList: TList;                // A TList of undo records (see above), added to every time a move is made
    FUndoLimit: Byte;               // Default: 0 = no limit
    FUndoCount: Cardinal;           // Used for undo/redo, stores current record number
    FValidMoveDragColour: TColor;   // Colour used to highlight current square with ShowValidMoves mode on
    FWhiteC,                        // White square colour
    FBlackC: TColor;                // Black square colour

    FOnCheckmate: TNotifyCheckmate;          // Called when checkmate occurs
    FOnDraw: TNotifyDraw;                    // Called on stalemate, repetition
    FOnEndTurn: TNotifyEndTurn;              // Called when a move is made
    FOnPositionMove: TNotifyPositionMove;    // Called after a PositionMode move
    FOnTimeLoss: TNotifyTimeLoss;            // Called if one side loses on time

    // NOTE: Lots of get/set functions for properties are in the file
    // BoardProperties.pas to make this file a bit clearer

    procedure AddPiece(const Which: TPiece);
    procedure AddUndoRecord(const From, WhereTo: TPoint);
    procedure CapturePiece(CapturedPiece: TPiece);
    procedure ChangeBlackSquareColour(const NewVal: TColor);
    procedure ChangeBackgroundColour(const NewVal: TColor);
    procedure ChangeGridLineColour(const NewVal: TColor);