1TComponent = class(TPersistent, IInterface, IInterfaceComponentReference) 2 protected type 3 TComponentAsyncResult = class(TBaseAsyncResult) 4 private 5 FComponent: TComponent; 6 protected 7 procedure Schedule; override; 8 constructor Create(const AContext: TObject; const AComponent: TComponent); 9 end; 10 TAsyncConstArrayResult = class(TComponentASyncResult) 11 protected 12 FParams: TArray<TValue>; 13 constructor Create(const AContext: TObject; const AComponent: TComponent; const Params: array of const); 14 end; 15 TAsyncConstArrayProcResult = class sealed(TAsyncConstArrayResult) 16 private 17 FAsyncProcedure: TAsyncConstArrayProc; 18 protected 19 procedure AsyncDispatch; override; 20 constructor Create(const AAsyncProcedure: TAsyncConstArrayProc; const AContext: TObject; const AComponent: TComponent; const Params: array of const); 21 end; 22 TAsyncConstArrayFuncResult<TResult> = class sealed(TAsyncConstArrayResult) 23 private 24 FRetVal: TResult; 25 FAsyncFunction: TAsyncConstArrayFunc<TResult>; 26 protected 27 constructor Create(const AAsyncFunction: TAsyncConstArrayFunc<TResult>; const AContext: TObject; const AComponent: TComponent; const Params: array of const); 28 procedure AsyncDispatch; override; 29 function GetRetVal: TResult; 30 end; 31 TAsyncConstArrayProcedureResult = class sealed(TAsyncConstArrayResult) 32 private 33 FAsyncProcedure: TAsyncConstArrayProcedureEvent; 34 protected 35 procedure AsyncDispatch; override; 36 constructor Create(const AAsyncProcedure: TAsyncConstArrayProcedureEvent; const AContext: TObject; const AComponent: TComponent; const Params: array of const); 37 end; 38 TAsyncConstArrayFunctionResult = class sealed(TAsyncConstArrayResult) 39 private 40 FRetVal: TObject; 41 FAsyncFunction: TAsyncConstArrayFunctionEvent; 42 protected 43 constructor Create(const AAsyncFunction: TAsyncConstArrayFunctionEvent; const AContext: TObject; const AComponent: TComponent; const Params: array of const); 44 procedure AsyncDispatch; override; 45 function GetRetVal: TObject; 46 end; 47 TAsyncProcedureResult = class sealed(TComponentAsyncResult) 48 private 49 FAsyncProcedure: TProc; 50 protected 51 constructor Create(const AAsyncProcedure: TProc; const AContext: TObject; const AComponent: TComponent);// overload; 52 procedure AsyncDispatch; override; 53 end; 54 TAsyncFunctionResult<TResult> = class sealed(TComponentAsyncResult) 55 private 56 FRetVal: TResult; 57 FAsyncFunction: TFunc<TResult>; 58 protected 59 constructor Create(const AAsyncFunction: TFunc<TResult>; const AContext: TObject; const AComponent: TComponent);// overload; 60 procedure AsyncDispatch; override; 61 function GetRetVal: TResult; 62 end; 63 TAsyncProcedureResultEvent = class sealed(TComponentAsyncResult) 64 private 65 FAsyncProcedure: TAsyncProcedureEvent; 66 protected 67 constructor Create(const AAsyncProcedure: TAsyncProcedureEvent; const AContext: TObject; const AComponent: TComponent);// overload; 68 procedure AsyncDispatch; override; 69 end; 70 TAsyncFunctionResultEvent = class sealed(TComponentAsyncResult) 71 private 72 FRetVal: TObject; 73 FAsyncFunction: TAsyncFunctionEvent; 74 protected 75 constructor Create(const AAsyncFunction: TAsyncFunctionEvent; const AContext: TObject; const AComponent: TComponent);// overload; 76 procedure AsyncDispatch; override; 77 function GetRetVal: TObject; 78 end; 79 private 80 [Unsafe] FOwner: TComponent; 81 FName: TComponentName; 82 FTag: NativeInt; 83 FComponents: TList<TComponent>; 84 FFreeNotifies: TList<TComponent>; 85 86 FDesignInfo: TDesignInfo; 87 FComponentState: TComponentState; 88 FVCLComObject: Pointer; 89 FObservers: TObservers; 90 FOnGetDeltaStreams: TGetDeltaStreamsEvent; 91 function GetComObject: IUnknown; 92 function GetComponent(AIndex: Integer): TComponent; 93 function GetComponentCount: Integer; 94 function GetComponentIndex: Integer; 95 procedure Insert(AComponent: TComponent); 96 procedure ReadLeft(Reader: TReader); 97 procedure ReadTop(Reader: TReader); 98 procedure Remove(AComponent: TComponent); 99 procedure RemoveNotification(const AComponent: TComponent); 100 procedure SetComponentIndex(Value: Integer); 101 procedure SetReference(Enable: Boolean); 102 procedure WriteLeft(Writer: TWriter); 103 procedure WriteTop(Writer: TWriter); 104 { IInterfaceComponentReference } 105 function IInterfaceComponentReference.GetComponent = IntfGetComponent; 106 function IntfGetComponent: TComponent; 107 procedure DoGetDeltaStreams(Proc: TGetStreamProc; var Handled: Boolean); 108 procedure ReadDeltaStream(const S: TStream); 109 procedure ReadDeltaState; 110 protected 111 FComponentStyle: TComponentStyle; 112 private 113 FSortedComponents: TList<TComponent>; 114 function FindSortedComponent(const AName: string; var Index: Integer): TComponent; 115 procedure AddSortedComponent(const AComponent: TComponent); 116 procedure RemoveSortedComponent(const AComponent: TComponent); inline; 117 private class var 118 FComparer: IComparer<TComponent>; 119 class constructor Create; 120 protected 121 /// <summary> 122 /// Override AsyncSchedule in descendant components in order to modify the manner in which an async method 123 /// call should be scheduled. By default, this will queue the method call with the main thread using 124 /// TThread.Queue. 125 /// </summary> 126 procedure AsyncSchedule(const ASyncResult: TBaseAsyncResult); virtual; 127 procedure ChangeName(const NewName: TComponentName); 128 procedure DefineProperties(Filer: TFiler); override; 129 procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic; 130 function GetChildOwner: TComponent; dynamic; 131 function GetChildParent: TComponent; dynamic; 132 function GetOwner: TPersistent; override; 133 procedure Loaded; virtual; 134 procedure Notification(AComponent: TComponent; Operation: TOperation); virtual; 135 procedure GetDeltaStreams(Proc: TGetStreamProc); dynamic; 136 procedure PaletteCreated; dynamic; 137 procedure ReadState(Reader: TReader); virtual; 138 function CanObserve(const ID: Integer): Boolean; virtual; 139 procedure ObserverAdded(const ID: Integer; const Observer: IObserver); virtual; 140 function GetObservers: TObservers; virtual; 141 procedure SetAncestor(Value: Boolean); 142 procedure SetDesigning(Value: Boolean; SetChildren: Boolean = True); 143 procedure SetInline(Value: Boolean); 144 procedure SetDesignInstance(Value: Boolean); 145 procedure SetName(const NewName: TComponentName); virtual; 146 procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic; 147 procedure SetParentComponent(Value: TComponent); dynamic; 148 procedure Updating; dynamic; 149 procedure Updated; dynamic; 150 class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual; 151 procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); virtual; 152 procedure ValidateContainer(AComponent: TComponent); dynamic; 153 procedure ValidateInsert(AComponent: TComponent); dynamic; 154 procedure WriteState(Writer: TWriter); virtual; 155 procedure RemoveFreeNotifications; 156 { IInterface } 157 function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; 158 function _AddRef: Integer; stdcall; 159 function _Release: Integer; stdcall; 160 { IDispatch } 161 function GetTypeInfoCount(out Count: Integer): HResult; stdcall; 162 function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; 163 function GetIDsOfNames(const IID: TGUID; Names: Pointer; 164 NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; 165 function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; 166 Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; 167 property OnGetDeltaStreams: TGetDeltaStreamsEvent read FOnGetDeltaStreams write FOnGetDeltaStreams; 168 public 169 constructor Create(AOwner: TComponent); virtual; 170 destructor Destroy; override; 171 procedure BeforeDestruction; override; 172 /// <summary> 173 /// Start an asynchronous procedure which will be execute in the context of the main thread or in the case of 174 /// a VCL TControl descendant, in the context of the thread on which the closest window handle was created 175 /// (following the parent chain). This will most likely still be on the main thread. 176 /// </summary> 177 function BeginInvoke(const AProc: TProc; const AContext: TObject = nil): IAsyncResult; overload; 178 function BeginInvoke(const AProc: TASyncProcedureEvent; const AContext: TObject = nil): IAsyncResult; overload; 179 function BeginInvoke<TResult>(const AFunc: TFunc<TResult>; const AContext: TObject = nil): IAsyncResult; overload; 180 function BeginInvoke(const AProc: TAsyncConstArrayProc; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload; 181 function BeginInvoke<TResult>(const AFunc: TAsyncConstArrayFunc<TResult>; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload; 182 function BeginInvoke(const AProc: TAsyncConstArrayProcedureEvent; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload; 183 function BeginInvoke(const AFunc: TAsyncConstArrayFunctionEvent; const Params: array of const; const AContext: TObject = nil): IAsyncResult; overload; 184 function BeginInvoke(const AFunc: TAsyncFunctionEvent; const AContext: TObject = nil): IAsyncResult; overload; 185 /// <summary> 186 /// Block the caller until the given IAsyncResult completes. This function will return immediately if the 187 /// IAsyncResult has already finished. This function will also raise any exception that may have happened while 188 /// the asynchronous procedure executed. 189 /// </summary> 190 procedure EndInvoke(const ASyncResult: IAsyncResult); overload; 191 /// <summary> 192 /// Block the caller until the given IAsyncResult completes. Returns the result from the asynchronously executed 193 /// function. This function will return immediately if the IAsyncResult has already finished. This function will 194 /// also raise any exception that may have happened while the asynchronous procedure executed. 195 /// </summary> 196 function EndInvoke<TResult>(const AsyncResult: IAsyncResult): TResult; overload; 197 /// <summary> 198 /// Block the caller until the given IAsyncResult completes. Returns the result from the asynchronously executed 199 /// function. This function will return immediately if the IAsyncResult has already finished. This function will 200 /// also raise any exception that may have happened while the asynchronous procedure executed. 201 /// </summary> 202 function EndFunctionInvoke(const AsyncResult: IAsyncResult): TObject; 203 procedure DestroyComponents; 204 procedure Destroying; 205 function ExecuteAction(Action: TBasicAction): Boolean; dynamic; 206 function FindComponent(const AName: string): TComponent; 207 procedure FreeNotification(AComponent: TComponent); 208 procedure RemoveFreeNotification(AComponent: TComponent); 209 procedure FreeOnRelease; 210 function GetEnumerator: TComponentEnumerator; 211 function GetParentComponent: TComponent; dynamic; 212 function GetNamePath: string; override; 213 function HasParent: Boolean; dynamic; 214 procedure InsertComponent(const AComponent: TComponent); 215 procedure RemoveComponent(const AComponent: TComponent); 216 procedure SetSubComponent(IsSubComponent: Boolean); 217 function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override; 218 function UpdateAction(Action: TBasicAction): Boolean; virtual; 219 function IsImplementorOf(const I: IInterface): Boolean; 220 function ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean; 221 property ComObject: IUnknown read GetComObject; 222 property Components[Index: Integer]: TComponent read GetComponent; 223 property ComponentCount: Integer read GetComponentCount; 224 property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex; 225 property ComponentState: TComponentState read FComponentState; 226 property ComponentStyle: TComponentStyle read FComponentStyle; 227 property DesignInfo: TDesignInfo read FDesignInfo write FDesignInfo; 228 property Owner: TComponent read FOwner; 229 property VCLComObject: Pointer read FVCLComObject write FVCLComObject; 230 property Observers: TObservers read GetObservers; 231 published 232 property Name: TComponentName read FName write SetName stored False; 233 property Tag: NativeInt read FTag write FTag default 0; 234 end;
