Unit FInterfaceTest;
Interface
Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Type
IPNameRead =
Interface( IInterface )
['
{801B392E-D9A7-4705-93DD-4822F032E33C}']
Function GetName:
String;
End;
IPNameWrite =
Interface( IPNameRead )
// Wer schreiben kann, kann auch lesen ;)
['
{7B1C4BAC-213C-4DD3-8EAB-A5A37DEEB123}']
Procedure SetName(
Const Value:
String );
End;
IPValues =
Interface( IInterface )
['
{0062AA2E-96AA-4C5D-85CD-83C946083887}']
Function GetValue: Variant;
Procedure SetValue(
Const Value: Variant );
End;
TIObjBase =
Class( TInterfacedObject, IPNameWrite )
Private
{ Private-Deklaration }
FName:
String;
Protected
{ Protected-Deklaration }
Function GetName:
String;
Virtual;
Procedure SetName(
Const Value:
String );
Virtual;
Property Name:
String Read GetName
Write SetName;
Public
{ Public-Deklaration }
End;
TIObj =
Class( TIObjBase, IPValues )
Private
{ Private-Deklaration }
FValue: Variant;
Protected
{ Protected-Deklaration }
Function GetValue: Variant;
Procedure SetValue(
Const Value: Variant );
Public
{ Public-Deklaration }
Property Name;
Property Value: Variant
Read GetValue
Write SetValue;
End;
{ Hier beginnt die Form... (So Übersichtshalber ^^ ) }
TfrmInterfaceTest =
Class( TForm )
txtName: TEdit;
txtValue: TEdit;
lblName: TLabel;
lblValue: TLabel;
cmdRead: TButton;
cmdWrite: TButton;
rbTIObjBase: TRadioButton;
rbTIObj: TRadioButton;
procedure rbObjTypClick(Sender: TObject);
procedure cmdReadClick(Sender: TObject);
procedure cmdWriteClick(Sender: TObject);
Private
{ Private-Deklarationen }
FMyObj: TObject;
Protected
{ Protected-Deklaration }
Procedure CreateRbObj;
Procedure GetMyObjValues;
Procedure SetMyObjValues;
Public
{ Public-Deklarationen }
Constructor Create( AOwner: TComponent);
Override;
Destructor Destroy;
Override;
Property MyObj: TObject
Read FMyObj
Write FMyObj;
End;
Var frmInterfaceTest: TfrmInterfaceTest;
implementation
{$R *.dfm}
{ TIObjBase }
Function TIObjBase.GetName:
String;
Begin
Result := FName;
End;
Procedure TIObjBase.SetName(
Const Value:
String );
Begin
FName := Value;
End;
{ TIObj }
Function TIObj.GetValue: Variant;
Begin
Result := FValue;
End;
Procedure TIObj.SetValue(
Const Value: Variant );
Begin
FValue := Value;
End;
{ Hier beginnt die Form... (So Übersichtshalber ^^ ) }
{ TForm1 }
Constructor TfrmInterfaceTest.Create( AOwner: TComponent );
Begin
Inherited;
CreateRbObj;
// Das kleine wird erzeugt... =p
End;
Destructor TfrmInterfaceTest.Destroy;
Begin
If Assigned( MyObj )
Then FreeAndNil( FMyObj );
// Ist ja public, da kann viel passieren... ;)
Inherited;
End;
Procedure TfrmInterfaceTest.CreateRbObj;
Begin
If Assigned( MyObj )
Then FreeAndNil( FMyObj );
// Ist ja public, da kann viel passieren... ;)
If rbTIObjBase.Checked
Then Begin
MyObj := TIObjBase.Create;
( MyObj
As TIObjBase ).
Name := '
TIObjBase';
// geht da protected und in der selben Unit... ^^
End Else If rbTIObj.Checked
Then Begin
MyObj := TIObj.Create;
( MyObj
As TIObjBase ).
Name := '
TIObj';
// geht da protected und in der selben Unit... ^^
( MyObj
As TIObj ).Value := '
Ein String Wert...';
End;
// Bei allem anderen ist MyObj ja NIL, was nicht passieren sollte... ;)
GetMyObjValues;
End;
Procedure TfrmInterfaceTest.rbObjTypClick( Sender: TObject );
Begin
{ Radiobutton wurde geändert bzw. angeklickt... ==> Neues Objekt }
CreateRbObj;
End;
Procedure TfrmInterfaceTest.cmdReadClick( Sender: TObject );
Begin
GetMyObjValues;
End;
Procedure TfrmInterfaceTest.cmdWriteClick( Sender: TObject );
Begin
SetMyObjValues;
End;
Procedure TfrmInterfaceTest.GetMyObjValues;
Var IPV: IPValues;
IPNR: IPNameRead;
IPNW: IPNameWrite;
Begin
txtValue.Enabled := Assigned( MyObj )
And Supports( MyObj, IPValues, IPV );
// MyObjWert: (0, 'TIObjBase')
If txtValue.Enabled
Then Begin // MyObjWert: (24, '') // WARUM ????????????
txtValue.Text := IPV.GetValue;
IPV :=
Nil;
End Else Begin
txtValue.Text := '
';
End;
txtName.Enabled := Assigned( MyObj )
And Supports( MyObj, IPNameRead, IPNR );
// EXCEPTION...
If txtName.Enabled
Then Begin
txtName.Text := IPNW.GetName;
IPNR :=
Nil;
End Else Begin
txtName.Text := '
';
End;
End;
Procedure TfrmInterfaceTest.SetMyObjValues;
Begin
// ... Soweit bin ich noch nichtmal gekommen... =(
End;
end.