(******************************************************************************
* *
* Project: Memory, Klassen für das Spiel Memory *
* File : Memory, Klassen TMemoryField, TCard *
* *
* Copyright (c) Michael Puff [url]http://www.michael-puff.de[/url] *
* *
******************************************************************************)
unit Memory;
interface
uses
SysUtils,
Controls,
ExtCtrls,
Graphics,
Classes;
type
TCardStatus = (csBlind, csRevealed);
type
TCard =
class;
TOnFlip =
procedure(Card: TCard)
of object;
TCard =
class(TPanel)
private
FValue: Integer;
FStatus: TCardStatus;
FOnFlip: TOnFlip;
function GetValue: Integer;
procedure SetValue(Value: Integer);
function GetStatus: TCardStatus;
procedure SetStatus(Value: TCardStatus);
procedure Click(Sender: TObject);
reintroduce;
property OnFlip: TOnFlip
read FOnFlip
write FOnFlip;
public
constructor Create(Owner: TComponent);
override;
property Value: Integer
read GetValue
write SetValue;
property Status: TCardStatus
read GetStatus
write SetStatus;
end;
TOnEndTurn =
procedure(FirstCard, SecondCard: TCard)
of object;
TOnGameOver =
procedure of object;
TMemoryField =
class(TObject)
private
FCards: TList;
FCountCards: Integer;
FParent: TWinControl;
FFirstCard: TCard;
FSecondCard: TCard;
FCountFlips: Integer;
FOnEndTurn: TOnEndTurn;
FOnGameOver: TOnGameOver;
procedure Add(Card: TCard);
procedure IniTMemoryField;
procedure OnFlip(Card: TCard);
public
constructor Create(CountCards: Integer; Parent: TWinControl);
destructor Destroy;
override;
property OnEndTurn: TOnEndTurn
read FOnEndTurn
write FOnEndTurn;
property OnGameOver: TOnGameOver
read FOnGameOver
write FOnGameOver;
procedure HideCard(Card: TCard);
end;
implementation
constructor TCard.Create(Owner: TComponent);
begin
inherited Create(Owner);
Self.OnClick := Click;
end;
function TCard.GetValue: Integer;
begin
Result := FValue;
end;
procedure TCard.SetValue(Value: Integer);
begin
FValue := Value;
end;
function TCard.GetStatus: TCardStatus;
begin
Result := FStatus;
end;
procedure TCard.SetStatus(Value: TCardStatus);
begin
FStatus := Value;
if FStatus = csBlind
then
begin
Self.Font.Color := clBlack;
Self.Enabled := True;
end
else
begin
Self.Font.Color := clBlue;
Self.Enabled := False;
end;
end;
procedure TCard.Click(Sender: TObject);
begin
Status := csRevealed;
if Assigned(OnFlip)
then
OnFlip(Self);
end;
constructor TMemoryField.Create(CountCards: Integer; Parent: TWinControl);
begin
inherited Create;
FCards := TList.Create;
FCountCards := CountCards;
FParent := Parent;
FCountFlips := 0;
IniTMemoryField;
end;
destructor TMemoryField.Destroy;
var
i : Integer;
begin
if FCards.Count > 0
then
begin
for i := FCards.Count - 1
downto 0
do
begin
TObject(FCards.Items[i]).Free;
end;
end;
FCards.Free;
inherited;
end;
procedure TMemoryField.IniTMemoryField;
var
i : Integer;
Card : TCard;
begin
for i := 0
to FCountCards - 1
do
begin
Card := TCard.Create(
nil);
Card.Parent := FParent;
Card.Font.Style := [fsBold];
Card.Font.Size := 14;
Card.OnFlip := OnFlip;
Card.Width := 50;
Card.Left := (Card.Width * i) + 50;
if not Odd(i)
then
Card.Caption := IntToStr(i)
else
Card.Caption := IntToStr(i - 1);
Card.Value := StrToInt(Card.Caption);
Add(Card);
end;
end;
procedure TMemoryField.Add(Card: TCard);
begin
FCards.Add(Card);
end;
procedure TMemoryField.OnFlip(Card: TCard);
begin
Inc(FCountFlips);
if FCountFlips = 1
then
FFirstCard := Card
else
FSecondCard := Card;
if FCountFlips = 2
then
begin
if Assigned(OnEndTurn)
then
OnEndTurn(FFirstCard, FSecondCard);
FCountFlips := 0;
end;
end;
procedure TMemoryField.HideCard(Card: TCard);
begin
Card.Visible := False;
Dec(FCountCards);
if FCountCards = 0
then
begin
if Assigned(OnGameOver)
then
OnGameOver;
end;
end;
end.