TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
protected type
TComponentAsyncResult = class(TBaseAsyncResult)
private
FComponent: TComponent;
protected
procedure Schedule; override;
constructor Create(const AContext: TObject; const AComponent: TComponent);
end;
TAsyncConstArrayResult = class(TComponentASyncResult)
protected
FParams: TArray<TValue>;
constructor Create(const AContext: TObject; const AComponent: TComponent; const Params: array of const);
end;
TAsyncConstArrayProcResult = class sealed(TAsyncConstArrayResult)
private
FAsyncProcedure: TAsyncConstArrayProc;
protected
procedure AsyncDispatch; override;
constructor Create(const AAsyncProcedure: TAsyncConstArrayProc; const AContext: TObject; const AComponent: TComponent; const Params: array of const);
end;
TAsyncConstArrayFuncResult<TResult> = class sealed(TAsyncConstArrayResult)
private
FRetVal: TResult;
FAsyncFunction: TAsyncConstArrayFunc<TResult>;
protected
constructor Create(const AAsyncFunction: TAsyncConstArrayFunc<TResult>; const AContext: TObject; const AComponent: TComponent; const Params: array of const);
procedure AsyncDispatch; override;
function GetRetVal: TResult;
end;
TAsyncConstArrayProcedureResult = class sealed(TAsyncConstArrayResult)
private
FAsyncProcedure: TAsyncConstArrayProcedureEvent;
protected
procedure AsyncDispatch; override;
constructor Create(const AAsyncProcedure: TAsyncConstArrayProcedureEvent; const AContext: TObject; const AComponent: TComponent; const Params: array of const);
end;
TAsyncConstArrayFunctionResult = class sealed(TAsyncConstArrayResult)
private
FRetVal: TObject;
FAsyncFunction: TAsyncConstArrayFunctionEvent;
protected
constructor Create(const AAsyncFunction: TAsyncConstArrayFunctionEvent; const AContext: TObject; const AComponent: TComponent; const Params: array of const);
procedure AsyncDispatch; override;
function GetRetVal: TObject;
end;
TAsyncProcedureResult = class sealed(TComponentAsyncResult)
private
FAsyncProcedure: TProc;
protected
constructor Create(const AAsyncProcedure: TProc; const AContext: TObject; const AComponent: TComponent);// overload;
procedure AsyncDispatch; override;
end;
TAsyncFunctionResult<TResult> = class sealed(TComponentAsyncResult)
private
FRetVal: TResult;
FAsyncFunction: TFunc<TResult>;
protected
constructor Create(const AAsyncFunction: TFunc<TResult>; const AContext: TObject; const AComponent: TComponent);// overload;
procedure AsyncDispatch; override;
function GetRetVal: TResult;
end;
TAsyncProcedureResultEvent = class sealed(TComponentAsyncResult)
private
FAsyncProcedure: TAsyncProcedureEvent;
protected
constructor Create(const AAsyncProcedure: TAsyncProcedureEvent; const AContext: TObject; const AComponent: TComponent);// overload;
procedure AsyncDispatch; override;
end;
TAsyncFunctionResultEvent = class sealed(TComponentAsyncResult)
private
FRetVal: TObject;
FAsyncFunction: TAsyncFunctionEvent;
protected
constructor Create(const AAsyncFunction: TAsyncFunctionEvent; const AContext: TObject; const AComponent: TComponent);// overload;
procedure AsyncDispatch; override;
function GetRetVal: TObject;
end;
private
[Unsafe] FOwner: TComponent;
FName: TComponentName;
FTag: NativeInt;
FComponents: TList<TComponent>;
FFreeNotifies: TList<TComponent>;
FDesignInfo: TDesignInfo;
FComponentState: TComponentState;
FVCLComObject: Pointer;
FObservers: TObservers;
FOnGetDeltaStreams: TGetDeltaStreamsEvent;
function GetComObject: IUnknown;
function GetComponent(AIndex: Integer): TComponent;
function GetComponentCount: Integer;
function GetComponentIndex: Integer;
procedure Insert(AComponent: TComponent);
procedure ReadLeft(Reader: TReader);
procedure ReadTop(Reader: TReader);
procedure Remove(AComponent: TComponent);
procedure RemoveNotification(const AComponent: TComponent);
procedure SetComponentIndex(Value: Integer);
procedure SetReference(Enable: Boolean);
procedure WriteLeft(Writer: TWriter);
procedure WriteTop(Writer: TWriter);
{ IInterfaceComponentReference }
function IInterfaceComponentReference.GetComponent = IntfGetComponent;
function IntfGetComponent: TComponent;
procedure DoGetDeltaStreams(Proc: TGetStreamProc; var Handled: Boolean);
procedure ReadDeltaStream(const S: TStream);
procedure ReadDeltaState;
protected
FComponentStyle: TComponentStyle;
private
FSortedComponents: TList<TComponent>;
function FindSortedComponent(const AName: string; var Index: Integer): TComponent;
procedure AddSortedComponent(const AComponent: TComponent);
procedure RemoveSortedComponent(const AComponent: TComponent); inline;
private class var
FComparer: IComparer<TComponent>;
class constructor Create;
protected
/// <summary>
/// Override AsyncSchedule in descendant components in order to modify the manner in which an async method
/// call should be scheduled. By default, this will queue the method call with the main thread using
/// TThread.Queue.
/// </summary>
procedure AsyncSchedule(const ASyncResult: TBaseAsyncResult); virtual;
procedure ChangeName(const NewName: TComponentName);
procedure DefineProperties(Filer: TFiler); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
function GetChildOwner: TComponent; dynamic;
function GetChildParent: TComponent; dynamic;
function GetOwner: TPersistent; override;
procedure Loaded; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); virtual;
procedure GetDeltaStreams(Proc: TGetStreamProc); dynamic;
procedure PaletteCreated; dynamic;
procedure ReadState(Reader: TReader); virtual;
function CanObserve(const ID: Integer): Boolean; virtual;
procedure ObserverAdded(const ID: Integer; const Observer: IObserver); virtual;
function GetObservers: TObservers; virtual;
procedure SetAncestor(Value: Boolean);
procedure SetDesigning(Value: Boolean; SetChildren: Boolean = True);
procedure SetInline(Value: Boolean);
procedure SetDesignInstance(Value: Boolean);
procedure SetName(const NewName: TComponentName); virtual;
procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
procedure SetParentComponent(Value: TComponent); dynamic;
procedure Updating; dynamic;
procedure Updated; dynamic;
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual;
procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); virtual;
procedure ValidateContainer(AComponent: TComponent); dynamic;
procedure ValidateInsert(AComponent: TComponent); dynamic;
procedure WriteState(Writer: TWriter); virtual;
procedure RemoveFreeNotifications;
{ IInterface }
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
property OnGetDeltaStreams: TGetDeltaStreamsEvent read FOnGetDeltaStreams write FOnGetDeltaStreams;
public
constructor Create(AOwner: TComponent); virtual;
destructor Destroy; override;
procedure BeforeDestruction; override;
/// <summary>
/// Start an asynchronous procedure which will be execute in the context of the main thread or in the case of
/// a VCL TControl descendant, in the context of the thread on which the closest window handle was created
/// (following the parent chain). This will most likely still be on the main thread.
/// </summary>
function BeginInvoke(const AProc: TProc; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke(const AProc: TASyncProcedureEvent; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke<TResult>(const AFunc: TFunc<TResult>; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke(const AProc: TAsyncConstArrayProc; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke<TResult>(const AFunc: TAsyncConstArrayFunc<TResult>; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke(const AProc: TAsyncConstArrayProcedureEvent; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke(const AFunc: TAsyncConstArrayFunctionEvent; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload;
function BeginInvoke(const AFunc: TAsyncFunctionEvent; const AContext: TObject = nil): IAsyncResult; overload;
/// <summary>
/// Block the caller until the given IAsyncResult completes. This function will return immediately if the
/// IAsyncResult has already finished. This function will also raise any exception that may have happened while
/// the asynchronous procedure executed.
/// </summary>
procedure EndInvoke(const ASyncResult: IAsyncResult); overload;
/// <summary>
/// Block the caller until the given IAsyncResult completes. Returns the result from the asynchronously executed
/// function. This function will return immediately if the IAsyncResult has already finished. This function will
/// also raise any exception that may have happened while the asynchronous procedure executed.
/// </summary>
function EndInvoke<TResult>(const AsyncResult: IAsyncResult): TResult; overload;
/// <summary>
/// Block the caller until the given IAsyncResult completes. Returns the result from the asynchronously executed
/// function. This function will return immediately if the IAsyncResult has already finished. This function will
/// also raise any exception that may have happened while the asynchronous procedure executed.
/// </summary>
function EndFunctionInvoke(const AsyncResult: IAsyncResult): TObject;
procedure DestroyComponents;
procedure Destroying;
function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
function FindComponent(const AName: string): TComponent;
procedure FreeNotification(AComponent: TComponent);
procedure RemoveFreeNotification(AComponent: TComponent);
procedure FreeOnRelease;
function GetEnumerator: TComponentEnumerator;
function GetParentComponent: TComponent; dynamic;
function GetNamePath: string; override;
function HasParent: Boolean; dynamic;
procedure InsertComponent(const AComponent: TComponent);
procedure RemoveComponent(const AComponent: TComponent);
procedure SetSubComponent(IsSubComponent: Boolean);
function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
function UpdateAction(Action: TBasicAction): Boolean; virtual;
function IsImplementorOf(const I: IInterface): Boolean;
function ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean;
property ComObject: IUnknown read GetComObject;
property Components[Index: Integer]: TComponent read GetComponent;
property ComponentCount: Integer read GetComponentCount;
property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
property ComponentState: TComponentState read FComponentState;
property ComponentStyle: TComponentStyle read FComponentStyle;
property DesignInfo: TDesignInfo read FDesignInfo write FDesignInfo;
property Owner: TComponent read FOwner;
property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
property Observers: TObservers read GetObservers;
published
property Name: TComponentName read FName write SetName stored False;
property Tag: NativeInt read FTag write FTag default 0;
end;
