Einzelnen Beitrag anzeigen

Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#10

Re: [oop] funktion einer oberklasse von einer unterklasse au

  Alt 10. Aug 2007, 05:02
Ich konnte nicht schlafen.

Im Anhang mein Memory. Eigentlich ist es nur eine Memory-Klasse mit einer Demo-Anwendung. Man müsste noch an zwei Punkten etwas verbesser: Die Anordnung der Felder, die sind in einer Reihe im Moment und an der Zuweisung der Werte, obwohl das ist egal, nur eben die Beschriftung der Felder sollte man noch mal etwas verschönern. Ansonsten kommt man mit 200 Codezeilen hin inklusive der Leerzeilen.

Als Spielleiter habe ich die Form genommen.

@Hansa: Ein zwei dimensionales Array ist natürlich Blödsinn. Wo die Karten liegen auf der Oberfläche kann der Klasse egal sein.

Für die Download-Faulen hier die Code:
Delphi-Quellcode:
(******************************************************************************
*                                                                            *
*  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.

Delphi-Quellcode:
procedure TForm1.OnEndTurn(FirstCard, SecondCard: TCard);
begin
  if FirstCard.Value = SecondCard.Value then
  begin
    Field.HideCard(FirstCard);
    Field.HideCard(SecondCard);
  end
  else
  begin
    FirstCard.Status := csBlind;
    SecondCard.Status := csBlind;
  end;
end;

procedure TForm1.OnGameOver;
begin
  ShowMessage('Game over');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(Field) then
    FreeAndNil(Field);
  Field := TMemoryField.Create(4, Form1);
  Field.OnEndTurn := OnEndTurn;
  Field.OnGameOver := OnGameOver;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Field.Free;
end;
@neomic : Ich hoffe, ich habe jetzt keine Hausaufgaben für dich gemacht. Wenn doch, dann solltest du möglichst verstehen, was ich gemacht habe, sonst könnte es etwas peinlich werden, wenn der Lehrer Fragen zum Code stellt.
Angehängte Dateien
Dateityp: zip memory_118.zip (198,1 KB, 26x aufgerufen)
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat