Delphi 深入浅出VCL(4)-Componet:组件对象

 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;

 

转载于:https://www.cnblogs.com/YiShen/p/9872895.html

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值