home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / ysfl12.zip / FILES1.ZIP / ttt.pas < prev    next >
Pascal/Delphi Source File  |  1995-04-04  |  10KB  |  308 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.   TTTTControl = 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 {TTTTControl};
  84.  
  85.   procedure Register;
  86.  
  87. implementation
  88.  
  89.   constructor TTTTControl.Create(AOwner: TComponent);
  90.   var ButtonIndex: TPlace;
  91.   begin
  92.     inherited Create(AOwner);
  93.     Game := 0;
  94.     UserStarts := False;
  95.     FGameEnded := True;
  96.     FUserChar := 'X';
  97.     FCompChar := '0';
  98.     FVersion := 2; { my version number }
  99.  
  100.     TheStartButton := TButton.Create(Self);
  101.     TheStartButton.Parent := Self;
  102.     TheStartButton.Visible := True;
  103.   { TheStartButton.Caption := 'Humor me...'; }
  104.     TheStartButton.OnClick := StartButtonClick;
  105.  
  106.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  107.     begin
  108.       Button[ButtonIndex] := TButton.Create(Self);
  109.       Button[ButtonIndex].Parent := Self;
  110.       Button[ButtonIndex].Caption := '';
  111.       Button[ButtonIndex].Visible := False;
  112.       Button[ButtonIndex].OnClick := ButtonClick;
  113.     end;
  114.     SetBounds(Left,Top,132,132)
  115.   end {Create};
  116.  
  117.   destructor TTTTControl.Destroy;
  118.   var ButtonIndex: TPlace;
  119.   begin
  120.     if (Game > 0) then EndGame(Game);
  121.     TheStartButton.Destroy;
  122.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  123.       Button[ButtonIndex].Destroy;
  124.     inherited Destroy
  125.   end {Destroy};
  126.  
  127.  
  128.   procedure TTTTControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  129.   Const Grid = 3;
  130.         GridX = 2;
  131.         GridY = 2;
  132.   var X,DX,W,Y,DY,H: Word;
  133.   begin
  134.     Inherited SetBounds(ALeft,ATop,AWidth,AHeight);
  135.     TheStartButton.SetBounds(0,0,Width,Height);
  136.     X := GridX;
  137.     DX := (Width div (Grid * (GridX+GridX))) * (GridX+GridX);
  138.     W := DX - GridX;
  139.     Y := GridY;
  140.     DY := (Height div (Grid * (GridY+GridY))) * (GridY+GridY);
  141.     H := DY - GridY;
  142.     Button[8].SetBounds(X, Y, W,H);
  143.     Button[1].SetBounds(X, Y+DY, W,H);
  144.     Button[6].SetBounds(X, Y+DY+DY, W,H);
  145.     Inc(X,DX);
  146.     Button[3].SetBounds(X, Y, W,H);
  147.     Button[5].SetBounds(X, Y+DY, W,H);
  148.     Button[7].SetBounds(X, Y+DY+DY, W,H);
  149.     Inc(X,DX);
  150.     Button[4].SetBounds(X, Y, W,H);
  151.     Button[9].SetBounds(X, Y+DY, W,H);
  152.     Button[2].SetBounds(X, Y+DY+DY, W,H)
  153.   end {SetBounds};
  154.  
  155.  
  156.   procedure TTTTControl.StartButtonClick(Sender: TObject);
  157.   var ButtonIndex: TPlace;
  158.   begin
  159.     if MagicLoaded then
  160.     begin
  161.       Game := NewGame;
  162.       FGameEnded := False;
  163.       TheStartButton.Visible := False;
  164.       for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  165.         Button[ButtonIndex].Visible := True;
  166.       if UserStarts then
  167.       begin
  168.         MessageDlg('You may start...', mtInformation, [mbOk], 0);
  169.         Button[5].SetFocus; { hint... }
  170.       end
  171.       else
  172.         ComputerMove
  173.     end
  174.     else
  175.     {$IFDEF EXCEPTIONS}
  176.       raise EDLLNotLoaded.Create('MAGIC.DLL could not be loaded!')
  177.     {$ELSE}
  178.       MessageDlg('Error loading MAGIC.DLL...', mtInformation, [mbOk], 0)
  179.     {$ENDIF}
  180.   end {ButtonClick};
  181.  
  182.  
  183.   procedure TTTTControl.ButtonClick(Sender: TObject);
  184.   var ButtonIndex: TPlace;
  185.   begin
  186.     for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  187.       if Button[ButtonIndex] = Sender as TButton then
  188.         UserMove(ButtonIndex)
  189.   end {ButtonClick};
  190.  
  191.  
  192.   procedure TTTTControl.ComputerMove;
  193.   var Move: TMove;
  194.   begin
  195.     if IsWinner(Game) = NoneID then
  196.     begin
  197.       Move := NextMove(Game,CompID);
  198.       if Move = 0 then
  199.       begin
  200.         FGameEnded := True;
  201.         MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  202.       end
  203.       else
  204.       begin
  205.         MakeMove(Game,CompID,Move);
  206.         Button[Move].Caption := CompChar;
  207.         if IsWinner(Game) = CompID then
  208.           MessageDlg('I have won!', mtInformation, [mbOk], 0)
  209.         else
  210.         begin
  211.           Move := NextMove(Game,UserID);
  212.           if Move = 0 then
  213.           begin
  214.             FGameEnded := True;
  215.             MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  216.           end
  217.           else Button[Move].SetFocus { hint... }
  218.         end
  219.       end
  220.     end
  221.   end {ComputerMove};
  222.  
  223.   procedure TTTTControl.UserMove(Move: TPlace);
  224.   begin
  225.     if IsWinner(Game) <> NoneID then
  226.     begin
  227.       if IsWinner(Game) = UserID then
  228.         MessageDlg('You have already won!', mtInformation, [mbOk], 0)
  229.       else
  230.         MessageDlg('I have already won!', mtInformation, [mbOk], 0)
  231.     end
  232.     else
  233.     begin
  234.       if FGameEnded then
  235.         MessageDlg('The game has already ended!', mtInformation, [mbOk], 0)
  236.       else
  237.       begin
  238.         if GetValue(Game, Move) <> NoneID then
  239.           MessageDlg('This place is occupied!', mtWarning, [mbOk], 0)
  240.         else
  241.         begin
  242.           Button[Move].Caption := UserChar;
  243.           MakeMove(Game,UserID,Move);
  244.           if IsWinner(Game) = UserID then
  245.             MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
  246.           else
  247.             ComputerMove
  248.         end
  249.       end
  250.     end
  251.   end {UserMove};
  252.  
  253.  
  254.   procedure TTTTControl.SetUserChar(Value: Char);
  255.   begin
  256.     if Value = FCompChar then
  257.     {$IFDEF EXCEPTIONS}
  258.       raise EBadChar.Create(Value+' already in use by CompChar!')
  259.     {$ELSE}
  260.       MessageDlg('Character '+Value+' already in use by CompChar!', mtError, [mbOk], 0)
  261.     {$ENDIF}
  262.     else FUserChar := Value
  263.   end {SetUserChar};
  264.  
  265.   procedure TTTTControl.SetCompChar(Value: Char);
  266.   begin
  267.     if Value = FUserChar then
  268.     {$IFDEF EXCEPTIONS}
  269.       raise EBadChar.Create(Value+' already in use by UserChar!')
  270.     {$ELSE}
  271.       MessageDlg('Character '+Value+' already in use by UserChar!', mtError, [mbOk], 0)
  272.     {$ENDIF}
  273.     else FCompChar := Value
  274.   end {SetCompChar};
  275.  
  276.   procedure TTTTControl.SetUserStarts(Value: Boolean);
  277.   begin
  278.     FUserStarts := Value;
  279.   {$IFDEF DEBUG}
  280.     if FUserStarts then
  281.       MessageDlg('User Starts!', mtInformation, [mbOk], 0)
  282.     else
  283.       MessageDlg('I''ll Start!', mtInformation, [mbOk], 0)
  284.   {$ENDIF DEBUG}
  285.   end {SetUserStarts};
  286.  
  287.   procedure TTTTControl.SetStartButton(Value: Boolean);
  288.   begin
  289.     FStartButton := Value
  290.   end {SetStartButton};
  291.  
  292.   function TTTTControl.GetCaption: String;
  293.   begin
  294.     GetCaption := TheStartButton.Caption
  295.   end {GetCaption};
  296.  
  297.   procedure TTTTControl.SetCaption(Value: String);
  298.   begin
  299.     TheStartButton.Caption := Value
  300.   end {SetCaption};
  301.  
  302.  
  303.   procedure Register;
  304.   begin
  305.     RegisterComponents('Dr.Bob', [TTTTControl])
  306.   end {Register};
  307. end.
  308.