Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi interface helpers / workarounds

I realise that Delphi does not support interface helpers, but after reading several SO topics and sources of Spring4D and so forth, I'm wondering is there is any way to achieve the following? The source code comments pretty much sums up what I'm trying to do, so here it is:

program IHelper;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Spring,
  System.SysUtils;

type

  IMyThing = interface
  ['{01E799A5-9141-4C5E-AA85-B7C9792024D9}']
    procedure BasicThing;
  end;

  TMyThing = class(TInterfacedObject, IMyThing)
  strict private
    procedure BasicThing;
  end;

  IMyThingHelper = record
  private
    FOutage: IMyThing;
  public
    class operator Implicit(const Value: IMyThing): IMyThingHelper;
    procedure HelpfulThing;
  end;

  TMyThingHelper = class helper for TMyThing
  public
    class procedure ObjectThing;
  end;

{ TOutage }

procedure TMyThing.BasicThing;
begin
  Writeln('Basic Thing');
end;


{ IOutageHelper }

procedure IMyThingHelper.HelpfulThing;
begin
  Writeln('Helpful thing');
end;

class operator IMyThingHelper.Implicit(const Value: IMyThing): IMyThingHelper;
begin
  Result.FOutage := Value;
end;

{ TMyThingHelper }

class procedure TMyThingHelper.ObjectThing;
begin
  Writeln('Object thing');
end;

var
  LThing: IMyThing;

begin
  try
    LThing := TMyThing.Create;
    LThing.BasicThing;
    //LThing.HelpfulThing;               // <--- **** prefer this syntax but obviously does not compile
    IMyThingHelper(LThing).HelpfulThing; // <--- this works ok but prefer not to have to cast it here

    //LThing.ObjectThing;                // <--- obviously does not compile
    (LThing as TMyThing).ObjectThing;    // <--- class helpers work ok but no good for interfaces

    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Any ideas or suggestions on how this code could be made to work where shown with **** ? I understand the answer might be an outright "no", but it seems that there's some pretty clever workarounds being done and perhaps someone much smarter than me knows how? (Delphi XE5)

Another example

var
   dataObject: IDataObject;

//Get clipboard IDataObject
OleGetClipboard({out}dataObject);

//Check if they want us to move or copy what's on the clipboard
preferredDropEffect: DWORD := dataObject.GetPreferredDropEffect;

//...do the stuff with the clipboard

//Tell them what we did
dataObject.SetPerformedDropEffect(DROPEFFECT_NONE); //we moved the underlying data; sender need not do anything
dataObject.SetPasteSucceeded(DROPEFFECT_MOVE); //Paste complete

with a helper:

TDataObjectHelper = interface helper for IDataObject
public
   function GetPreferredDropEffect(DefaultPreferredDropEffect: DWORD=DROPEFFECT_NONE): DWORD;
end;

function TDataObjectHelper.GetPreferredDropEffect(DefaultPreferredDropEffect: DWORD=DROPEFFECT_NONE): DWORD;
begin
{
    DROPEFFECT_NONE   = 0;  //Drop target cannot accept the data.
    DROPEFFECT_COPY   = 1;  //Drop results in a copy. The original data is untouched by the drag source.
    DROPEFFECT_MOVE   = 2;  //Drag source should remove the data.
    DROPEFFECT_LINK   = 4;  //Drag source should create a link to the original data.
    DROPEFFECT_SCROLL = 0x80000000 //Scrolling is about to start or is currently occurring in the target. This value is used in addition to the other values.
}
    if TDataObjectHelper.ContainsFormat(Source, CF_PreferredDropEffect) then
        Result := TDataObjectHelper.GetUInt32(Source, CF_PREFERREDDROPEFFECT)
    else
        Result := DefaultDropEffect;
end;
like image 529
Rick Wheeler Avatar asked Jul 17 '14 01:07

Rick Wheeler


Video Answer


1 Answers

Why not just use another interface?

program IHelper;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Spring,
  System.SysUtils;

type

  IMyThing = interface
  ['{01E799A5-9141-4C5E-AA85-B7C9792024D9}']
    procedure BasicThing;
  end;

  IMyThingHelper = interface
  ['{...}']
    procedure HelpfulThing;
  end;

  TMyThing = class(TInterfacedObject, IMyThing, IMyThingHelper)
  strict private
    procedure BasicThing;
    procedure HelpfulThing;
  end;

{ TOutage }

procedure TMyThing.BasicThing;
begin
  Writeln('Basic Thing');
end;

{ IOutageHelper }

procedure TMyThing.HelpfulThing;
begin
  Writeln('Helpful thing');
end;

var
  LThing: IMyThing;
  LHelper: IMyThingHelper;
begin
  try
    LThing := TMyThing.Create;
    LThing.BasicThing;
    if Supports(LThing, IMyThingHelper, LHelper) then
      LHelper.HelpfulThing;
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
like image 64
Remy Lebeau Avatar answered Sep 27 '22 23:09

Remy Lebeau