Assign auf Vorfahr-Komponente

[berens]

Hi. Steh mal wieder auf dem Schlauch.

TComponent
--> TMeineKlasse1 (TComponent)
x, y: integer
--> TMeineKlasse2 (TMeineKlasse1)
Text: string
--> TMeineKlasse3 (TMeineKlasse2)
z: integer

Jetzt habe ich ein Objekt vom Typ TMeineKlasse3 voll mit Daten.

Das neue Objekt vom Typ TMeineKlasse1 soll mit .Assign so viele Daten wie möglich erhalten. Hier: x, y. Text und z entfallen ja logischerweise.

Die Unit mit der Deklaration von TMeineKlasse1 soll nicht auf die Unit mit TMeineKlasse3 referenzieren, sondern nur die Infos auswerten, mit der die Klasse arbeiten kann (alles von TComponent, x und y).

Hier bekomme ich die Meldung "TMeineKlasse3 kann nicht zu TMeineKlasse1 zugewiesen werden.".

Ist ja auch klar, TMeineKlasse1 kann ja nicht alle Informationen halten wie TMeineKlasse3.

Wie kann ich das Problem lösen, wenn ich wirklich nur die Daten mit assign haben will, die dieser Komponententyp halten kann?




Meine Ansätze:
1) Typcast: TMeineKlasse1.Assign ruft inherited Assign(TComponent(_Sender)) auf --> Klappt nicht
2) ??

[shmia]

Hier mal das Grundgerüst:

Delphi-Quellcode:

procedure TMeineKlasse3.Assign(Source: TPersistent);
var
  t : TMeineKlasse3;
begin
  if Source is TMeineKlasse3 then
  begin
    t := TMeineKlasse3(Source);  // Hilfsvariable macht das Leben angenehmer
    self.z := t.z;
  end;
  inherited;  // Assign von TMeineKlasse2 aufrufen
end;

[berens]

Das Problem liegt nicht in TMeineKlasse3.Assign, sondern bei TMeineKlasse1.Assign

Beispiel:

Delphi-Quellcode:

procedure TMeineKlasse1.Assign(Source: TPersistent);
var
begin
  if Source.inheritsfrom(TComponent) then begin
    inherited; // <-- klappt nicht, weil Source von der Klasse TMeineKlasse 3 ist *
//  inherited Assign(TComponent(Source)); // klappt auch nicht
  end;

  if Source.inheritsfrom(TMeineKlasse1) then begin
    Self.X := TMeineKlasse1(Source).X;
    Self.Y := TMeineKlasse1(Source).Y;
  end;
end;

* dessen Unit wiederum NICHT in USES der Unit von TMeineKlasse1 stehen soll.

Fehlermeldung: "TMeineKlasse3 kann nicht zu TMeineKlasse1 zugewiesen werden."



Konkretes Beispiel:

Delphi-Quellcode:

var
  Klasse1: TMeineKlasse1;
  Klasse3: TMeineKlasse3;
begin
  Klasse1 := TMeineKlasse1.Create;

  Klasse3 := TMeineKlasse3.Create;
  Klasse3.X := 10;
  Klasse3.Y := 20;
  Klasse3.Z := 30;
  Klasse3.Text := 'Hallo!';

  // Klasse1.X und Y sind nach wie vor 0

  Klasse1.Assign(Klasse3);
  ^-- Exception

  ShowMessage(IntToStr(Klasse1.X));
  // Meine Erwartung als korrekte Ausgabe: "10"

Als einzigen Lösungsansatz sehe ich im Moment, die Eigenschaften der TComponent Klasse zu ignorieren. Also kein Inherited aufrufen sondern nur eine leere TMeineKlasse1 neu zu erstellen und die Variablen einfach rüberzukopieren. Da ich keine Werte von TComponent benutze (hoffe/denke ich mal) ist das hier jetzt nicht so tragisch, aber mir geht's hier erstmal um's Prinzip wie es geht, einer Vorfahrenklasse eine Varible seines eigenen Nachfolgers zuzuweisen.

Danke schonmal.

[chaosben]

So funktionierts bei mir:

Delphi-Quellcode:

unit Unit1;

interface

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

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

  TKlasse1 = class(TPersistent)
  public
    X, Y : Integer;
    procedure Assign(Source: TPersistent); override;
  end;

  TKlasse2 = class(TKlasse1)
  public
    Text : String;
    procedure Assign(Source: TPersistent); override;
  end;

  TKlasse3 = class(TKlasse2)
  public
    Z : Integer;
    procedure Assign(Source: TPersistent); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  K1 : TKlasse1;
  K3 : TKlasse3;
begin
  K1 := TKlasse1.Create;

  K3 := TKlasse3.Create;
  K3.X := 5778;
  K3.Y := 135;
  K3.Z := 9788;
  K3.Text := 'Bla';

  K1.Assign(K3);
  MessageDlg(Format('X = %d Y=%d', [K1.X, K1.Y]), mtWarning, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

{ TKlasse1 }

procedure TKlasse1.Assign(Source: TPersistent);
begin
  if Source is TKlasse1 then
  begin
    X := TKlasse1(Source).X;
    Y := TKlasse1(Source).Y;
    // hier kein inherited
  end
  else
    inherited;
end;

{ TKlasse2 }

procedure TKlasse2.Assign(Source: TPersistent);
begin
  if Source is TKlasse2 then
  begin
    Text := TKlasse2(Source).Text;
    inherited;
  end
  else
    inherited;
end;

{ TKlasse3 }

procedure TKlasse3.Assign(Source: TPersistent);
begin
  if Source is TKlasse3 then
  begin
    Z := TKlasse3(Source).Z;
    inherited;
  end
  else
    inherited;
end;

end.

[sx2008]

Das Problem ist, dass du noch nicht verstanden hast, wie Assign funktioniert.
Wenn man TPersistent zu einem TPersistent zuweisen möchte, dann wird direkt eine Exception geworfen.
(es wird in Wirklichkeit noch der Weg über AssignTo() probiert, aber das braucht hier mal nicht zu stören)
Das Gleiche gilt für TComponent: TComponent.Assign() ist nicht implementiert; also Exception.

Die Klassenhierachie sieht so aus:

Code:

TObject->TPersistent->TComponent->TMeineKlasse1->TMeineKlasse2->TMeineKlasse3

TMeinKlasse1 darf also nur dann inherited aufrufen, wenn es mit der Klasse von Source nichts anfangen kann.

Delphi-Quellcode:

procedure TMeineKlasse1.Assign(Source: TPersistent);
var
begin
  if Source is TMeineKlasse1 then
  begin
    Self.X := TMeineKlasse1(Source).X;
    Self.Y := TMeineKlasse1(Source).Y;
  end
  else if Source is TControl then  // nur ein Beispiel
  begin
    Self.X := TControl(Source).Left;
    Self.Y := TControl(Source).Top;
  end
  else
    // "ich kenne deine Klasse nicht" - also inherited aufrufen
    // das führt zur Exception
    inherited;
end;

Für die Klassen TMeineKlasse2 und TMeineKlasse3 gilt folgende Strategie:
Alle eigenen Properties kopieren und dann immer inherited aufrufen, denn man weiss ja
dass drüber die Klasse TMeineKlasse1 sitzt und den Rest erledigt.

[berens]

Dein Beispiel lässt sich zwar starten (und hilft mir auch soweit erstmal mein Problem zu lösen, danke), allerdings verstehe ich nicht, warum inherited nicht funktioniert, siehe dieses Beispiel:

Delphi-Quellcode:

  TKlasse1 = class(TComponent)

  ...

procedure TForm1.Button1Click(Sender: TObject);
var
  K1 : TKlasse1;
  K3 : TKlasse3;
begin
  K1 := TKlasse1.Create(Self);
  K1.Tag := 11;

  K3 := TKlasse3.Create(Self);
  K3.X := 5778;
  K3.Y := 135;
  K3.Z := 9788;
  K3.Text := 'Bla';
  K3.Tag := 22;

  K1.Assign(K3);
  MessageDlg(Format('X = %d Y = %d Tag = %d', [K1.X, K1.Y, K1.Tag]), mtWarning, [mbOK], 0); // Ausgabe: 5778 135 11 <-- sollte 22 sein
end;

Klar, in Assign müsste wieder inherited aufgerufen werden, damit Tag kopiert wird, aber dann kommt ja wieder die Exception.

Bleibt scheinbar nix anderes übrig, als in meiner untersten Klasse die Werte von TComponent per Hand zu kopieren.

Danke auf jeden Fall schonmal an die Antworter

[Blup]

TComponent implementiert kein eigenes Assign (um z.B. den Tag zu übernehmen).
Deshalb wird Assign von TPersistent aufgerufen, was zur Exception führt.
Wenn deine Komponente auch den Tag übernehmen soll, dann z.B. so:

Delphi-Quellcode:

procedure TMeineKlasse1.Assign(Source: TPersistent); 
begin 
  if Source is TComponent then
    Tag := TComponent(Source).Tag
  else 
    inherited; {Exception auslösen}

  if Source is TMeineKlasse1 then 
  begin 
    X := TMeineKlasse1(Source).X; 
    Y := TMeineKlasse1(Source).Y; 
  end;
end;

[berens]

Aahhhhh! oO *Licht aufgeh*

Nagut, wenn man mit zu hohen Erwartungen an Sachen rangeht ist klar, dass man oft enttäuscht wird:

Ich dachte dass alle VCL Komponenten quasi "von Hause aus" mit einem funktionierenden "Assign" ausgeliefert werden. Sind sie aber nicht. Wieder was dazugelernt.

Nimmt man nun eine Komponente, die Assign implementiert hat (z.B. TFont), dann klappt auch mein Beispiel vollwertig (inherited wird bei Assign aufgerufen):

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TKlasse1 = class(TFont)
  public
    X, Y : Integer;
    procedure Assign(Source: TPersistent); override;
  end;

  TKlasse2 = class(TKlasse1)
  public
    Text : String;
    procedure Assign(Source: TPersistent); override;
  end;

  TKlasse3 = class(TKlasse2)
  public
    Z : Integer;
    procedure Assign(Source: TPersistent); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  K1 : TKlasse1;
  K3 : TKlasse3;
begin
  K1 := TKlasse1.Create;
  K1.Color := 11;

  K3 := TKlasse3.Create;
  K3.X := 5778;
  K3.Y := 135;
  K3.Z := 9788;
  K3.Text := 'Bla';
  K3.Color := 22;

  K1.Assign(K3);
  MessageDlg(Format('X = %d Y = %d Tag = %d', [K1.X, K1.Y, K1.Color]), mtWarning, [mbOK], 0); // Korrekte Ausgabe: 5778 135 22
end;

{ TKlasse1 }

procedure TKlasse1.Assign(Source: TPersistent);
begin
  if Source is TKlasse1 then
  begin
    X := TKlasse1(Source).X;
    Y := TKlasse1(Source).Y;
  end;
  INHERITED; // funktioniert
end;

{ TKlasse2 }

procedure TKlasse2.Assign(Source: TPersistent);
begin
  if Source is TKlasse2 then
  begin
    Text := TKlasse2(Source).Text;
    inherited;
  end
  else
    inherited;
end;

{ TKlasse3 }

procedure TKlasse3.Assign(Source: TPersistent);
begin
  if Source is TKlasse3 then
  begin
    Z := TKlasse3(Source).Z;
    inherited;
  end
  else
    inherited;
end;

end.

Danke für die Erleuchtung

[quendolineDD]

Zitat von Blup:

TComponent implementiert kein eigenes Assign (um z.B. den Tag zu übernehmen).
Deshalb wird Assign von TPersistent aufgerufen, was zur Exception führt.
Wenn deine Komponente auch den Tag übernehmen soll, dann z.B. so:

Delphi-Quellcode:

procedure TMeineKlasse1.Assign(Source: TPersistent); 
begin 
  if Source is TComponent then
    Tag := TComponent(Source).Tag
  else 
    inherited; {Exception auslösen}

  if Source is TMeineKlasse1 then 
  begin 
    X := TMeineKlasse1(Source).X; 
    Y := TMeineKlasse1(Source).Y; 
  end;
end;

Das würde natürlich bei allen Klassen <> TComponent eine Exception generieren.
Edit: Zitat eingefügt.

[Blup]

Eine Exception würde so nur bei Klassen auftreten, die nicht von TComponent abgeleitet wurden.