home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 10.ddi / CHESS.ZIP / OWCHPIEC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  6.1 KB  |  210 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Chess Demo                     }
  4. {   Chess Pieces unit                            }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit OWChPiec;
  10.  
  11. interface
  12.  
  13. uses WinProcs, WinTypes, OWindows, OWPieces, Chessdll, OWConst;
  14.  
  15. type
  16.  
  17.   PChessPiece = ^TChessPiece;
  18.   TChessPiece = object (TGamePiece)
  19.     Piece: TPiece;
  20.     Color: TColor;
  21.     LastValidSquare: TLocation;
  22.     SquareIsValid: Boolean;
  23.     InJeopardy: Boolean;
  24.     ValidMoves: array [0..27] of TMove;  { 28 = max moves per piece (Queen)}
  25.     NeedPawnPromote: Boolean;
  26.     constructor Init(AParent: PWindowsObject;
  27.                      ASquare: TSquare;
  28.                      Loc: TLocation);
  29.     procedure GetSquare(var Sq: TLocation);
  30.     procedure SetSquare(Sq: TLocation);
  31.     procedure Paint(DC: HDC); virtual;
  32.     function  GetCursor: HCursor; virtual;
  33.     function  CanDrag: Boolean; virtual;
  34.     procedure DragBegin(DC: HDC; Mouse: TPoint); virtual;
  35.     procedure DragContinue(DC: HDC; Mouse: TPoint; Sq: TLocation); virtual;
  36.     function  DragEnd(DC: HDC; Mouse: TPoint;
  37.                       Sq: TLocation; var Move): Boolean; virtual;
  38.     procedure ResetValidMoves(var MoveArray: array of TMove);
  39.     procedure CheckJeopardy(var MoveArray: array of TMove);
  40.     function  ValidSquare(Sq: TLocation): Boolean;
  41.   end;
  42.  
  43.  
  44. implementation
  45.  
  46. constructor TChessPiece.Init(AParent: PWindowsObject;
  47.                              ASquare: TSquare;
  48.                              Loc: TLocation);
  49. begin
  50.   Piece := ASquare.Piece;
  51.   Color := ASquare.Color;
  52.   inherited Init(AParent,
  53.     PChar(bmChessPiecesBaseID + Ord(Piece) + Ord(High(Piece))*Ord(Color)),
  54.     PChar(bmChessPiecesBaseID + Ord(Piece) + Ord(High(Piece))*2), Loc);
  55.   FillChar(ValidMoves, SizeOf(ValidMoves), 0);
  56.   Word(LastValidSquare) := 0;
  57.   SquareIsValid := True;
  58.   InJeopardy := False;
  59.   NeedPawnPromote := False;
  60. end;
  61.  
  62. procedure TChessPiece.GetSquare(var Sq: TLocation);
  63. begin
  64.   Sq := Square;
  65. end;
  66.  
  67. procedure TChessPiece.SetSquare(Sq: TLocation);
  68. begin
  69.   Square := Sq;
  70. end;
  71.  
  72. function TChessPiece.GetCursor: HCursor;
  73. begin
  74.   if Dragging then
  75.     if SquareIsValid then
  76.       GetCursor := LoadCursor(HInstance, PChar(curInvisible))
  77.     else
  78.       GetCursor := LoadCursor(HInstance, PChar(curNo))
  79.   else
  80.     GetCursor := LoadCursor(HInstance, PChar(curGrabHandOpen));
  81. end;
  82.  
  83. procedure TChessPiece.Paint(DC: HDC);
  84. var
  85.   OldBrush: HBrush;
  86.   OldPen: HPen;
  87.   OldRop: Integer;
  88.   R: TRect;
  89. begin
  90.   inherited Paint(DC);
  91.   if InJeopardy and not DragHidden then
  92.   begin
  93.     R := Rect;
  94.     OldBrush := SelectObject(DC, GetStockObject(Null_Brush));
  95.     OldPen := SelectObject(DC, GetStockObject(White_Pen));
  96.     OldRop := SetRop2(DC, R2_XORPEN);
  97.     InflateRect(R, -1, -1);
  98.     Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
  99.     InflateRect(R, -2, -2);
  100.     Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
  101.     SelectObject(DC, OldPen);
  102.     SelectObject(DC, OldBrush);
  103.     SetRop2(DC, OldRop);
  104.   end;      
  105. end;
  106.  
  107. function  TChessPiece.CanDrag: Boolean;
  108. begin
  109.   CanDrag := ValidMoves[0].Change.Piece <> pEmpty;
  110. end;
  111.  
  112. procedure TChessPiece.DragBegin(DC: HDC; Mouse: TPoint);
  113. begin
  114.   SquareIsValid := True;
  115.   inherited DragBegin(DC, Mouse);
  116.   Word(LastValidSquare) := 0;   
  117. end;
  118.  
  119. procedure TChessPiece.DragContinue(DC: HDC; Mouse: TPoint; Sq: TLocation);
  120. begin
  121.   SquareIsValid :=(Word(Sq) = Word(Square)) or
  122.                   (Word(Sq) = Word(LastValidSquare)) or
  123.                    ValidSquare(TLocation(Sq));
  124.   inherited DragContinue(DC, Mouse, Sq);
  125. end;
  126.  
  127. function  TChessPiece.DragEnd(   DC: HDC;
  128.                               Mouse: TPoint;
  129.                                  Sq: TLocation;
  130.                            var Move        ): Boolean;
  131. begin
  132.   DragEnd := inherited DragEnd(DC, Mouse, Sq, Move)
  133.              and ValidSquare(Sq);
  134.   with TChange(Move) do
  135.   begin
  136.     Piece := Self.Piece;
  137.     Source:= Square;
  138.     Dest  := Sq;
  139.   end;
  140. end;
  141.  
  142. { ResetValidMoves takes the valid move list of the current player
  143.   and copies moves for this piece into a local array.  The valid moves
  144.   are used in setting the cursor to indicate whether a piece is
  145.   draggable or whether the dragging piece can move to the current square. }
  146. procedure TChessPiece.ResetValidMoves(var MoveArray: array of TMove);
  147. var
  148.   X: Integer;
  149.   Y: Integer;
  150. begin
  151.   X := 0;
  152.   Y := 0;
  153.   ValidMoves[X].Change.Piece := pEmpty;
  154.   while (X <= High(ValidMoves)) and
  155.         (Y <= High(MoveArray))  and
  156.         (MoveArray[Y].Change.Piece <> pEmpty) do
  157.   begin
  158.     if Word(MoveArray[Y].Change.Source) = Word(Square) then
  159.     begin
  160.       Move(MoveArray[Y], ValidMoves[X], SizeOf(TMove));
  161.       Inc(X);
  162.       ValidMoves[X].Change.Piece := pEmpty;
  163.     end;
  164.     Inc(Y);
  165.   end;
  166. end;
  167.  
  168. { CheckJeopardy takes the valid move list of the opponent and looks
  169.   for any move that will capture this piece. }
  170. procedure TChessPiece.CheckJeopardy(var MoveArray: array of TMove);
  171. var
  172.   X: Integer;
  173.   OldState: Boolean;
  174. begin
  175.   OldState := InJeopardy;
  176.   InJeopardy := False;
  177.   X := 0;
  178.   while (not InJeopardy) and
  179.         (X <= High(MoveArray)) and
  180.         (MoveArray[X].Change.Piece <> pEmpty) do
  181.   begin
  182.     InJeopardy := (Word(MoveArray[X].Change.Dest) = Word(Square));
  183.     Inc(X);
  184.   end;
  185.   if OldState xor InJeopardy then  { If state has changed, redraw }
  186.     RequestRedraw;
  187. end;
  188.  
  189. function  TChessPiece.ValidSquare(Sq: TLocation): Boolean;
  190. var
  191.   X: Integer;
  192. begin
  193.   ValidSquare := False;
  194.   X := 0;
  195.   while (X <= High(ValidMoves)) and
  196.         (ValidMoves[X].Change.Piece <> pEmpty) and
  197.         (Word(ValidMoves[X].Change.Dest) <> Word(Sq)) do
  198.     Inc(X);
  199.   if (X <= High(ValidMoves)) and
  200.      (ValidMoves[X].Change.Piece <> pEmpty) and
  201.      (Word(ValidMoves[X].Change.Dest) = Word(Sq)) then
  202.   begin
  203.     ValidSquare := True;
  204.     LastValidSquare := Sq;
  205.     NeedPawnPromote := (Piece = pPawn) and
  206.                        (ValidMoves[X].Change.Piece <> Piece);
  207.   end
  208. end;
  209.  
  210. end.