home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / objects / ttt / ttt.pas < prev   
Pascal/Delphi Source File  |  1995-03-20  |  7KB  |  250 lines
  1. unit TTT;
  2. {$DEFINE EXCEPTIONS}
  3.  
  4. { Program copyright (c) 1995 by Charles Calvert }
  5. { Project Name: TTT }
  6.  
  7.  
  8. interface
  9.  
  10. uses SysUtils, Classes, Controls, StdCtrls, Dialogs, Magic;
  11.  
  12. {$IFDEF EXCEPTIONS}
  13. Type
  14.   EBadChar = class(Exception);
  15. {$ENDIF EXCEPTIONS}
  16.  
  17. Type
  18.   TTTTControl = class(TWinControl)
  19.                 private
  20.                   FUserStarts: Boolean;
  21.                   FUserChar: Char;
  22.                   FCompChar: Char;
  23.                   Game: HGame;
  24.                   GameEnded: Boolean;
  25.  
  26.                   Button: Array[TPlace] of TButton;
  27.                   procedure ButtonClick(Sender: TObject);
  28.  
  29.                   procedure SetUserChar(Value: Char);
  30.                   procedure SetCompChar(Value: Char);
  31.  
  32.                   procedure SetUserStarts(Value: Boolean);
  33.  
  34.                   procedure ComputerMove;
  35.                   procedure UserMove(Move: TPlace);
  36.  
  37.                   procedure ResizeBoard;
  38.  
  39.                 protected
  40.                   constructor Create(AOwner: TComponent); override;
  41.                   destructor Destroy; override;
  42.                   procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  43.  
  44.                 protected
  45.                   StartButton: TButton;
  46.                   procedure StartButtonClick(Sender: TObject);
  47.  
  48.                 published
  49.                   property UserChar: Char read FUserChar write SetUserChar default 'X';
  50.                   property CompChar: Char read FCompChar write SetCompChar default '0';
  51.                   property UserStarts: Boolean read FUserStarts write SetUserStarts default False;
  52.                 end {TTTTControl};
  53.  
  54.   procedure Register;
  55.  
  56. implementation
  57.  
  58.   constructor TTTTControl.Create(AOwner: TComponent);
  59.   var ButtonIndex: TPlace;
  60.   begin
  61.     inherited Create(AOwner);
  62.     Game := 0;
  63.     GameEnded := True;
  64.     FUserChar := 'X';
  65.     FCompChar := '0';
  66.     UserStarts := False;
  67.  
  68.     StartButton := TButton.Create(Self);
  69.     StartButton.Parent := Self;
  70.     StartButton.Visible := True;
  71.     StartButton.Caption := 'Humor me...';
  72.     StartButton.OnClick := StartButtonClick;
  73.  
  74.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  75.     begin
  76.       Button[ButtonIndex] := TButton.Create(Self);
  77.       Button[ButtonIndex].Parent := Self;
  78.       Button[ButtonIndex].Caption := '';
  79.       Button[ButtonIndex].Visible := False;
  80.       Button[ButtonIndex].OnClick := ButtonClick;
  81.     end;
  82.     SetBounds(Left,Top,132,132)
  83.   end {Create};
  84.  
  85.   destructor TTTTControl.Destroy;
  86.   var ButtonIndex: TPlace;
  87.   begin
  88.     if (Game > 0) then EndGame(Game);
  89.     StartButton.Destroy;
  90.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  91.       Button[ButtonIndex].Destroy;
  92.     inherited Destroy
  93.   end {Destroy};
  94.  
  95.  
  96.   procedure TTTTControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  97.   begin
  98.     Inherited SetBounds(ALeft,ATop,AWidth,AHeight);
  99.     ResizeBoard
  100.   end {SetBounds};
  101.  
  102.  
  103.   procedure TTTTControl.ResizeBoard;
  104.   Const Grid = 3;
  105.         GridX = 2;
  106.         GridY = 2;
  107.   var X,DX,W,Y,DY,H: Word;
  108.   begin
  109.     StartButton.SetBounds(0,0,Width,Height);
  110.  
  111.     X := GridX;
  112.     DX := (Width div (Grid * (GridX+GridX))) * (GridX+GridX);
  113.     W := DX - GridX;
  114.     Y := GridY;
  115.     DY := (Height div (Grid * (GridY+GridY))) * (GridY+GridY);
  116.     H := DY - GridY;
  117.  
  118.     Button[8].SetBounds(X, Y, W,H);
  119.     Button[1].SetBounds(X, Y+DY, W,H);
  120.     Button[6].SetBounds(X, Y+DY+DY, W,H);
  121.     Inc(X,DX);
  122.     Button[3].SetBounds(X, Y, W,H);
  123.     Button[5].SetBounds(X, Y+DY, W,H);
  124.     Button[7].SetBounds(X, Y+DY+DY, W,H);
  125.     Inc(X,DX);
  126.     Button[4].SetBounds(X, Y, W,H);
  127.     Button[9].SetBounds(X, Y+DY, W,H);
  128.     Button[2].SetBounds(X, Y+DY+DY, W,H)
  129.   end {Resize};
  130.  
  131.  
  132.   procedure TTTTControl.StartButtonClick(Sender: TObject);
  133.   var ButtonIndex: TPlace;
  134.   begin
  135.     Game := NewGame; { Error: Cannot open component library }
  136.     GameEnded := False;
  137.     StartButton.Visible := False;
  138.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  139.       Button[ButtonIndex].Visible := True;
  140.     if UserStarts then
  141.       MessageDlg('You may start...', mtInformation, [mbOk], 0)
  142.     else
  143.     begin
  144.       MessageDlg('I will start...', mtInformation, [mbOk], 0);
  145.       ComputerMove
  146.     end
  147.   end {ButtonClick};
  148.  
  149.  
  150.   procedure TTTTControl.ButtonClick(Sender: TObject);
  151.   var ButtonIndex: TPlace;
  152.   begin
  153.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  154.       if Button[ButtonIndex] = Sender as TButton then
  155.         UserMove(ButtonIndex)
  156.   end {ButtonClick};
  157.  
  158.  
  159.   procedure TTTTControl.ComputerMove;
  160.   var Move: TMove;
  161.   begin
  162.     if IsWinner(Game) = NoneID then
  163.     begin
  164.       Move := NextMove(Game,CompID);
  165.       if Move = 0 then
  166.       begin
  167.         GameEnded := True;
  168.         MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  169.       end
  170.       else
  171.       begin
  172.         MakeMove(Game,CompID,Move);
  173.         Button[Move].Caption := CompChar;
  174.         if IsWinner(Game) = CompID then
  175.           MessageDlg('I have won!', mtInformation, [mbOk], 0)
  176.       end
  177.     end
  178.   end {ComputerMove};
  179.  
  180.   procedure TTTTControl.UserMove(Move: TPlace);
  181.   begin
  182.     if IsWinner(Game) <> NoneID then
  183.     begin
  184.       if IsWinner(Game) = UserID then
  185.         MessageDlg('You have already won!', mtInformation, [mbOk], 0)
  186.       else
  187.         MessageDlg('I have already won!', mtInformation, [mbOk], 0)
  188.     end
  189.     else
  190.     begin
  191.       if GameEnded then
  192.         MessageDlg('The game already has ended!', mtInformation, [mbOk], 0)
  193.       else
  194.       begin
  195.         if GetValue(Game, Move) <> NoneID then
  196.           MessageDlg('This place is occupied!', mtWarning, [mbOk], 0)
  197.         else
  198.         begin
  199.           Button[Move].Caption := UserChar;
  200.           MakeMove(Game,UserID,Move);
  201.           if IsWinner(Game) = UserID then
  202.             MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
  203.           else
  204.             ComputerMove
  205.         end
  206.       end
  207.     end
  208.   end {UserMove};
  209.  
  210.  
  211.   procedure TTTTControl.SetUserChar(Value: Char);
  212.   begin
  213.     if Value = FCompChar then
  214.     {$IFDEF EXCEPTIONS}
  215.       raise EBadChar.Create(Value+' already in use by CompChar!')
  216.     {$ELSE}
  217.       MessageDlg('Character '+Value+' already in use by CompChar!', mtError, [mbOk], 0)
  218.     {$ENDIF}
  219.     else FUserChar := Value
  220.   end {SetUserChar};
  221.  
  222.   procedure TTTTControl.SetCompChar(Value: Char);
  223.   begin
  224.     if Value = FUserChar then
  225.     {$IFDEF EXCEPTIONS}
  226.       raise EBadChar.Create(Value+' already in use by UserChar!')
  227.     {$ELSE}
  228.       MessageDlg('Character '+Value+' already in use by UserChar!', mtError, [mbOk], 0)
  229.     {$ENDIF}
  230.     else FCompChar := Value
  231.   end {SetCompChar};
  232.  
  233.   procedure TTTTControl.SetUserStarts(Value: Boolean);
  234.   begin
  235.     FUserStarts := Value;
  236.   {$IFDEF DEBUG}
  237.     if FUserStarts then
  238.       MessageDlg('User Starts!', mtInformation, [mbOk], 0)
  239.     else
  240.       MessageDlg('I''ll Start!', mtInformation, [mbOk], 0)
  241.   {$ENDIF DEBUG}
  242.   end {SetUserStarts};
  243.  
  244.  
  245.   procedure Register;
  246.   begin
  247.     RegisterComponents('Games', [TTTTControl])
  248.   end {Register};
  249. end.
  250.