OLE клиент-сервер – Крестики-нолики
Автор: Xavier Pacheco
unit UiMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, Menus, TTTServer_TLB, ComCtrls;
type
TRecord = record
Wins, Loses, Ties: Integer;
end;
TFrmMain = class(TForm)
SbTL: TSpeedButton;
SbTM: TSpeedButton;
SbTR: TSpeedButton;
SbMM: TSpeedButton;
SbBL: TSpeedButton;
SbBR: TSpeedButton;
SbMR: TSpeedButton;
SbBM: TSpeedButton;
SbML: TSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
MainMenu1: TMainMenu;
FileItem: TMenuItem;
HelpItem: TMenuItem;
ExitItem: TMenuItem;
AboutItem: TMenuItem;
SkillItem: TMenuItem;
UnconItem: TMenuItem;
AwakeItem: TMenuItem;
NewGameItem: TMenuItem;
N1: TMenuItem;
StatusBar: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure ExitItemClick(Sender: TObject);
procedure SkillItemClick(Sender: TObject);
procedure AboutItemClick(Sender: TObject);
procedure SBClick(Sender: TObject);
procedure NewGameItemClick(Sender: TObject);
private
FXImage: TBitmap;
FOImage: TBitmap;
FCurrentSkill: Integer;
FGameID: Integer;
FGameServer: IGameServer;
FRec: TRecord;
procedure TagToCoord(ATag: Integer; var Coords: TPoint);
function CoordToCtl(const Coords: TPoint): TSpeedButton;
procedure DoGameResult(GameRez: GameResults);
end;
var
FrmMain: TFrmMain;
implementation
uses UiAbout;
{$R *.DFM}
{$R xo.res}
const
RecStr = 'Wins: %d, Loses: %d, Ties: %d';
procedure TFrmMain.FormCreate(Sender: TObject);
begin
// load "X" and "O" images from resource into TBitmaps
FXImage := TBitmap.Create;
FXImage.LoadFromResourceName(MainInstance, 'x_img');
FOImage := TBitmap.Create;
FOImage.LoadFromResourceName(MainInstance, 'o_img');
// set default skill
FCurrentSkill := slAwake;
// init record UI
with FRec do
StatusBar.SimpleText := Format(RecStr, [Wins, Loses, Ties]);
// Get server instance
FGameServer := CoGameServer.Create;
// Start a new game
FGameServer.NewGame(FGameID);
end;
procedure TFrmMain.ExitItemClick(Sender: TObject);
begin
Close;
end;
procedure TFrmMain.SkillItemClick(Sender: TObject);
begin
with Sender as TMenuItem do
begin
Checked := True;
FCurrentSkill := Tag;
end;
end;
procedure TFrmMain.AboutItemClick(Sender: TObject);
begin
// Show About box
with TFrmAbout.Create(Application) do
try
ShowModal;
finally
Free;
end;
end;
procedure TFrmMain.TagToCoord(ATag: Integer; var Coords: TPoint);
begin
case ATag of
0: Coords := Point(1, 1);
1: Coords := Point(1, 2);
2: Coords := Point(1, 3);
3: Coords := Point(2, 1);
4: Coords := Point(2, 2);
5: Coords := Point(2, 3);
6: Coords := Point(3, 1);
7: Coords := Point(3, 2);
else
Coords := Point(3, 3);
end;
end;
function TFrmMain.CoordToCtl(const Coords: TPoint): TSpeedButton;
begin
Result := nil;
with Coords do
case X of
1:
case Y of
1: Result := SbTL;
2: Result := SbTM;
3: Result := SbTR;
end;
2:
case Y of
1: Result := SbML;
2: Result := SbMM;
3: Result := SbMR;
end;
3:
case Y of
1: Result := SbBL;
2: Result := SbBM;
3: Result := SbBR;
end;
end;
end;
procedure TFrmMain.SBClick(Sender: TObject);
var
Coords: TPoint;
GameRez: GameResults;
SB: TSpeedButton;
begin
if Sender is TSpeedButton then
begin
SB := TSpeedButton(Sender);
if SB.Glyph.Empty then
begin
with SB do
begin
TagToCoord(Tag, Coords);
FGameServer.PlayerMove(FGameID, Coords.X, Coords.Y, GameRez);
Glyph.Assign(FXImage);
end;
if GameRez = grInProgress then
begin
FGameServer.ComputerMove(FGameID, FCurrentSkill, Coords.X, Coords.Y,
GameRez);
CoordToCtl(Coords).Glyph.Assign(FOImage);
end;
DoGameResult(GameRez);
end;
end;
end;
procedure TFrmMain.NewGameItemClick(Sender: TObject);
var
I: Integer;
begin
FGameServer.NewGame(FGameID);
for I := 0 to ControlCount - 1 do
if Controls[I] is TSpeedButton then
TSpeedButton(Controls[I]).Glyph := nil;
end;
procedure TFrmMain.DoGameResult(GameRez: GameResults);
const
EndMsg: array[grTie..grComputerWin] of string = (
'Tie game', 'You win', 'Computer wins');
begin
if GameRez <> grInProgress then
begin
case GameRez of
grComputerWin: Inc(FRec.Loses);
grPlayerWin: Inc(FRec.Wins);
grTie: Inc(FRec.Ties);
end;
with FRec do
StatusBar.SimpleText := Format(RecStr, [Wins, Loses, Ties]);
if MessageDlg(Format('%s! Play again?', [EndMsg[GameRez]]), mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
NewGameItemClick(nil);
end;
end;
end.
Скачать весь проект
|