TObject As Interface

[Incocnito]

Hi zusammen,

ich muss zugeben, ich weiß gerade nicht so recht, wie ich nach meinem Problem suchen kann,
daher poste ich hier, auch wenn es möglicherweise schon eine Antowrt dazu irgendwo gibt.

Es handelt sich hierbei um eine theoretische Frage, da ich das ganze im Projekt nun anders gelöst habe.
Trotzdem würde ich gerne wissen, was ich falsch mache oder wie man das Problem reell lösen könnte.

Ich habe eine vordefinierte Quelle in welchem ich Daten als "TObject" speichern kann. Ein StringGrid.
In diesem StringGrid speichere ich pro Zeile die Nutzinformationen in StringGrid.Objects[0, iRow].
Zum Speichern verwende ich einen eigenen Typ "TGridObject".
Nun möchte ich eine allgemeingültige Funktion haben, mit welcher ich im StringGrid einen Hint anzeigen kann.
Damit diese Funktion auch auf anderen Grids funktioniert definiere ich ein Interface "IGridInfo",
welches mir die Funktion "GetVal(const iCol : Integer) : String;" bereit stellen soll.
Die Idee ist, dass die "AutoGridHint"-Funktion den String, welcher angezeigt werden kann über diese Funktion erhällt.
Das Objekt muss dann natürlich von diesem Interface erben und die Funktion umsetzen.

Definition vom Interface in der Tools-Unit:

Delphi-Quellcode:

type
  IGridInfo = interface(IInterface)
    ['{675C1022-0376-4583-AF24-8FAA2D008139}']
    Function GetVal(const iCol : Integer) : String;
  end;

Definition des GridObjects in der Unit mit dem Form:

Delphi-Quellcode:

type
  TGridObject = class(TInterfacedObject, IGridInfo)
  private
    FRow      : Integer;
    FSomeText : String;
    FSomeMore : String;
  public
    Function GetVal(const iCol : Integer) : String;
    Constructor Create(const iRow : Integer; const sText1 : String; const sText2 : String);
  end;

Das Grid (sgDaten) wird dann irgendwie irgendwann gefüllt und in Spalte "0" wird das Objekt gespeichert.

Delphi-Quellcode:

  currObj := TGridObject.Create(iRow, 'bla', 'blub');
  sgDaten.Objects[0, iRow] := currObj;
  sgDaten.Cells[1, iRow] := currObj.GetVal(1);

GetVal(1) soll hierbei FSomeText und GetVal(2) soll FSomeMore zurück geben.

In MouseMove vom Grid werden die Koordinaten umgerechnet und an die tolle Methode übergeben:

Delphi-Quellcode:

procedure TfrmMain.sgDatenMouseMove(
  Sender : TObject;
  Shift  : TShiftState;
  X      : Integer;
  Y      : Integer
);
var
  ACol : Integer;
  ARow : Integer;
begin
  inherited;
  sgDaten.MouseToCell(x, y, ACol, ARow);
  AutoGridHint(sgDaten, ACol, ARow);
End;

Bisher bin ich bei solchen Sachen dann hingegangen und habe folgendes gemacht (was auch toll funktioniert):

Delphi-Quellcode:

procedure TfrmMain.sgDatenMouseMove(
  Sender : TObject;
  Shift  : TShiftState;
  X      : Integer;
  Y      : Integer
);
var
  ACol : Integer;
  ARow : Integer;
  GridObj : TGridObject;
  sHint   : String;
begin
  inherited;
  sgDaten.MouseToCell(x, y, ACol, ARow);

  if (sgDaten.Objects[0, ARow] <> nil) AND
     (sgDaten.Objects[0, ARow] IS TGridObject) then
  Begin
    GridObj := sgDaten.Objects[0, ARow] AS TGridObject;
    sHint := GridObj.GetVal(ACol);
    if (sgDaten.Hint <> sHint) then
    Begin
      Application.CancelHint();
      sgDaten.Hint := sHint;
    End;
  End;

end;

Jetzt wollte ich das aber ja, wie oben schon erkennbar, über eine zentrale Methode laufen lassen.
In den Tools hatte ich zuletzt dieses hier:

Delphi-Quellcode:

Procedure AutoGridHint(
  sgCurr     : TStringGrid;
  const iCol : Integer;
  const iRow : Integer
);
var
  GridObj : IGridInfo;
  sHint   : String;
Begin
  if (sgCurr.Objects[0, iRow] <> nil) AND
     (Supports(sgCurr.Objects[0, iRow], IGridInfo)) then
  Begin
    GridObj := IGridInfo(sgCurr.Objects[0, iRow]); // <- Nope
    sHint := GridObj.GetVal(iCol);
    if (sgCurr.Hint <> sHint) then
    Begin
      Application.CancelHint();
      sgCurr.Hint := sHint;
    End;
  End;
End;

Anstelle vom "IS"-Operator für Objekte soll man bei Interfaces offensichtlich
"Supports" aus den SysUtils nehmen.
Aber egal ob ich versuche den Cast zu erzwingen "IGridInfo(...)" oder
vorsichtig zu erfragen "X AS IGridInfo", der Compiler will das nicht.
Das unterliegende Objekt erbt ja das Interface, aber diese vorgehensweise ist
in Delphi wohl nicht vorgesehen.
Ich befürchte auch, dass "Supports" prüft, ob die Klasse "TObject" das Interface "IGridInfo" erbt
und nicht das Objekt, was tatsächlich gespeichert ist, denn die Funktion liefert mir "False".

"IS" und "AS", wie ich das von Klassen kenne läuft hier nicht, aber warum und wie löst man sowas dann?

Frage zusammengefasst also: Wenn ich eine Klasse A [TGridObject] erstelle,
welche vom Interface X [IGridInfo] erbt und ich ein
Objekt A1 dieser Klasse A erzeuge und in einer Variable V1 speichere,
welche vom Typ (Klasse) B [TObject] ist (wobei die Klasse A von Klasse B erbt),
wie kann ich auf die Funktionen des Interface X [IGridInfo] zugreifen, wenn ich
als Übergabe nur eine Variable V1 habe?

Oder vielleicht noch ein kurzes (unrealistisches!) Beispiel mit dem ersten Interface,
was ich in SysUtils gefunden habe (damit ist dann alles in einer Funktion):

Delphi-Quellcode:

Procedure Test();
var
  v1 : TSimpleRWSync;
  v2 : TObject;
  v3 : IReadWriteSync;
Begin
  // Erstelle Objekt vom Typ 1
  v1 := TSimpleRWSync.Create();

  // Speicher in Oberklasse:
  v2 := v1;

  // Mach irgendwas, um aus v2 das Interface zu bekommen:
  v3 := Irgendwas_IReadWriteSync(v2);

  // Arebite mit den Methoden des Interface:
  v3.BeginRead();
  v3.EndRead();
End;

Und wehe es kommt einer und sagt "mach doch einfach >v1.BeginRead<"!

Ich hoffe jemand hat da eine Idee zu.
Schonmal vielen Dank alleine für die Zeit für's lesen!

Liebe Grüße
Incocnito

[DeddyH]

Ohne groß nachzudenken würde ich es so versuchen:

Delphi-Quellcode:

Procedure AutoGridHint(
  sgCurr : TStringGrid;
  const iCol : Integer;
  const iRow : Integer
);
var
  GridObj : IGridInfo;
  sHint : String;
Begin
  if Assigned(sgCurr.Objects[0, iRow]) AND
     Supports(sgCurr.Objects[0, iRow], IGridInfo, GridObj) then
  Begin
    //GridObj := IGridInfo(sgCurr.Objects[0, iRow]); // <- Nope
    sHint := GridObj.GetVal(iCol);
    if (sgCurr.Hint <> sHint) then
    Begin
      Application.CancelHint();
      sgCurr.Hint := sHint;
    End;
  End;
End;

[edit] Vermutlich wäre es aber sachdienlicher, TGridInfo nicht von TInterfacedObject, sondern von TInterfacedPersistent abzuleiten, um die Referenzzählung und damit ein unbeabsichtigtes Freigeben zu umgehen. [/edit]

[Incocnito]

Danke für die schnelle Antwort!

Respekt, dass du das so schnell raus hattest!
Mit
- Assigned (aber ich glaube das tut nichts zur Sache)
- Supports + Parameter
- TInterfacedPersistent
läufts exakt, wie es soll!

Liebe Grüße
Incocnito

[peterbelow]

Zitat von Incocnito:

Hi zusammen,

ich muss zugeben, ich weiß gerade nicht so recht, wie ich nach meinem Problem suchen kann,
daher poste ich hier, auch wenn es möglicherweise schon eine Antowrt dazu irgendwo gibt.

Es handelt sich hierbei um eine theoretische Frage, da ich das ganze im Projekt nun anders gelöst habe.
Trotzdem würde ich gerne wissen, was ich falsch mache oder wie man das Problem reell lösen könnte.

Ich habe eine vordefinierte Quelle in welchem ich Daten als "TObject" speichern kann. Ein StringGrid.
In diesem StringGrid speichere ich pro Zeile die Nutzinformationen in StringGrid.Objects[0, iRow].
Zum Speichern verwende ich einen eigenen Typ "TGridObject".
Nun möchte ich eine allgemeingültige Funktion haben, mit welcher ich im StringGrid einen Hint anzeigen kann.
Damit diese Funktion auch auf anderen Grids funktioniert definiere ich ein Interface "IGridInfo",
welches mir die Funktion "GetVal(const iCol : Integer) : String;" bereit stellen soll.
Die Idee ist, dass die "AutoGridHint"-Funktion den String, welcher angezeigt werden kann über diese Funktion erhällt.
Das Objekt muss dann natürlich von diesem Interface erben und die Funktion umsetzen.

Definition vom Interface in der Tools-Unit:

Delphi-Quellcode:

type
  IGridInfo = interface(IInterface)
    ['{675C1022-0376-4583-AF24-8FAA2D008139}']
    Function GetVal(const iCol : Integer) : String;
  end;

Definition des GridObjects in der Unit mit dem Form:

Delphi-Quellcode:

type
  TGridObject = class(TInterfacedObject, IGridInfo)
  private
    FRow      : Integer;
    FSomeText : String;
    FSomeMore : String;
  public
    Function GetVal(const iCol : Integer) : String;
    Constructor Create(const iRow : Integer; const sText1 : String; const sText2 : String);
  end;

Im Prinzip funktioniert das, aber Du hast da eine Zeitbombe konstruiert, da von TInterfacedObject abgeleitete Klassen darauf angelegt sind, das die Lebensdauer von Objekten dieser Klasse per Interface reference counting kontrolliert wird. Daher ist es Gift, Objektreferenzen solcher Objekte irgendwo zu speichern.

1. Du erzeugst eine Objekt der Klasse und speicherst es irgendwo. Der Reference count ist jetzt 0.
2. Du erzeugst eine Interface-Referenz aus der Objektreferenz, danach ist der reference count 1.
3. Die Interface-Referenz geht out of scope und dadurch wird automatisch seine _Release-Methode aufgerufen. Der reference count fällt auf 0 und dadurch wird das Objekt zerstört.
4. Deine gespeicherte Objektreferenz ist nun nicht mehr gültig.

Wenn Du Objekt- und Interface-Referenzen mischen willst brauchst Du eine Basisklasse, die IInterface ohne reference counting implementiert.
Z. B. die hier:

Delphi-Quellcode:

{! == BaseNonRefcountIntfObjU ===========================================
<summary>
 This unit provides a base class with a non-reference counted
  implementation of IUnknown/IInterface.</summary>
<author>Dr. Peter Below</author>
<history>
 Version 1.0 created 2002-03-28<p>
 Version 1.0 created 2009-03-22, changed docs to XML, checked
 for Unicode issues.<p>
 Version 2.0 created 2016-08-05, renamed to scoped name, adjusted
 uses clauses.<p>
 Last modified       2016-08-05<p>
</history>
<remarks></remarks>
<copyright>Copyright 2009 by Dr. Peter Below</copyright>
<licence> The code in this unit is released to the public domain without
restrictions for use or redistribution. Just leave the copyright note
above intact. The code carries no warranties whatsoever, use at your
own risk!</licence>
=======================================================================}
unit PB.BaseNonRefcountIntfObjU;
interface

type
  {! <summary>
    Derive classes that need a non-reference counted IInterface
    implementation from this class.</summary>
  }
  TNonRefcountInterfacedObject = class(TObject, IInterface)
  protected
    {! <summary>
      Try to obtain an interface from this object.</summary>
     <returns>S_OK if the interface could be found, E_NOINTERFACE otherwise.</returns>
     <param name="IID">identifies the interface to get, can be a GUID or
       an interface type with a GUID.</param>
     <param name="Obj">receives the found interfaces reference.</param>
    }
    function QueryInterface(const IID: TGUID; out Obj): HResult;
      stdcall;
    {! <summary>
      Does nothing and always returns -1. </summary>
    }
    function _AddRef: Integer; stdcall;
    {! <summary>
      Does nothing and always returns -1. </summary>
    }
    function _Release: Integer; stdcall;
  end;

implementation

function TNonRefcountInterfacedObject.QueryInterface(
  const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE
end;

function TNonRefcountInterfacedObject._AddRef: Integer;
begin
  Result := -1 // -1 indicates no reference counting is taking place
end;

function TNonRefcountInterfacedObject._Release: Integer;
begin
  Result := -1 // -1 indicates no reference counting is taking place
end;

end.

TPersistent ist auch geeignet, diese Klasse hat ebenfalls eine IInterface-Implementierung ohne reference counting, schleppt aber mehr Ballast mit.

Die Supports-Funktion aus System.Sysutils ist die bevorzugte Methode, um aus einer objektreferenz eine Interface-Referenz zu extrahieren. Ein "as" typecast funktioniert normalerweise auch, dafür muß der Interface-Type aber eine GUID haben.

[dummzeuch]

Wenn ich mich recht erinnere, funktioniert auch mit Interfaces das IS. Und damit es funktioniert, muss man bei der Interface-Deklaration eine GUID angeben. Und ich glaube, dasselbe gilt auch für Supports.

(Das ist jetzt nur so dahin getippert, ohne Deinen Code genauer angeschaut zu haben.)