Klone eines TShapes

Mitmischer 1703 · Verfasst: Sa 14.03.09 18:20

Hi DF!

Ich arbeite gerade am einem "Schiffe versenken" und regle die Trefferanzeige (Treffer, Wasser) über Shapes. Jetzt will ich im FormCreate die Shapes folgendermaßen erstellen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

procedure TForm1.FormCreate(Sender: TObject);
var ColI, RowI : Integer;
begin
  Cols := StrToInt(InputBox('Spalten', 'Geben Sie die Anzahl der Spalten an (A-..)', '10'));
  Rows := StrToInt(InputBox('Zeilen', 'Geben Sie die Anzahl der Zeilen an (1-..)', '10'));
  for ColI := 1 to Cols do begin
   for RowI := 1 to Rows do begin
    TShape.Create(Self).Name := Pre_SP + IntToStr(RowI) + IntToStr(ColI);
    with TShape(FindComponent(Pre_SP + IntToStr(RowI) + IntToStr(ColI))) do
    begin
      Left := ColI * 24;
      Top := RowI * 20;
      Parent := ShipSP;
      Visible := true;
    end;
   end;
  end;
end;

Da die Shapes auf dem Panel ShipSP liegen, brauche ich die Parent-Zuweisung. Nun aber mein Problem: Am Anfang existiert ein Muttershape. Wie übernehme ich alle Eigenschaften des Muttershapes?

Moderiert von Narses: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am So 15.03.2009 um 12:22

_________________
Die Lösung ist nicht siebzehn.

Narses · Verfasst: So 15.03.09 12:24

Moin!

Ich gebe zu, ich habe mir das jetzt nicht soo entsetzlich genau angesehen, aber die Methode .Assign() sollte sein, was du suchst (sollten alle von TPersistent abgeleiteten Klassen haben, und die GUI-Controls sind das). :idea:

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Kha · Verfasst: So 15.03.09 12:31

TShape scheint sich (wie wahrscheinlich alle Controls) um Assign allerdings nicht wirklich zu kümmern

. Also wird es das Einfachste sein, die paar Properties von Hand zuzuweisen.

_________________
>λ=

Mitmischer 1703 · Verfasst: So 15.03.09 12:48

Hab ich mir schon gedacht...

_________________
Die Lösung ist nicht siebzehn.

jaenicke · Verfasst: So 15.03.09 12:52

Oder du nimmst einfach gar keine Shapes. Damit würdest du vermutlich auch nicht viel mehr Arbeit haben, vor allem würdest du aber ohne die ganzen visuellen Komponenten auskommen.

Mitmischer 1703 · Verfasst: Di 17.03.09 17:53

Uff... Wie könnte man das denn dann programmieren? Dann müsste ich ja theoretisch mit einem Memo arbeiten... Außerdem: Wie krieg ich dann Schiffspositionen ausgelesen? Mit Arrays?

_________________
Die Lösung ist nicht siebzehn.

jaenicke · Verfasst: Di 17.03.09 17:56

Die Positionen der Schiffe haben ja nichts mit der Darstellung der Oberfläche zu tun.

Zur Anzeige bietet sich eine TPaintBox z.B. an. Und dann zeichnest du entsprechend der Schiffspositionen und Schüsse entsprechende Rechtecke. Später kannst du das ja dann noch graphisch schöner machen.

Wie du die Schiffspositionen speicherst bleibt dir überlassen, Arrays, Listen, was du willst.

delfiphan · Beiträge: 2684 Erhaltene Danke: 32

Nicht zu empfehlen, aber rein theoretisch kannst du Shape1 mit TStream().WriteComponent speichern und in Shape2 mit TStream().ReadComponent laden (z.B. mit TMemoryStream). Da kommt dann aber alles mit, inkl. Position und Name. Letzteres wird dir dann eine Exception schmeissen, da keine 2 Controls mit dem gleichen Namen existieren dürfen.

Wie jaenicke bereits gesagt hat solltest du das Spielfeld selbst zeichnen. Entweder in eine TPaintBox, oder meinetwegen in eine TImage. Die sauberste Möglichkeit wäre eine eigene Komponente, die das GUI-Objekt "Spielfeld" in eine eigene Klasse kapselt.

Narses · Verfasst: Di 17.03.09 18:58

Moin!

Man kann auch einfach die Standard-Klasse erweitern. :idea:

Beispiel:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TMyShape = class(TShape)
  public
    procedure Assign(Source: TPersistent); override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    Shape1: TMyShape;
    Shape2: TMyShape;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyShape }

procedure TMyShape.Assign(Source: TPersistent);
begin
  if (Source is TShape) then begin
    Brush.Assign((Source as TShape).Brush);
    Pen.Assign((Source as TShape).Pen);
    Shape := (Source as TShape).Shape;
  end
  else
    inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Shape1 := TMyShape.Create(Self);
  Shape1.Parent := Self;
  Shape1.Left := 72;
  Shape1.Top := 112;
  Shape1.Width := 65;
  Shape1.Height := 65;
  Shape1.Brush.Color := clRed;
  Shape1.Shape := stCircle;

  Shape2 := TMyShape.Create(Self);
  Shape2.Parent := Self;
  Shape2.Left := 208;
  Shape2.Top := 112;
  Shape2.Width := 65;
  Shape2.Height := 65;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Shape2.Assign(Shape1);
end;

end.

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Mitmischer 1703 · Verfasst: Mi 18.03.09 17:52

Also soetwas:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:

unit GameField;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls;

type
  TGameField = class(TPaintBox)
  private
    { Private-Deklarationen }
  protected
    { Protected-Deklarationen }
  public
   CreateShipSinkField(Cols : Word, Rows : Word,...)
    { Public-Deklarationen }
  published
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TGameField]);
end;

end.

Oh jeh, ich versuchs mal so... Dann hab ich auch was fürs OpenSouce :twisted:

!
Ist TPaintBox soetwas wie ein bewegliches Canvas?

_________________
Die Lösung ist nicht siebzehn.

delfiphan · Beiträge: 2684 Erhaltene Danke: 32

TCustomControl wäre geeigneter wenn du eine eigene GUI-Komponente implementierst.

Mitmischer 1703 · Verfasst: Mi 18.03.09 18:29

Aber eigentlich will ich TPaintBox nur neue Fähigkeiten verleihen :-|

..

_________________
Die Lösung ist nicht siebzehn.

delfiphan · Beiträge: 2684 Erhaltene Danke: 32

Sowas ähnliches, natürlich in einer separaten Unit, etc.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TFieldCoord = type TPoint;
  TPlayField = class(TCustomControl)
  private
    FRowCount: Integer;
    FColumnCount: Integer;
    FSelection: TFieldCoord;
    procedure SetColumnCount(const Value: Integer);
    procedure SetRowCount(const Value: Integer);
    function GetFieldRect(X, Y: Integer): TRect;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function HitTest(P: TPoint): TFieldCoord;
  public
    constructor Create(AOwner: TComponent); override;
    property FieldRect[X, Y: Integer]: TRect read GetFieldRect;
  published
    property ColumnCount: Integer read FColumnCount write SetColumnCount;
    property RowCount: Integer read FRowCount write SetRowCount;
    property Align;
    property Visible;
    property Width;
    property Height;
    property OnClick;
    // usw.
  end;

{ TMyField }

constructor TPlayField.Create(AOwner: TComponent);
begin
  inherited;
  FSelection.X := -1;
  FSelection.Y := -1;
end;

function TPlayField.GetFieldRect(X, Y: Integer): TRect;
begin
  Result := Rect(Round(X/FColumnCount*Width),
              Round(Y/FRowCount*Height),
              Round((X + 1)/FColumnCount*Width),
              Round((Y + 1)/FRowCount*Height));
end;

function TPlayField.HitTest(P: TPoint): TFieldCoord;
var
  IndexX, IndexY: Integer;
begin
  // note: calculation could be done with a simple division, general solution shown here for completeness
  Result.X := -1;
  Result.Y := -1;
  for IndexX := 0 to FColumnCount - 1 do 
    for IndexY := 0 to FRowCount - 1 do
      if PtInRect(FieldRect[IndexX,IndexY], P) then
      begin
        Result.X := IndexX;
        Result.Y := IndexY;
        exit;
      end;
end;

procedure TPlayField.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  FSelection := HitTest(Point(X, Y));
  Invalidate;
  inherited;
end;

procedure TPlayField.Paint;
var
  IndexX, IndexY: Integer;
begin
  for IndexX := 0 to FColumnCount - 1 do
    for IndexY := 0 to FRowCount - 1 do
    begin
      if (IndexX = FSelection.X) and (indexY = FSelection.Y) then
        Canvas.Brush.Color := clRed
      else
        Canvas.Brush.Color := clWhite;
      Canvas.Rectangle(FieldRect[IndexX,IndexY]);
    end;
end;

procedure TPlayField.SetColumnCount(const Value: Integer);
begin
  FColumnCount := Value;
  Invalidate;
end;

procedure TPlayField.SetRowCount(const Value: Integer);
begin
  FRowCount := Value;
  Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  MyField: TPlayField;
begin
  MyField := TPlayField.Create(Self);
  MyField.Parent := Self;
  MyField.Width := 200;
  MyField.Height := 200;
  MyField.ColumnCount := 10;
  MyField.RowCount := 10;
end;

end.

Mitmischer 1703 · Verfasst: Mi 18.03.09 19:30

Wow...

Ich habs mir noch nicht angeguckt(ich will ja schließlich selber mal probieren), aber das scheint sehr brauchbar zu sein. Danke!

_________________
Die Lösung ist nicht siebzehn.

Mitmischer 1703 · Verfasst: Sa 21.03.09 13:58

Ich geb's auf und nehm deinen Code. Woher kannst du das so gut? Übung? Ich bin einfach nicht drauf gekommen

...

_________________
Die Lösung ist nicht siebzehn.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme