ActiveX Inheritance

[Glenn9999]

One final set of questions I seem to have regarding this ActiveX interface - more of a concept one.

1) I have a couple of callback interfaces coded. I eventually figured out that I could use them in the code by:

TMyCallBack = class(TInterfacedObject, IMyCallBack)
  function Invoke bla bla bla

var
  MyCallBack: IMyCallBack;

begin
  MyCallBack := TMyCallBack.Create;
  callfunc(mycallback);
end;

This is how I ended up getting it to work, but:
a) Is using "IMyCallBack" appropriate or is there some other way to make this work right?
b) I couldn't figure out how to "free" this and didn't see a method to do that on the code suggestion feature. Should I and how?

2) Then my major problem is that I need to have these call backs access variables and methods of the original calling class (the thing that calls "Callfunc" if you go by the above example). But as I have them coded right now, they know nothing of these variables and methods.

So I'm guessing I probably have to combine them? e.g.

  MyBaseClass = class(TComponent, TMyCallBack)

and then have an alias pointing an invoke function to IMyCallBack.Invoke?

Or is there some other way to have these callback interfaces be able to "see" the original class items?

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[whosrdaddy]

a) looks ok to me
b) this is an interface, when the variable goes out of scope (ie is no longer used), the interface will call _release which will free the object, so you don't have to do anything. You can "force" free by doing MyCallback := nil;

2) I would use the Owner pattern in this case. Add an Owner TWhateverObject to your callback function and inject it via the constructor.

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[Glenn9999]

2) I would use the Owner pattern in this case. Add an Owner TWhateverObject to your callback function and inject it via the constructor.

Wouldn't that make it incompatible with an IUnknown interface - in that sense I wouldn't want it to look like IDispatch necessarily? I'm not sure I'm understanding you here, and searching "Owner" in the help and source files isn't bringing any enlightenment. You're saying instead of TCallback.Create, I want TCallBack.Create(Self) as a call?

Another question: How would this all play out in adding some corresponding TThread objects to some of these calls?

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[whosrdaddy]

TCallBack.Create(Self)

yes that would be a start.

Another question: How would this all play out in adding some corresponding TThread objects to some of these calls?

difficult question to answer without seeing the "bigger picture".

Here's a unit I wrote several years ago to add a worker thread to my applications:

unit u_class_backgroundthread;

interface

uses
  // own units
  u_class_debugger, u_class_sqlinterface,
  // delphi units
  Windows, Classes, SysUtils, Contnrs,SyncObjs;

type
  // Helper class to make TObjectQueue thread safe
  TSafeObjectQueue = class(TObject)
  private
    ObjectQueue : TObjectQueue;
    FSection    : TRTLCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    function Push(AObject: TObject): TObject;
    function Pop: TObject;
    function Peek: TObject;
    function Count : Integer;
  end;

  TObjectProc = procedure of object;
  // class to define work objects, these will do work that does not need interaction with the main thread
  TWorkObject = class(TObject)
  private
//    FWorkType      : TWorkType;
    FWorkData      : string;
    FNotifyEvent   : TNotifyEvent;
    FExecutionTime : TDateTime;
    FObject        : TObject;
    FObjectProc    : TObjectProc;
  public
    constructor Create(AObject : TObject; WorkData : string; ExecutionTime : TDateTime); overload;
    constructor Create(AObject : TObject; WorkData : string); overload;
    constructor Create(AObjectProc : TObjectProc); overload;
    constructor Create(AObjectProc : TObjectProc; ExecutionTime : TDateTime); overload;
  published
    property WorkObject : TObject read FObject write FObject;
    property WorkCode : TObjectProc read FObjectProc write FObjectProc;
    property WorkData : string read FWorkData write FWorkData;
    property OnWorkDone : TNotifyEvent read FNotifyEvent write FNotifyEvent;
    property ExecutionTime : TDateTime read FExecutionTime write FExecutionTime;
  end;

  // workobject do to sql updates in background
  TSQLWorkObject = class(TWorkObject)
    FActivateSQL  : Boolean;
  private
    function GetSQLInterface: TSQLInterface;
  published
  public
    property SQLInterface : TSQLInterface read GetSQLInterface;
    constructor Create(SQLInterface : TSQLInterface; SQLQuery : string; Activate : Boolean); overload;
  end;

  // workobject do execute object methods in background
  // method must be threadsafe!!! (so no UI)
  TMethodWorkObject = class(TWorkObject)
  public
    constructor Create(const WorkMethod : TObjectProc; WorkNotify : TNotifyEvent); overload;
    constructor Create(const WorkMethod : TObjectProc; WorkNotify : TNotifyEvent; ExecutionTime : TDateTime); overload;
  end;

  TNotifyObject = class(TObject)
    NotifyEvent : TNotifyEvent;
  end;

  TBackgroundThread = class(TThread)
  private
    Debug               : TDebuggerSlot;
    FSection            : TRTLCriticalSection;
    FSpeed              : Integer;
    NotifyObjects       : TSafeObjectQueue;
    WorkObjects         : TSafeObjectQueue;
    procedure Output(Routine: string; Str : string);
    procedure SyncNotify;
    procedure DoNotify;
    procedure DoWork;
    procedure DoWorkSQLUpdate(WorkObject : TSQLWorkObject);
    procedure DoWorkMethod(WorkObject : TMethodWorkObject);
    procedure FreeWorkObjects;
    procedure FreeNotifyObjects;
  protected
    procedure Execute; override;
  public
    ThreadDone : THandle;
    constructor CreateMe(ADebug : TDebuggerSlot; Speed : Integer);
    destructor Destroy; override;
    procedure AddWork(WorkObject : TWorkObject);
    procedure AddNotify(NotifyEvent : TNotifyEvent);
  end;

implementation

{ TSafeObjectQueue }

function TSafeObjectQueue.Count: Integer;
begin
 EnterCriticalSection(FSection);
 try
  Result := ObjectQueue.Count;
 finally
  LeaveCriticalSection(FSection);
 end;
end;

function TSafeObjectQueue.Peek: TObject;
begin
 EnterCriticalSection(FSection);
 try
  Result := ObjectQueue.Peek;
 finally
  LeaveCriticalSection(FSection);
 end;
end;

function TSafeObjectQueue.Pop: TObject;
begin
 EnterCriticalSection(FSection);
 try
  Result := ObjectQueue.Pop;
 finally
  LeaveCriticalSection(FSection);
 end;
end;

function TSafeObjectQueue.Push(AObject: TObject): TObject;
begin
 EnterCriticalSection(FSection);
 try
  Result := ObjectQueue.Push(AObject);
 finally
  LeaveCriticalSection(FSection);
 end;
end;

constructor TSafeObjectQueue.Create;
begin
 FillChar(FSection, SizeOf(FSection), 0);
 InitializeCriticalSection(FSection);
 ObjectQueue := TObjectQueue.Create;
end;

destructor TSafeObjectQueue.Destroy;
begin
 FreeAndNil(ObjectQueue);
 DeleteCriticalSection(FSection);
 inherited;
end;

{ TWorkObject }

constructor TWorkObject.Create(AObject : TObject; WorkData: string; ExecutionTime : TDateTime);
begin
 FWorkData := WorkData;
// FWorkType := WorkType;
 FExecutionTime := ExecutionTime;
 FObject := AObject;
end;

constructor TWorkObject.Create(AObject : TObject; WorkData: string);
begin
 Create(AObject, WorkData, 0);
end;

constructor TWorkObject.Create(AObjectProc: TObjectProc);
begin
 Create(nil, '');
 FObjectProc := AObjectProc;
end;

constructor TWorkObject.Create(AObjectProc: TObjectProc; ExecutionTime: TDateTime);
begin
 Create(nil, '', ExecutionTime);
 FObjectProc := AObjectProc;
end;

{ TSQLWorkObject }

constructor TSQLWorkObject.Create(SQLInterface: TSQLInterface; SQLQuery: string; Activate: Boolean);
begin
 FActivateSQL := Activate;
 Create(SQLInterface, SQLQuery, 0);
end;

function TSQLWorkObject.GetSQLInterface: TSQLInterface;
begin
 Result := TSQLInterface(WorkObject);
end;

{ TMethodWorkObject }

constructor TMethodWorkObject.Create(const WorkMethod: TObjectProc; WorkNotify: TNotifyEvent);
begin
 Create(WorkMethod);
 Self.OnWorkDone := WorkNotify;
end;

constructor TMethodWorkObject.Create(const WorkMethod: TObjectProc; WorkNotify: TNotifyEvent; ExecutionTime: TDateTime);
begin
 Create(WorkMethod, ExecutionTime);
 Self.OnWorkDone := WorkNotify;
end;

{ TBackgroundThread }

procedure TBackgroundThread.Output(Routine: string; Str: string);
begin
 if Assigned(Debug) then
  Debug.Output(Self, Routine, Str);
end;

procedure TBackgroundThread.DoWorkSQLUpdate(WorkObject: TSQLWorkObject);
begin
 // execute sql update (current thread context)
 try
  if WorkObject.FActivateSQL then
   WorkObject.SQLInterface.Active := True;
  Debug.OutputL(Self, 'DoWorkSQLUpdate', Format('Executing SQL query "%s"', [WorkObject.WorkData]), LVL_FULL);
  WorkObject.SQLInterface.UpdateQuery(WorkObject.WorkData);
 finally
  if WorkObject.FActivateSQL then
   WorkObject.SQLInterface.Active := False;
 end;
 // inform caller (main thread context)
 if Assigned(WorkObject.OnWorkDone) then
  AddNotify(WorkObject.OnWorkDone);
end;

procedure TBackgroundThread.DoWorkMethod(WorkObject: TMethodWorkObject);
begin
 // execute method (current thread context)
 WorkObject.FObjectProc;
 // inform caller (main thread context)
 if Assigned(WorkObject.OnWorkDone) then
  AddNotify(WorkObject.OnWorkDone);
end;

procedure TBackgroundThread.SyncNotify;
begin
 // execute notifyevent (main thread context)
 if NotifyObjects.Count > 0 then
  Synchronize(DoNotify);
end;

procedure TBackgroundThread.DoNotify;

var NotifyObject : TNotifyObject;


begin
 if NotifyObjects.Count > 0 then
  begin
   if Terminated then Exit;
   NotifyObject := TNotifyObject(NotifyObjects.Pop);
   try
    NotifyObject.NotifyEvent(nil);
   except
    on E: Exception do
     Debug.ExceptionOutput(Self, 'DoNotify', E);
   end;
   FreeAndNil(NotifyObject);
  end;
end;

procedure TBackgroundThread.DoWork;

var WorkObject : TWorkObject;

begin
 // all objects are arranged as a FIFO
 if WorkObjects.Count > 0 then
  begin
   if Terminated then Exit;
   WorkObject := TWorkObject(WorkObjects.Pop);
   if WorkObject.ExecutionTime > 0 then
    begin
     // it is no time yet to execute this object, put it back as last object
     if WorkObject.ExecutionTime > Now then
      begin
       WorkObjects.Push(WorkObject);
       Exit;
      end;
    end;
   try
    if WorkObject is TSQLWorkObject then
     DoWorkSQLUpdate(TSQLWorkObject(WorkObject)) else
    if WorkObject is TMethodWorkObject then
     DoWorkMethod(TMethodWorkObject(WorkObject));
   except
    on E: Exception do
     Debug.ExceptionOutput(Self, 'DoWork', E);
   end;
   FreeAndNil(WorkObject);
  end;
end;

procedure TBackgroundThread.FreeNotifyObjects;

var NotifyObject : TNotifyObject;

begin
 while NotifyObjects.Count > 0 do begin
  NotifyObject := TNotifyObject(NotifyObjects.Pop);
  FreeAndNil(NotifyObject);
 end;
 FreeAndNil(NotifyObjects);
end;

procedure TBackgroundThread.FreeWorkObjects;

var WorkObject : TWorkObject;

begin
 while WorkObjects.Count > 0 do begin
  WorkObject := TWorkObject(WorkObjects.Pop);
  FreeAndNil(WorkObject);
 end;
 FreeAndNil(WorkObjects);
end;

procedure TBackgroundThread.AddNotify(NotifyEvent: TNotifyEvent);

var NotifyObject : TNotifyObject;

begin
 if Assigned(NotifyEvent) then
  begin
   NotifyObject := TNotifyObject.Create;
   NotifyObject.NotifyEvent := NotifyEvent;
   NotifyObjects.Push(NotifyObject);
  end;
end;

procedure TBackgroundThread.AddWork(WorkObject: TWorkObject);
begin
 WorkObjects.Push(WorkObject);
end;

// main thread loop
procedure TBackgroundThread.Execute;
begin
 Output('Execute', 'Start of thread execution');
 while not Terminated do
  begin
   Sleep(FSpeed);
   DoWork;
   SyncNotify;
  end;
 Output('Execute', 'End of thread execution');
 SetEvent(ThreadDone);
end;

constructor TBackgroundThread.CreateMe(ADebug : TDebuggerSlot; Speed : Integer);
begin
 Create(True);
 FreeOnTerminate := False;
 // create objects
 Debug := ADebug;
 FSpeed := Speed;
 ThreadDone := CreateEvent(nil, True, False, nil);
 Output('Create','creating objects');
 FillChar(FSection, SizeOf(FSection), 0);
 InitializeCriticalSection(FSection);
 NotifyObjects := TSafeObjectQueue.Create;
 WorkObjects := TSafeObjectQueue.Create;
 Output('Create','create complete');
end;

destructor TBackgroundThread.Destroy;
begin
 // destroy objects
 Output('Destroy','destroying objects');
 FreeWorkObjects;
 FreeNotifyObjects;
 DeleteCriticalSection(FSection);
 CloseHandle(ThreadDone);
 Output('Destroy','destroy complete');
 inherited;
end;

end.

since then I converted to OTL threading library
and I starting to look at DPL (Embarcadero's own library).

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!