Delphi Programming Unleashed/Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso/misc/objects/ttt/ttt.pas

Pascal/Delphi Source File | 1995-03-21 | 7.0 KB | 250 lines

unit TTT;
{$DEFINE EXCEPTIONS}

{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: TTT }


interface

uses SysUtils, Classes, Controls, StdCtrls, Dialogs, Magic;

{$IFDEF EXCEPTIONS}
Type
  EBadChar = class(Exception);
{$ENDIF EXCEPTIONS}

Type
  TTTTControl = class(TWinControl)
                private
                  FUserStarts: Boolean;
                  FUserChar: Char;
                  FCompChar: Char;
                  Game: HGame;
                  GameEnded: Boolean;

                  Button: Array[TPlace] of TButton;
                  procedure ButtonClick(Sender: TObject);

                  procedure SetUserChar(Value: Char);
                  procedure SetCompChar(Value: Char);

                  procedure SetUserStarts(Value: Boolean);

                  procedure ComputerMove;
                  procedure UserMove(Move: TPlace);

                  procedure ResizeBoard;

                protected
                  constructor Create(AOwner: TComponent); override;
                  destructor Destroy; override;
                  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

                protected
                  StartButton: TButton;
                  procedure StartButtonClick(Sender: TObject);

                published
                  property UserChar: Char read FUserChar write SetUserChar default 'X';
                  property CompChar: Char read FCompChar write SetCompChar default '0';
                  property UserStarts: Boolean read FUserStarts write SetUserStarts default False;
                end {TTTTControl};

  procedure Register;

implementation

  constructor TTTTControl.Create(AOwner: TComponent);
  var ButtonIndex: TPlace;
  begin
    inherited Create(AOwner);
    Game := 0;
    GameEnded := True;
    FUserChar := 'X';
    FCompChar := '0';
    UserStarts := False;

    StartButton := TButton.Create(Self);
    StartButton.Parent := Self;
    StartButton.Visible := True;
    StartButton.Caption := 'Humor me...';
    StartButton.OnClick := StartButtonClick;

    for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
    begin
      Button[ButtonIndex] := TButton.Create(Self);
      Button[ButtonIndex].Parent := Self;
      Button[ButtonIndex].Caption := '';
      Button[ButtonIndex].Visible := False;
      Button[ButtonIndex].OnClick := ButtonClick;
    end;
    SetBounds(Left,Top,132,132)
  end {Create};

  destructor TTTTControl.Destroy;
  var ButtonIndex: TPlace;
  begin
    if (Game > 0) then EndGame(Game);
    StartButton.Destroy;
    for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
      Button[ButtonIndex].Destroy;
    inherited Destroy
  end {Destroy};


  procedure TTTTControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  begin
    Inherited SetBounds(ALeft,ATop,AWidth,AHeight);
    ResizeBoard
  end {SetBounds};


  procedure TTTTControl.ResizeBoard;
  Const Grid = 3;
        GridX = 2;
        GridY = 2;
  var X,DX,W,Y,DY,H: Word;
  begin
    StartButton.SetBounds(0,0,Width,Height);

    X := GridX;
    DX := (Width div (Grid * (GridX+GridX))) * (GridX+GridX);
    W := DX - GridX;
    Y := GridY;
    DY := (Height div (Grid * (GridY+GridY))) * (GridY+GridY);
    H := DY - GridY;

    Button[8].SetBounds(X, Y, W,H);
    Button[1].SetBounds(X, Y+DY, W,H);
    Button[6].SetBounds(X, Y+DY+DY, W,H);
    Inc(X,DX);
    Button[3].SetBounds(X, Y, W,H);
    Button[5].SetBounds(X, Y+DY, W,H);
    Button[7].SetBounds(X, Y+DY+DY, W,H);
    Inc(X,DX);
    Button[4].SetBounds(X, Y, W,H);
    Button[9].SetBounds(X, Y+DY, W,H);
    Button[2].SetBounds(X, Y+DY+DY, W,H)
  end {Resize};


  procedure TTTTControl.StartButtonClick(Sender: TObject);
  var ButtonIndex: TPlace;
  begin
    Game := NewGame; { Error: Cannot open component library }
    GameEnded := False;
    StartButton.Visible := False;
    for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
      Button[ButtonIndex].Visible := True;
    if UserStarts then
      MessageDlg('You may start...', mtInformation, [mbOk], 0)
    else
    begin
      MessageDlg('I will start...', mtInformation, [mbOk], 0);
      ComputerMove
    end
  end {ButtonClick};


  procedure TTTTControl.ButtonClick(Sender: TObject);
  var ButtonIndex: TPlace;
  begin
    for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
      if Button[ButtonIndex] = Sender as TButton then
        UserMove(ButtonIndex)
  end {ButtonClick};


  procedure TTTTControl.ComputerMove;
  var Move: TMove;
  begin
    if IsWinner(Game) = NoneID then
    begin
      Move := NextMove(Game,CompID);
      if Move = 0 then
      begin
        GameEnded := True;
        MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
      end
      else
      begin
        MakeMove(Game,CompID,Move);
        Button[Move].Caption := CompChar;
        if IsWinner(Game) = CompID then
          MessageDlg('I have won!', mtInformation, [mbOk], 0)
      end
    end
  end {ComputerMove};

  procedure TTTTControl.UserMove(Move: TPlace);
  begin
    if IsWinner(Game) <> NoneID then
    begin
      if IsWinner(Game) = UserID then
        MessageDlg('You have already won!', mtInformation, [mbOk], 0)
      else
        MessageDlg('I have already won!', mtInformation, [mbOk], 0)
    end
    else
    begin
      if GameEnded then
        MessageDlg('The game already has ended!', mtInformation, [mbOk], 0)
      else
      begin
        if GetValue(Game, Move) <> NoneID then
          MessageDlg('This place is occupied!', mtWarning, [mbOk], 0)
        else
        begin
          Button[Move].Caption := UserChar;
          MakeMove(Game,UserID,Move);
          if IsWinner(Game) = UserID then
            MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
          else
            ComputerMove
        end
      end
    end
  end {UserMove};


  procedure TTTTControl.SetUserChar(Value: Char);
  begin
    if Value = FCompChar then
    {$IFDEF EXCEPTIONS}
      raise EBadChar.Create(Value+' already in use by CompChar!')
    {$ELSE}
      MessageDlg('Character '+Value+' already in use by CompChar!', mtError, [mbOk], 0)
    {$ENDIF}
    else FUserChar := Value
  end {SetUserChar};

  procedure TTTTControl.SetCompChar(Value: Char);
  begin
    if Value = FUserChar then
    {$IFDEF EXCEPTIONS}
      raise EBadChar.Create(Value+' already in use by UserChar!')
    {$ELSE}
      MessageDlg('Character '+Value+' already in use by UserChar!', mtError, [mbOk], 0)
    {$ENDIF}
    else FCompChar := Value
  end {SetCompChar};

  procedure TTTTControl.SetUserStarts(Value: Boolean);
  begin
    FUserStarts := Value;
  {$IFDEF DEBUG}
    if FUserStarts then
      MessageDlg('User Starts!', mtInformation, [mbOk], 0)
    else
      MessageDlg('I''ll Start!', mtInformation, [mbOk], 0)
  {$ENDIF DEBUG}
  end {SetUserStarts};


  procedure Register;
  begin
    RegisterComponents('Games', [TTTTControl])
  end {Register};
end.