Hi @All,
noch 'n bissl was zur "Schönheit/Korrektheit".
Hier mal ein Beispiel wie eine meiner Interface Deklarationen aussieht!!
Delphi-Quellcode:
IUpdater =
Interface(IInterface)
['
{2EA0113C-2BE8-443A-86BE-1B6E40573772}']
//GUID (Global Unique Identifier)
//-- protected --//
procedure SetInterfacedOwner(AOwner:TObject);
stdcall;
function GetInterf:IUpdater;
procedure Call(Sender:TObject);
stdcall;
procedure CallOwner;
stdcall;
procedure RaiseError(Sender:TObject;cid:TID;eid:TErrorID);
stdcall;
function GetCallerID:TID;
stdcall;
function GetActionID:TActionID;
stdcall;
procedure SetActionID(act:TActionID);
stdcall;
function GetCallerAction:TActionID;
stdcall;
procedure RestoreLastAction;
stdcall;
function GetInterfacedObjectOwner:TObject;
stdcall;
function RequestPosition(
var px,py:Double;posreq:TPositionRequest;targetID:TID):boolean;
stdcall;
function RequestMainMaxArr(
var arr:TMinMaxXYArr; targetID:TID):boolean;
stdcall;
property ActionID:TActionID
read GetActionID
write SetActionID;
//-- public !! --//
property Updater:IUpdater
read GetInterf;
// referst to self.IUpdater interface
property InterfacedObjectOwner:TObject
read GetInterfacedObjectOwner;
end;
Zusätzlich hab ich noch zwei Funktionen die ganz Praktisch sind.
Delphi-Quellcode:
function CheckInterface(Caller:TObject;var Intf:IUpdater):Boolean;
begin
if (Caller<>NIL) then result := Caller.GetInterface(IUpdater,Intf);
end;
// Checks if the caller also has the interface IUpdater and if "I'm" the owner
// If yes it returns true and the Pointer to the interface in "var intf:IUpdater"
function CheckInterface_DoIOwn(Caller,Receiver:TObject;var Intf:IUpdater):Boolean;
begin
result := false;
if (Receiver<>NIL)
then if CheckInterface(Caller,Intf)
then result := (Intf.InterfacedObjectOwner=Receiver);
end;
und hier mal ein Beispiel für die Definition einer Basisklasse
Delphi-Quellcode:
//----------------------------------------------------------------------------//
// TInterfacedCollectionItem = CLASS(TCollectionItem,IUpdater) //
//----------------------------------------------------------------------------//
TInterfacedCollectionItem = CLASS(TCollectionItem,IUpdater)
private
FOwnerUpInt : IUpdater;
FOwnerUpIntExists : BOOLEAN;
FInterfacedOwner : TObject;
FID : TID;
FActionID : TActionID;
FActionRead : Boolean;
protected
//-- Interface IInterface --//
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
function _AddRef: Integer; virtual; stdcall;
function _Release: Integer; virtual; stdcall;
//-- Interface IUpdater --//
procedure SetInterfacedOwner(AOwner:TObject); virtual; stdcall;
function GetInterf:IUpdater;
procedure Call(Sender:TObject); virtual; stdcall;
procedure CallOwner; virtual; stdcall;
procedure RaiseError(Sender:TObject;cid:TID;eid:TErrorID); virtual; stdcall;
function GetCallerID:TID; virtual; stdcall;
function GetActionID:TActionID; virtual; stdcall;
procedure SetActionID(act:TActionID); virtual; stdcall;
function GetCallerAction:TActionID; virtual; stdcall;
procedure RestoreLastAction; virtual; stdcall;
function GetInterfacedObjectOwner:TObject; virtual; stdcall;
function RequestPosition(var px,py:Double;posreq:TPositionRequest;targetID:TID):boolean; virtual; stdcall;
function RequestMainMaxArr(var arr:TMinMaxXYArr; targetID:TID):boolean; virtual; stdcall;
//-- --//
property OwnerUpInt:IUpdater read FOwnerUpInt write FOwnerUpInt;
property OwnerUpIntExists:BOOLEAN read FOwnerUpIntExists write FOwnerUpIntExists;
property InterfacedOwner:TObject read FInterfacedOwner write FInterfacedOwner;
property ID:TID read FID write FID;
property ActionID:TActionID read GetActionID write SetActionID;
public
constructor create(ACollection: TCollection); override;
destructor destroy; override;
property Updater:IUpdater read GetInterf;
property InterfacedObjectOwner:TObject read GetInterfacedObjectOwner;
published
end;
Implementationsteil:
Delphi-Quellcode:
//----------------------------------------------------------------------------//
// TInterfacedCollectionItem = CLASS(TCollectionItem,IUpdater) //
//----------------------------------------------------------------------------//
//-[ CONSTRUCTOR / DESTUCTOR ]------------------------------------------------//
constructor TInterfacedCollectionItem.create(ACollection: TCollection);
begin
inherited create(ACollection);
SetInterfacedOwner(TObject(ACollection.Owner));
FID := idNone;
FActionID := aidNone;
end;
destructor TInterfacedCollectionItem.destroy;
begin
FInterfacedOwner := NIL;
FOwnerUpIntExists := no;
FOwnerUpInt := NIL;
inherited;
end;
//--[ PRIVATE ]---------------------------------------------------------------//
//--[ PROTECTED ]-------------------------------------------------------------//
//--[ Interface IInterface ]--------------------------------------------------//
function TInterfacedCollectionItem.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
if GetInterface(IID, Obj)
then Result := S_OK
else Result := E_NOINTERFACE;
end;
function TInterfacedCollectionItem._AddRef: Integer; stdcall;
begin
Result := -1;
end;
function TInterfacedCollectionItem._Release: Integer; stdcall;
begin
Result := -1;
end;
//--[ Interface IUpdater ]----------------------------------------------------//
procedure TInterfacedCollectionItem.SetInterfacedOwner(AOwner:TObject); stdcall;
begin
FInterfacedOwner := NIL;
FOwnerUpIntExists := no;
FOwnerUpInt := NIL;
if (AOwner<>NIL)
then if AOwner.GetInterface(IUpdater,FOwnerUpInt)
then begin
FInterfacedOwner := AOwner;
FOwnerUpIntExists := yes;
end;
end;
function TInterfacedCollectionItem.GetInterf:IUpdater;
begin
// Can be done this way, cause "I" know "I" have the Interface !!!
Self.GetInterface(IUpdater,result);
end;
procedure TInterfacedCollectionItem.Call(Sender:TObject); stdcall;
begin
end;
procedure TInterfacedCollectionItem.CallOwner; stdcall;
begin
if FOwnerUpIntExists THEN FOwnerUpInt.Call(Self);
end;
procedure TInterfacedCollectionItem.RaiseError(Sender:TObject;cid:TID;eid:TErrorID); stdcall;
begin
End;
function TInterfacedCollectionItem.GetCallerID:TID; stdcall;
begin
Result := FID;
end;
function TInterfacedCollectionItem.GetActionID:TActionID; stdcall;
begin
result := FActionID;
end;
procedure TInterfacedCollectionItem.SetActionID(act:TActionID); stdcall;
begin
FActionID := act;
FActionRead := no;
end;
function TInterfacedCollectionItem.GetCallerAction:TActionID; stdcall;
begin
// Can be read only once if not RestoreLastAction !!!!
result := aidNone;
if not(FActionRead) then result := FActionID;
FActionRead := yes;
end;
procedure TInterfacedCollectionItem.RestoreLastAction;
begin
FActionRead := no;
end;
function TInterfacedCollectionItem.GetInterfacedObjectOwner:TObject; stdcall;
begin
if Assigned(FInterfacedOwner) then Result:=FInterfacedOwner else Result := nil;
end;
function TInterfacedCollectionItem.RequestPosition(var px,py:Double;posreq:TPositionRequest;targetID:TID):boolean; stdcall;
begin
result := no;
px := 0;
py := 0;
end;
function TInterfacedCollectionItem.RequestMainMaxArr(var arr:TMinMaxXYArr; targetID:TID):boolean; stdcall;
begin
result := no;
end;
//--[ PUBLIC ]----------------------------------------------------------------//
//--[ PUBLISHED ]-------------------------------------------------------------//
////[ TInterfacedCollectionItem ]///////////////////////////////////////////////
Ihr muesst euch da jetzt nicht im Detail durchwurschteln.
Aber
BIITE die
GUID (SHIFT+CTRL+G) einfügen und hinter jede Methode
stdcall;.
Die
virtual; deklaration in der Basisklasse inst nicht notwendig, da hier die Methoden schon
explizit implementiert sind. Stört aber nicht und dient nur zur Sicherheit (gegen meinen Alzheimer).
- Die Standard-Aufrufkonvention für Schnittstellen ist register. Schnittstellen, die man von
verschiedenen Modulen gemeinsam benutzt, sollten die Methoden mit stdcall deklarieren.
Dies gilt insbesondere, wenn diese Module in verschiedenen Programmiersprachen erstellt wurden.
- Wenn Sie den Operator as oder QueryInterface() mit einer Schnittstelle einsetzen,
muss diese eine zugeordnete IID besitzen.
- In jedem Interface ist unterstellt, dass die Basisklasse oder ein Vorfahr die Methoden
von IUnknown zur Referenzzählung implementiert.
- Im Unterschied zu einer abstrakten Klasse enthält eine Schnittstelle überhaupt keine implementierte
Methode, alle Methoden sind abstrakt. Abstrakte Klassen lassen sich verwenden, wenn bereits ein
bestimmtes Grundverhalten in den abgeleiteten Klassen vorhanden sein soll.
Mhh... Ich hab schon lang überlegt mal ein TUT über Interfaces zu basteln. Aber gerade fehlt mir die Zeit.
MFG
LoCrux