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