home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / DRBOBC.ZIP / TTT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-20  |  9.3 KB  |  300 lines
  1. unit TTT;
  2. {
  3.     File: TTT.PAS
  4.   Author: Bob Swart [100434,2072]
  5.  Purpose: Tic-tac-toe game component
  6.  
  7.    Usage: Install on component palette.  Make sure MAGIC.DLL is available
  8.           in the WINDOWS\SYSTEM directory or the directory with the final
  9.           application itself.  Otherwise, the component will not work and
  10.           raise an exception.
  11.  
  12.   Design: Published in The Delphi Magazine issue #2
  13.           Send your name & (postal)address to Chris Frizelle at 70630,717
  14.           for a free sample issue.
  15. }
  16. {$DEFINE EXCEPTIONS}
  17. interface
  18. uses SysUtils, Classes, Controls, StdCtrls, Dialogs, Magic;
  19.  
  20. {$IFDEF EXCEPTIONS}
  21. Type
  22.   EBadChar = class(Exception);
  23.   EDLLNotLoaded = class(Exception);
  24. {$ENDIF EXCEPTIONS}
  25.  
  26. Type
  27.   TTicTacToe = class(TWinControl)
  28.                   constructor Create(AOwner: TComponent); override;
  29.                   destructor Destroy; override;
  30.                   procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  31.  
  32.                 private { Magic DLL handle }
  33.                   Game: HGame;
  34.  
  35.                 private { 9 game buttons }
  36.                   Button: Array[TPlace] of TButton;
  37.                   procedure ButtonClick(Sender: TObject);
  38.                   procedure ComputerMove;
  39.                   procedure UserMove(Move: TPlace);
  40.  
  41.                 private { start button }
  42.                   TheStartButton: TButton;
  43.                   procedure StartButtonClick(Sender: TObject);
  44.  
  45.                 private { game properties }
  46.                   FStartButton: Boolean;
  47.                   FUserStarts: Boolean;
  48.                   FGameEnded: Boolean;
  49.                   FUserChar: Char;
  50.                   FCompChar: Char;
  51.                   FVersion: Integer;
  52.                   FDummy: Integer; { to catch the FVersion changes... }
  53.  
  54.                 protected { design interface }
  55.                   procedure SetStartButton(Value: Boolean);
  56.                   procedure SetUserStarts(Value: Boolean);
  57.                   procedure SetUserChar(Value: Char);
  58.                   procedure SetCompChar(Value: Char);
  59.                   function  GetCaption: String;
  60.                   procedure SetCaption(Value: String);
  61.  
  62.                 published { user interface }
  63.                   property StartButton: Boolean
  64.                            read FStartButton write FStartButton
  65.                            default False;
  66.                   property Caption: String
  67.                            read GetCaption write SetCaption;
  68.                   property UserStarts: Boolean
  69.                            read FUserStarts write SetUserStarts
  70.                            default False;
  71.                   property GameEnded: Boolean
  72.                            read FGameEnded
  73.                            default False;
  74.                   property UserChar: Char
  75.                            read FUserChar write SetUserChar
  76.                            default 'X';
  77.                   property CompChar: Char
  78.                            read FCompChar write SetCompChar
  79.                            default '0';
  80.                   property Version: Integer
  81.                            read FVersion write FDummy
  82.                            default 2;
  83.                 end {TTicTacToe};
  84.  
  85. implementation
  86.  
  87.   constructor TTicTacToe.Create(AOwner: TComponent);
  88.   var ButtonIndex: TPlace;
  89.   begin
  90.     inherited Create(AOwner);
  91.     Game := 0;
  92.     UserStarts := False;
  93.     FGameEnded := True;
  94.     FUserChar := 'X';
  95.     FCompChar := '0';
  96.     FVersion := 2; { my version number }
  97.  
  98.     TheStartButton := TButton.Create(Self);
  99.     TheStartButton.Parent := Self;
  100.     TheStartButton.Visible := True;
  101.   { TheStartButton.Caption := 'Humor me...'; }
  102.     TheStartButton.OnClick := StartButtonClick;
  103.  
  104.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  105.     begin
  106.       Button[ButtonIndex] := TButton.Create(Self);
  107.       Button[ButtonIndex].Parent := Self;
  108.       Button[ButtonIndex].Caption := '';
  109.       Button[ButtonIndex].Visible := False;
  110.       Button[ButtonIndex].OnClick := ButtonClick;
  111.     end;
  112.     SetBounds(Left,Top,132,132)
  113.   end {Create};
  114.  
  115.   destructor TTicTacToe.Destroy;
  116.   var ButtonIndex: TPlace;
  117.   begin
  118.     if (Game > 0) then EndGame(Game);
  119.     TheStartButton.Destroy;
  120.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  121.       Button[ButtonIndex].Destroy;
  122.     inherited Destroy
  123.   end {Destroy};
  124.  
  125.  
  126.   procedure TTicTacToe.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  127.   Const Grid = 3;
  128.         GridX = 2;
  129.         GridY = 2;
  130.   var X,DX,W,Y,DY,H: Word;
  131.   begin
  132.     Inherited SetBounds(ALeft,ATop,AWidth,AHeight);
  133.     TheStartButton.SetBounds(0,0,Width,Height);
  134.     X := GridX;
  135.     DX := (Width div (Grid * (GridX+GridX))) * (GridX+GridX);
  136.     W := DX - GridX;
  137.     Y := GridY;
  138.     DY := (Height div (Grid * (GridY+GridY))) * (GridY+GridY);
  139.     H := DY - GridY;
  140.     Button[8].SetBounds(X, Y, W,H);
  141.     Button[1].SetBounds(X, Y+DY, W,H);
  142.     Button[6].SetBounds(X, Y+DY+DY, W,H);
  143.     Inc(X,DX);
  144.     Button[3].SetBounds(X, Y, W,H);
  145.     Button[5].SetBounds(X, Y+DY, W,H);
  146.     Button[7].SetBounds(X, Y+DY+DY, W,H);
  147.     Inc(X,DX);
  148.     Button[4].SetBounds(X, Y, W,H);
  149.     Button[9].SetBounds(X, Y+DY, W,H);
  150.     Button[2].SetBounds(X, Y+DY+DY, W,H)
  151.   end {SetBounds};
  152.  
  153.  
  154.   procedure TTicTacToe.StartButtonClick(Sender: TObject);
  155.   var ButtonIndex: TPlace;
  156.   begin
  157.     if MagicLoaded then
  158.     begin
  159.       Game := NewGame;
  160.       FGameEnded := False;
  161.       TheStartButton.Visible := False;
  162.       for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  163.         Button[ButtonIndex].Visible := True;
  164.       if UserStarts then
  165.       begin
  166.         MessageDlg('You may start...', mtInformation, [mbOk], 0);
  167.         Button[5].SetFocus; { hint... }
  168.       end
  169.       else
  170.         ComputerMove
  171.     end
  172.     else
  173.     {$IFDEF EXCEPTIONS}
  174.       raise EDLLNotLoaded.Create('MAGIC.DLL could not be loaded!')
  175.     {$ELSE}
  176.       MessageDlg('Error loading MAGIC.DLL...', mtInformation, [mbOk], 0)
  177.     {$ENDIF}
  178.   end {ButtonClick};
  179.  
  180.  
  181.   procedure TTicTacToe.ButtonClick(Sender: TObject);
  182.   var ButtonIndex: TPlace;
  183.   begin
  184.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  185.       if Button[ButtonIndex] = Sender as TButton then
  186.         UserMove(ButtonIndex)
  187.   end {ButtonClick};
  188.  
  189.  
  190.   procedure TTicTacToe.ComputerMove;
  191.   var Move: TMove;
  192.   begin
  193.     if IsWinner(Game) = NoneID then
  194.     begin
  195.       Move := NextMove(Game,CompID);
  196.       if Move = 0 then
  197.       begin
  198.         FGameEnded := True;
  199.         MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  200.       end
  201.       else
  202.       begin
  203.         MakeMove(Game,CompID,Move);
  204.         Button[Move].Caption := CompChar;
  205.         if IsWinner(Game) = CompID then
  206.           MessageDlg('I have won!', mtInformation, [mbOk], 0)
  207.         else
  208.         begin
  209.           Move := NextMove(Game,UserID);
  210.           if Move = 0 then
  211.           begin
  212.             FGameEnded := True;
  213.             MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  214.           end
  215.           else Button[Move].SetFocus { hint... }
  216.         end
  217.       end
  218.     end
  219.   end {ComputerMove};
  220.  
  221.   procedure TTicTacToe.UserMove(Move: TPlace);
  222.   begin
  223.     if IsWinner(Game) <> NoneID then
  224.     begin
  225.       if IsWinner(Game) = UserID then
  226.         MessageDlg('You have already won!', mtInformation, [mbOk], 0)
  227.       else
  228.         MessageDlg('I have already won!', mtInformation, [mbOk], 0)
  229.     end
  230.     else
  231.     begin
  232.       if FGameEnded then
  233.         MessageDlg('The game has already ended!', mtInformation, [mbOk], 0)
  234.       else
  235.       begin
  236.         if GetValue(Game, Move) <> NoneID then
  237.           MessageDlg('This place is occupied!', mtWarning, [mbOk], 0)
  238.         else
  239.         begin
  240.           Button[Move].Caption := UserChar;
  241.           MakeMove(Game,UserID,Move);
  242.           if IsWinner(Game) = UserID then
  243.             MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
  244.           else
  245.             ComputerMove
  246.         end
  247.       end
  248.     end
  249.   end {UserMove};
  250.  
  251.  
  252.   procedure TTicTacToe.SetUserChar(Value: Char);
  253.   begin
  254.     if Value = FCompChar then
  255.     {$IFDEF EXCEPTIONS}
  256.       raise EBadChar.Create(Value+' already in use by CompChar!')
  257.     {$ELSE}
  258.       MessageDlg('Character '+Value+' already in use by CompChar!', mtError, [mbOk], 0)
  259.     {$ENDIF}
  260.     else FUserChar := Value
  261.   end {SetUserChar};
  262.  
  263.   procedure TTicTacToe.SetCompChar(Value: Char);
  264.   begin
  265.     if Value = FUserChar then
  266.     {$IFDEF EXCEPTIONS}
  267.       raise EBadChar.Create(Value+' already in use by UserChar!')
  268.     {$ELSE}
  269.       MessageDlg('Character '+Value+' already in use by UserChar!', mtError, [mbOk], 0)
  270.     {$ENDIF}
  271.     else FCompChar := Value
  272.   end {SetCompChar};
  273.  
  274.   procedure TTicTacToe.SetUserStarts(Value: Boolean);
  275.   begin
  276.     FUserStarts := Value;
  277.   {$IFDEF DEBUG}
  278.     if FUserStarts then
  279.       MessageDlg('User Starts!', mtInformation, [mbOk], 0)
  280.     else
  281.       MessageDlg('I''ll Start!', mtInformation, [mbOk], 0)
  282.   {$ENDIF DEBUG}
  283.   end {SetUserStarts};
  284.  
  285.   procedure TTicTacToe.SetStartButton(Value: Boolean);
  286.   begin
  287.     FStartButton := Value
  288.   end {SetStartButton};
  289.  
  290.   function TTicTacToe.GetCaption: String;
  291.   begin
  292.     GetCaption := TheStartButton.Caption
  293.   end {GetCaption};
  294.  
  295.   procedure TTicTacToe.SetCaption(Value: String);
  296.   begin
  297.     TheStartButton.Caption := Value
  298.   end {SetCaption};
  299. end.
  300.