学步园

TComponent is the common ancestor of all component classes.

Classes

TComponent is the base class for all components. TComponent implements the following features:

Components are persistent objects that have the following capabilities:

IDE integration. The ability to appear on an IDE palette and be manipulated in a form designer.
 Ownership. The ability to manage other components. If component A owns component B, then A is responsible for destroying B when A is destroyed.
 Streaming and filing. Enhancements of the persistence features inherited from TPersistent.
 COM support. Components can be converted into ActiveX controls or other COM objects using wizards provided with Windows products. Components can serve as wrappers for COM objects.

COM features are present in all implementations of TComponent, including those provided with Linux development tools. However, these features are only useful in Windows applications, and are marked in this documentation as "Windows only". Do not use these features in cross-platform applications.

TComponent does not provide any user interface or display features. These features are provided by two classes that directly descend from TComponent.

TControl, in the QControls unit, is the base class for "visual" components in cross-platform applications.

TControl, in the Controls unit, is the base class for "visual" components in Windows-only applications.

The Controls unit and other Windows-specific units are not provided with Linux development tools.

Components that can be visible at runtime are sometimes called "visual components". Other components, which are never visible at runtime, are sometimes called "non-visual components". However it is more common to refer to "visual components" as "controls" and "non-visual components" simply as "components."

Do not create instances of TComponent. Use TComponent as a base class when declaring non-visual components that can appear on the component palette and be used in the form designer. Properties and methods of TComponent provide basic behavior that descendant classes inherit as well as behavior that components can override to customize their behavior.

1. TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
2.   private
3.     FOwner: TComponent;            //所属
4.     FName: TComponentName; 
5.     FTag: Longint;
6.     FComponents: TList;
7.     FFreeNotifies: TList;
8.     FDesignInfo: Longint;
9.     FComponentState: TComponentState;
11.     FVCLComObject: Pointer;
12.     function GetComObject: IUnknown;
14.     function GetComponent(AIndex: Integer): TComponent;
15.     function GetComponentCount: Integer;
16.     function GetComponentIndex: Integer;
17.     procedure Insert(AComponent: TComponent);
18.     procedure ReadLeft(Reader: TReader);
19.     procedure ReadTop(Reader: TReader);
20.     procedure Remove(AComponent: TComponent);
21.     procedure RemoveNotification(AComponent: TComponent);
22.     procedure SetComponentIndex(Value: Integer);
23.     procedure SetReference(Enable: Boolean);
24.     procedure WriteLeft(Writer: TWriter);
25.     procedure WriteTop(Writer: TWriter);
26.     { IInterfaceComponentReference }
27.     function IInterfaceComponentReference.GetComponent = IntfGetComponent;
28.     function IntfGetComponent: TComponent;
29.   protected
30.     FComponentStyle: TComponentStyle;
31.     procedure ChangeName(const NewName: TComponentName);
32.     procedure DefineProperties(Filer: TFiler); override;
33.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
34.     function GetChildOwner: TComponent; dynamic;
35.     function GetChildParent: TComponent; dynamic;
36.     function GetOwner: TPersistent; override;
37.     procedure Loaded; virtual;
38.     procedure Notification(AComponent: TComponent;
39.       Operation: TOperation); virtual;                  //发送消息
40.     procedure PaletteCreated; dynamic;
41.     procedure ReadState(Reader: TReader); virtual;
42.     procedure SetAncestor(Value: Boolean);
43.     procedure SetDesigning(Value: Boolean; SetChildren: Boolean = True);
44.     procedure SetInline(Value: Boolean);
45.     procedure SetDesignInstance(Value: Boolean);
46.     procedure SetName(const NewName: TComponentName); virtual;
47.     procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
48.     procedure SetParentComponent(Value: TComponent); dynamic;
49.     procedure Updating; dynamic;
50.     procedure Updated; dynamic;
51.     class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual;
52.     procedure ValidateRename(AComponent: TComponent;
53.       const CurName, NewName: string); virtual;    //确定是否有重名组件存在
54.     procedure ValidateContainer(AComponent: TComponent); dynamic;
55.     procedure ValidateInsert(AComponent: TComponent); dynamic;
56.     procedure WriteState(Writer: TWriter); virtual;
57.     { IInterface }
58.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
59.     function _AddRef: Integer; stdcall;
60.     function _Release: Integer; stdcall;
62.     { IDispatch }
63.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
64.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
65.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
66.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
67.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
68.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
70.   public
71.     constructor Create(AOwner: TComponent); virtual;
72.     destructor Destroy; override;
73.     procedure BeforeDestruction; override;
74.     procedure DestroyComponents;
75.     procedure Destroying;
76.     function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
77.     function FindComponent(const AName: string): TComponent;
78.     procedure FreeNotification(AComponent: TComponent);
79.     procedure RemoveFreeNotification(AComponent: TComponent);
81.     procedure FreeOnRelease;
83.     function GetParentComponent: TComponent; dynamic;
84.     function GetNamePath: string; override;
85.     function HasParent: Boolean; dynamic;
86.     procedure InsertComponent(AComponent: TComponent);
87.     procedure RemoveComponent(AComponent: TComponent);
88.     procedure SetSubComponent(IsSubComponent: Boolean);
89.     function SafeCallException(ExceptObject: TObject;
90.       ExceptAddr: Pointer): HResult; override;
91.     function UpdateAction(Action: TBasicAction): Boolean; dynamic;
92.     function IsImplementorOf(const I: IInterface): Boolean;
93.     function ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean;
95.     property ComObject: IUnknown read GetComObject;
97.     property Components[Index: Integer]: TComponent read GetComponent;
98.     property ComponentCount: Integer read GetComponentCount;
99.     property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
100.     property ComponentState: TComponentState read FComponentState;
101.     property ComponentStyle: TComponentStyle read FComponentStyle;
102.     property DesignInfo: Longint read FDesignInfo write FDesignInfo;
103.     property Owner: TComponent read FOwner;
105.     property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
107.   published
108.     property Name: TComponentName read FName write SetName stored False;
109.     property Tag: Longint read FTag write FTag default 0;
110.   end;
113. { TComponent }
115. constructor TComponent.Create(AOwner: TComponent);
116. begin
117.   FComponentStyle := [csInheritable];
118.   if AOwner <> nil then AOwner.InsertComponent(Self);    //新增
119. end;
121. destructor TComponent.Destroy;
122. begin
123.   Destroying;
124.   if FFreeNotifies <> nil then
125.   begin
126.     while Assigned(FFreeNotifies) and (FFreeNotifies.Count > 0) do
127.       TComponent(FFreeNotifies[FFreeNotifies.Count - 1]).Notification(Self, opRemove);
128.     FreeAndNil(FFreeNotifies);
129.   end;
130.   DestroyComponents;
131.   if FOwner <> nil then FOwner.RemoveComponent(Self);
132.   inherited Destroy;
133. end;
135. procedure TComponent.BeforeDestruction;
136. begin
137.   if not (csDestroying in ComponentState) then
138.     Destroying;
139. end;
141. procedure TComponent.FreeNotification(AComponent: TComponent);
142. begin
143.   if (Owner = nil) or (AComponent.Owner <> Owner) then
144.   begin
145.     // Never acquire a reference to a component that is being deleted.
146.     assert(not (csDestroying in (ComponentState + AComponent.ComponentState)));
147.     if not Assigned(FFreeNotifies) then FFreeNotifies := TList.Create;
148.     if FFreeNotifies.IndexOf(AComponent) < 0 then
149.     begin
150.       FFreeNotifies.Add(AComponent);
151.       AComponent.FreeNotification(Self);
152.     end;
153.   end;
154.   Include(FComponentState, csFreeNotification);
155. end;
157. procedure TComponent.ReadLeft(Reader: TReader);
158. begin
159.   LongRec(FDesignInfo).Lo := Reader.ReadInteger;
160. end;
162. procedure TComponent.ReadTop(Reader: TReader);
163. begin
164.   LongRec(FDesignInfo).Hi := Reader.ReadInteger;
165. end;
167. procedure TComponent.WriteLeft(Writer: TWriter);
168. begin
169.   Writer.WriteInteger(LongRec(FDesignInfo).Lo);
170. end;
172. procedure TComponent.WriteTop(Writer: TWriter);
173. begin
174.   Writer.WriteInteger(LongRec(FDesignInfo).Hi);
175. end;
177. procedure TComponent.Insert(AComponent: TComponent);
178. begin
179.   if FComponents = nil then FComponents := TList.Create;
180.   FComponents.Add(AComponent);
181.   AComponent.FOwner := Self;
182. end;
184. procedure TComponent.Remove(AComponent: TComponent);
185. begin
186.   AComponent.FOwner := nil;
187.   FComponents.Remove(AComponent);
188.   if FComponents.Count = 0 then
189.   begin
190.     FComponents.Free;
191.     FComponents := nil;
192.   end;
193. end;
195. procedure TComponent.InsertComponent(AComponent: TComponent);
196. begin
197.   AComponent.ValidateContainer(Self);
198.   ValidateRename(AComponent, '', AComponent.FName);
199.   Insert(AComponent);
200.   AComponent.SetReference(True);
201.   if csDesigning in ComponentState then
202.     AComponent.SetDesigning(True);
203.   Notification(AComponent, opInsert);  //发送消息
204. end;
206. procedure TComponent.RemoveComponent(AComponent: TComponent);
207. begin
208.   ValidateRename(AComponent, AComponent.FName, '');
209.   Notification(AComponent, opRemove);
210.   AComponent.SetReference(False);
211.   Remove(AComponent);
212. end;
214. procedure TComponent.DestroyComponents;
215. var
216.   Instance: TComponent;
217. begin
218.   while FComponents <> nil do
219.   begin
220.     Instance := FComponents.Last;
221.     if (csFreeNotification in Instance.FComponentState)
222.       or (FComponentState * [csDesigning, csInline] = [csDesigning, csInline]) then
223.       RemoveComponent(Instance)
224.     else
225.       Remove(Instance);
226.     Instance.Destroy;
227.   end;
228. end;
230. procedure TComponent.Destroying;
231. var
232.   I: Integer;
233. begin
234.   if not (csDestroying in FComponentState) then
235.   begin
236.     Include(FComponentState, csDestroying);
237.     if FComponents <> nil then
238.       for I := 0 to FComponents.Count - 1 do
239.         TComponent(FComponents[I]).Destroying;
240.   end;
241. end;
243. procedure TComponent.RemoveNotification(AComponent: TComponent);
244. begin
245.   if FFreeNotifies <> nil then
246.   begin
247.     FFreeNotifies.Remove(AComponent);
248.     if FFreeNotifies.Count = 0 then
249.     begin
250.       FFreeNotifies.Free;
251.       FFreeNotifies := nil;
252.     end;
253.   end;
254. end;
256. procedure TComponent.RemoveFreeNotification(AComponent: TComponent);
257. begin
258.   RemoveNotification(AComponent);
259.   AComponent.RemoveNotification(Self);
260. end;
262. procedure TComponent.Notification(AComponent: TComponent;
263.   Operation: TOperation);
264. var
265.   I: Integer;
266. begin
267.   if (Operation = opRemove) and (AComponent <> nil) then
268.     RemoveFreeNotification(AComponent);
269.   if FComponents <> nil then
270.   begin
271.     I := FComponents.Count - 1;
272.     while I >= 0 do
273.     begin
274.       TComponent(FComponents[I]).Notification(AComponent, Operation);
275.       Dec(I);
276.       if I >= FComponents.Count then
277.         I := FComponents.Count - 1;
278.     end;
279.   end;
280. end;
282. procedure TComponent.DefineProperties(Filer: TFiler);
283. var
284.   Ancestor: TComponent;
285.   Info: Longint;
286. begin
287.   Info := 0;
288.   Ancestor := TComponent(Filer.Ancestor);
289.   if Ancestor <> nil then Info := Ancestor.FDesignInfo;
290.   Filer.DefineProperty('Left', ReadLeft, WriteLeft,
291.     LongRec(FDesignInfo).Lo <> LongRec(Info).Lo);
292.   Filer.DefineProperty('Top', ReadTop, WriteTop,
293.     LongRec(FDesignInfo).Hi <> LongRec(Info).Hi);
294. end;
296. function TComponent.HasParent: Boolean;
297. begin
298.   Result := False;
299. end;
301. procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
302. begin
303. end;
305. function TComponent.GetChildOwner: TComponent;
306. begin
307.   Result := nil;
308. end;
310. function TComponent.GetChildParent: TComponent;
311. begin
312.   Result := Self;
313. end;
315. function TComponent.GetNamePath: string;
316. begin
317.   Result := FName;
318. end;
320. function TComponent.GetOwner: TPersistent;
321. begin
322.   Result := FOwner;
323. end;
325. procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer);
326. begin
327. end;
329. function TComponent.GetParentComponent: TComponent;
330. begin
331.   Result := nil;
332. end;
334. procedure TComponent.SetParentComponent(Value: TComponent);
335. begin
336. end;
338. procedure TComponent.Updating;
339. begin
340.   Include(FComponentState, csUpdating);
341. end;
343. procedure TComponent.Updated;
344. begin
345.   Exclude(FComponentState, csUpdating);
346. end;
348. procedure TComponent.Loaded;
349. begin
350.   Exclude(FComponentState, csLoading);
351. end;
353. procedure TComponent.PaletteCreated;
354. begin
355.   // Notification
356. end;
358. procedure TComponent.ReadState(Reader: TReader);
359. begin
360.   Reader.ReadData(Self);
361. end;
363. procedure TComponent.WriteState(Writer: TWriter);
364. begin
365.   Writer.WriteData(Self);
366. end;
368. procedure TComponent.ValidateRename(AComponent: TComponent;
369.   const CurName, NewName: string);
370. begin
371.   if (AComponent <> nil) and not SameText(CurName, NewName) and
372.     (AComponent.Owner = Self) and (FindComponent(NewName) <> nil) then
373.     raise EComponentError.CreateResFmt(@SDuplicateName, [NewName]);
374.   if (csDesigning in ComponentState) and (Owner <> nil) then
375.     Owner.ValidateRename(AComponent, CurName, NewName);
376. end;
378. procedure TComponent.ValidateContainer(AComponent: TComponent);
379. begin
380.   AComponent.ValidateInsert(Self);
381. end;
383. procedure TComponent.ValidateInsert(AComponent: TComponent);
384. begin
385. end;
387. function TComponent.FindComponent(const AName: string): TComponent;
388. var
389.   I: Integer;
390. begin
391.   if (AName <> '') and (FComponents <> nil) then
392.     for I := 0 to FComponents.Count - 1 do
393.     begin
394.       Result := FComponents[I];
395.       if SameText(Result.FName, AName) then Exit;
396.     end;
397.   Result := nil;
398. end;
400. procedure TComponent.SetName(const NewName: TComponentName);
401. begin
402.   if FName <> NewName then
403.   begin
404.     if (NewName <> '') and not IsValidIdent(NewName) then
405.       raise EComponentError.CreateResFmt(@SInvalidName, [NewName]);
406.     if FOwner <> nil then
407.       FOwner.ValidateRename(Self, FName, NewName) else
408.       ValidateRename(nil, FName, NewName);
409.     SetReference(False);
410.     ChangeName(NewName);
411.     SetReference(True);
412.   end;
413. end;
415. procedure TComponent.ChangeName(const NewName: TComponentName);
416. begin
417.   FName := NewName;
418. end;
420. function TComponent.GetComponentIndex: Integer;
421. begin
422.   if (FOwner <> nil) and (FOwner.FComponents <> nil) then
423.     Result := FOwner.FComponents.IndexOf(Self) else
424.     Result := -1;
425. end;
427. function TComponent.GetComponent(AIndex: Integer): TComponent;
428. begin
429.   if FComponents = nil then TList.Error(@SListIndexError, AIndex);
430.   Result := FComponents[AIndex];
431. end;
433. function TComponent.GetComponentCount: Integer;
434. begin
435.   if FComponents <> nil then
436.     Result := FComponents.Count else
437.     Result := 0;
438. end;
440. procedure TComponent.SetComponentIndex(Value: Integer);
441. var
442.   I, Count: Integer;
443. begin
444.   if FOwner <> nil then
445.   begin
446.     I := FOwner.FComponents.IndexOf(Self);
447.     if I >= 0 then
448.     begin
449.       Count := FOwner.FComponents.Count;
450.       if Value < 0 then Value := 0;
451.       if Value >= Count then Value := Count - 1;
452.       if Value <> I then
453.       begin
454.         FOwner.FComponents.Delete(I);
455.         FOwner.FComponents.Insert(Value, Self);
456.       end;
457.     end;
458.   end;
459. end;
461. procedure TComponent.SetAncestor(Value: Boolean);
462. var
463.   I: Integer;
464. begin
465.   if Value then
466.     Include(FComponentState, csAncestor) else
467.     Exclude(FComponentState, csAncestor);
468.   for I := 0 to ComponentCount - 1 do
469.     Components[I].SetAncestor(Value);
470. end;
472. procedure TComponent.SetDesigning(Value, SetChildren: Boolean);
473. var
474.   I: Integer;
475. begin
476.   if Value then
477.     Include(FComponentState, csDesigning) else
478.     Exclude(FComponentState, csDesigning);
479.   if SetChildren then
480.     for I := 0 to ComponentCount - 1 do Components[I].SetDesigning(Value);
481. end;
483. procedure TComponent.SetInline(Value: Boolean);
484. begin
485.   if Value then
486.     Include(FComponentState, csInline) else
487.     Exclude(FComponentState, csInline);
488. end;
490. procedure TComponent.SetDesignInstance(Value: Boolean);
491. begin
492.   if Value then
493.     Include(FComponentState, csDesignInstance) else
494.     Exclude(FComponentState, csDesignInstance);
495. end;
497. procedure TComponent.SetReference(Enable: Boolean);
498. var
499.   Field: ^TComponent;
500. begin
501.   if FOwner <> nil then
502.   begin
503.     Field := FOwner.FieldAddress(FName);
504.     if Field <> nil then
505.       if Enable then Field^ := Self else Field^ := nil;
506.   end;
507. end;
509. function TComponent.ExecuteAction(Action: TBasicAction): Boolean;
510. begin
511.   Result := Action.HandlesTarget(Self);
512.   if Result then
513.     Action.ExecuteTarget(Self);
514. end;
516. function TComponent.UpdateAction(Action: TBasicAction): Boolean;
517. begin
518.   Result := Action.HandlesTarget(Self);
519.   if Result then
520.     Action.UpdateTarget(Self);
521. end;
523. procedure TComponent.SetSubComponent(IsSubComponent: Boolean);
524. begin
525.   if IsSubComponent then
526.     Include(FComponentStyle, csSubComponent)
527.   else
528.     Exclude(FComponentStyle, csSubComponent);
529. end;
532. function TComponent.GetComObject: IUnknown;
533. begin
534.   if FVCLComObject = nil then
535.   begin
536.     if Assigned(CreateVCLComObjectProc) then CreateVCLComObjectProc(Self);
537.     if FVCLComObject = nil then
538.       raise EComponentError.CreateResFmt(@SNoComSupport, [ClassName]);
539.   end;
540.   IVCLComObject(FVCLComObject).QueryInterface(IUnknown, Result);
541. end;
543. function TComponent.SafeCallException(ExceptObject: TObject;
544.   ExceptAddr: Pointer): HResult;
545. begin
547.   if FVCLComObject <> nil then
548.     Result := IVCLComObject(FVCLComObject).SafeCallException(
549.       ExceptObject, ExceptAddr)
551. {$IFDEF LINUX}
552.   {$IFDEF _WIN32};{$ENDIF}
553.   if ExceptObject is Exception then
554.   begin
555.     SetSafeCallExceptionMsg(Exception(ExceptObject).Message);
556.     SetSafeCallExceptionAddr(ExceptAddr);
557.     Result := HResult($8000FFFF);
558.   end
559. {$ENDIF}
560.   else
561.     Result := inherited SafeCallException(ExceptObject, ExceptAddr);
562. end;
564. procedure TComponent.FreeOnRelease;
565. begin
566.   if FVCLComObject <> nil then IVCLComObject(FVCLComObject).FreeOnRelease;
567. end;
570. class procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
571. begin
572. end;
574. { TComponent.IInterface }
576. function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;
577. begin
579.   if FVCLComObject = nil then
580.   begin
582.     if GetInterface(IID, Obj) then Result := S_OK
583.     else Result := E_NOINTERFACE
585.   end
586.   else
587.     Result := IVCLComObject(FVCLComObject).QueryInterface(IID, Obj);
589. end;
591. function TComponent._AddRef: Integer;
592. begin
594.   if FVCLComObject = nil then
595.     Result := -1   // -1 indicates no reference counting is taking place
596.   else
597.     Result := IVCLComObject(FVCLComObject)._AddRef;
601. end;
603. function TComponent._Release: Integer;
604. begin
606.   if FVCLComObject = nil then
607.     Result := -1   // -1 indicates no reference counting is taking place
608.   else
609.     Result := IVCLComObject(FVCLComObject)._Release;
613. end;
616. { TComponent.IDispatch }
618. function TComponent.GetTypeInfoCount(out Count: Integer): HResult;
619. begin
620.   if FVCLComObject = nil then
621.     Result := E_NOTIMPL
622.   else
623.     Result := IVCLComObject(FVCLComObject).GetTypeInfoCount(Count);
624. end;
626. function TComponent.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
627. begin
628.   if FVCLComObject = nil then
629.     Result := E_NOTIMPL
630.   else
631.     Result := IVCLComObject(FVCLComObject).GetTypeInfo(
632.       Index, LocaleID, TypeInfo);
633. end;
635. function TComponent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
636.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
637. begin
638.   if FVCLComObject = nil then
639.     Result := E_NOTIMPL
640.   else
641.     Result := IVCLComObject(FVCLComObject).GetIDsOfNames(IID, Names,
642.       NameCount, LocaleID, DispIDs);
643. end;
645. function TComponent.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
646.   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
647. begin
648.   if FVCLComObject = nil then
649.     Result := E_NOTIMPL
650.   else
651.     Result := IVCLComObject(FVCLComObject).Invoke(DispID, IID, LocaleID,
652.       Flags, Params, VarResult, ExcepInfo, ArgErr);
653. end;
656. { TComponent.IInterfaceComponentReference.GetComponent
657.   Return a reference to the component that can be queried at load time to
658.   obtain an interface.  The name of the reference component will be written to
659.   the stream (same as a normal component reference) so that it can be located
660.   again at load time.
661.   In the case of aggregation, the reference component for an interface might
662.   not be the same as the class that implements the interface itself.
663.   Aggregate implementation classes should not implement
664.   IInterfaceComponentReference, but should defer requests for that interface
665.   to the controlling component.
666. }
668. function TComponent.IntfGetComponent: TComponent;
669. begin
670.   Result := Self;
671. end;
673. function TComponent.IsImplementorOf(const I: IInterface): Boolean;
674. var
675.   ICR: IInterfaceComponentReference;
676. begin
677.   Result := (I <> nil) and Supports(I, IInterfaceComponentReference, ICR)
678.     and (ICR.GetComponent = Self);
679. end;
681. { TComponent.ReferenceInterface
682.   Establishes (opInsert) or removes (opRemove) internal links that
683.   notify us when the component that implements the given interface is
684.   destroyed.  The function result indicates whether the function was able
685.   to establish/remove a notification link or not.  A result of False
686.   doesn't necessarily indicate an error, but it does mean that the
687.   interface's implementor does not participate in the interfaced component
688.   reference model.  This could mean that the given interface employs true
689.   reference counting, independent of component lifetimes.  That doesn't
690.   affect the use of interface properties at runtime, but non-component
691.   interfaces cannot be stored by the property streaming system.
693.   When implementing components with interface-type properties, implement
694.   setter methods for the interface-type properties like this:
696.   procedure TMyComponent.SetMyIntfProp(const Value: IMyInterface);
697.   begin
698.     ReferenceInterface(FIntfField, opRemove);
699.     FIntfField := Value;
700.     ReferenceInterface(FIntfField, opInsert);
701.   end;
703.   Also override Notification to do the following for each interface property
704.   in your component:
706.   procedure TMyComponent.Notification(AComponent: TComponent; Operation: TOperation);
707.   begin
708.     inherited;
709.     if Assigned(MyIntfProp) and AComponent.IsImplementorOf(MyIntfProp) then
710.       MyIntfProp := nil;
711.     ... repeat for other interface properties ...
712.   end;
714.   Note that the Notification code assigns nil to the *property*, not to the
715.   private field, so that the property setter will call
716.   ReferenceInterface(FIntfField, opRemove to undo any links established by
717.   a previous opInsert operation.  All assignments to the interface property
718.   *must* be made through the property setter.
720.   TComponent.ReferenceInterface hides the details of how links are
721.   established between the implementor and the holder of an interface.
722.   The implementation details may change in the future.  Code that relies
723.   on those implementation details (instead of using ReferenceInterface)
724.   will not be supported.  In particular, avoid the temptation to use
725.   IInterfaceComponentReference in your own code, as this interface may
726.   not be available in the future.
727. }
729. function TComponent.ReferenceInterface(const I: IInterface; Operation: TOperation): Boolean;
730. var
731.   ICR: IInterfaceComponentReference;
732. begin
733.   Result := (I <> nil) and Supports(I, IInterfaceComponentReference, ICR);
734.   if Result then
735.     if Operation = opInsert then
736.       ICR.GetComponent.FreeNotification(Self)
737.     else
738.       ICR.GetComponent.RemoveFreeNotification(Self);
739. end;