jvdataprovider.pas

East make Tray Icon in delphi

    function IndexOf(Ctx: IJvDataContext): Integer; virtual;
    property DsgnContext: IJvDataContext read FDsgnContext write FDsgnContext;
  public
    constructor Create(AProvider: IJvDataProvider; AAncestor: IJvDataContext;
      ManagerClass: TJvDataContextsManagerClass = nil); virtual;
  end;

  // Basic context list manager
  TJvBaseDataContextsManager = class(TAggregatedPersistentEx, IJvDataContextsManager)
  protected
    function Contexts: IJvDataContexts;
    function ContextsImpl: TJvBaseDataContexts;
    function Add(Context: IJvDataContext): IJvDataContext;
    function New: IJvDataContext; virtual; abstract;
    procedure Delete(Context: IJvDataContext);
    procedure Clear;
  end;

  // Basic context
  TJvBaseDataContext = class(TExtensibleInterfacedPersistent, IJvDataContext)
  private
    FContexts: TJvBaseDataContexts;
  protected
    { Will actually set the name without any checks or notification. You should use SetName to
      change the context's name which in turn will call this method after it has checked the
      name is unique. }
    procedure DoSetName(Value: string); virtual; abstract;
    { Changes this context's name to the given name. It will first check if the new name is
      unique and then calls DoSetName to change it. }
    procedure SetName(Value: string); virtual;
    function GetImplementer: TObject;
    function ContextsImpl: TJvBaseDataContexts;
    function Contexts: IJvDataContexts;
    function Name: string; virtual; abstract;
    function IsDeletable: Boolean; dynamic;
    function IsStreamable: Boolean; dynamic;
  public
    constructor Create(AContexts: TJvBaseDataContexts; AName: string); virtual;
  end;

  // Basic managed context
  TJvBaseManagedDataContext = class(TJvBaseDataContext, IJvDataContextManager);

  // Basic fixed context
  TJvBaseFixedDataContext = class(TJvBaseDataContext)
  protected
    function IsDeletable: Boolean; override;
  end;

  // Standard context list
  TJvDataContexts = class(TJvBaseDataContexts)
  private
    FContexts: TInterfaceList;
  protected
    procedure DoAddContext(Context: IJvDataContext); override;
    procedure DoDeleteContext(Index: Integer); override;
    procedure DoRemoveContext(Context: IJvDataContext); override;
    procedure DoClearContexts; override;
    function GetCount: Integer; override;
    function GetContext(Index: Integer): IJvDataContext; override;
  public
    constructor Create(AProvider: IJvDataProvider; AAncestor: IJvDataContext;
      ManagerClass: TJvDataContextsManagerClass = nil); override;
    destructor Destroy; override;
  end;

  // Standard context
  TJvDataContext = class(TJvBaseDataContext)
  private
    FName: string;
  protected
    procedure DoSetName(Value: string); override;
    function Name: string; override;
  end;

  // Standard managed context
  TJvManagedDataContext = class(TJvDataContext, IJvDataContextManager);

  // Standard fixed context
  TJvFixedDataContext = class(TJvDataContext)
  protected
    function IsDeletable: Boolean; override;
  end;

// Helper classes: rendering helpers
  { Render class to be used by both the IJvDataItemsRenderer as well as IJvDataItemRenderer
    implementers. Reduces code duplication if both type of implementers can use the same rendering
    mechanism. }
  TJvDP_ProviderBaseRender = class(TObject)
  private
    FItem: IJvDataItem;
    FCanvas: TCanvas;
    FState: TProviderDrawStates;
  protected
    Rect: TRect;
    procedure Prepare(ForMeasure: Boolean); virtual; abstract; 
    procedure DoDraw; virtual; abstract;
    function DoMeasure: TSize; virtual; abstract;

    property Item: IJvDataItem read FItem;
    property Canvas: TCanvas read FCanvas;
    property State: TProviderDrawStates read FState;
  public
    constructor Create(AItem: IJvDataItem; ACanvas: TCanvas; AState: TProviderDrawStates);
    class procedure Draw(AItem: IJvDataItem; ACanvas: TCanvas; var ARect: TRect; AState: TProviderDrawStates);
    class function Measure(AItem: IJvDataItem; ACanvas: TCanvas; AState: TProviderDrawStates): TSize;
  end;

  TJvDP_ProviderTextOnlyRender = class(TJvDP_ProviderBaseRender)
  private
    FHasNoText: Boolean;
    FText: string;
    FTextRect: TRect;
  protected
    procedure Prepare(ForMeasure: Boolean); override;
    procedure DoDraw; override;
    function DoMeasure: TSize; override;

    property HasNoText: Boolean read FHasNoText write FHasNoText;
    property Text: string read FText write FText;
    property TextRect: TRect read FTextRect write FTextRect;
  end;

  TJvDP_ProviderImgAndTextRender = class(TJvDP_ProviderTextOnlyRender)
  private
    FHasImage: Boolean;
    FHasDisabledImage: Boolean;
    FImages: TCustomImageList;
    FImageIndex: Integer;
    FAlignment: TAlignment;
  protected
    procedure Prepare(ForMeasure: Boolean); override;
    procedure DoDraw; override;
    function DoMeasure: TSize; override;

    property HasImage: Boolean read FHasImage write FHasImage;
    property HasDisabledImage: Boolean read FHasDisabledImage write FHasDisabledImage;
    property Images: TCustomImageList read FImages write FImages;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property Alignment: TAlignment read FAlignment write FAlignment;
  end;

  TJvDataConsumer = class(TExtensibleInterfacedPersistent, IJvDataConsumer, IJvDataProviderNotify,
    IJvDataConsumerProvider, IJvDataConsumerClientNotify)
  private
    FOwner: TComponent;
    FAttrList: array of Integer;
    FProvider: IJvDataProvider;
    FContext: IJvDataContext;
    FAfterCreateSubSvc: TAfterCreateSubSvcEvent;
    FBeforeCreateSubSvc: TBeforeCreateSubSvcEvent;
    FOnChanging: TJvDataConsumerChangeEvent;
    FOnChanged: TJvDataConsumerChangeEvent;
    FNeedFixups: Boolean;
    FFixupContext: TJvDataContextID;
    FOnProviderChanging: TProviderNotifyEvent;
    FOnProviderChanged: TProviderNotifyEvent;
    FServerList: TInterfaceList;
    procedure SetProvider(Value: IJvDataProvider);
    {$IFDEF COMPILER5}
    function GetProviderComp: TComponent;
    procedure SetProviderComp(Value: TComponent);
    {$ENDIF COMPILER5}
  protected
    function _AddRef: Integer; override; stdcall;
    function _Release: Integer; override; stdcall;
    { Event triggering }
    procedure DoProviderChanging(ADataProvider: IJvDataProvider; AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DoProviderChanged(ADataProvider: IJvDataProvider; AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DoAfterCreateSubSvc(ASvc: TJvDataConsumerAggregatedObject);
    procedure DoBeforeCreateSubSvc(var AClass: TJvDataConsumerAggregatedObjectClass);
    procedure DoChanging(Reason: TJvDataConsumerChangeReason);
    procedure DoChanged(Reason: TJvDataConsumerChangeReason);
    { Misc. }
    procedure DoAddAttribute(Attr: Integer);
    procedure Changing(Reason: TJvDataConsumerChangeReason); virtual;
    procedure Changed(Reason: TJvDataConsumerChangeReason); virtual;
    procedure ProviderChanging;
    procedure ProviderChanged;
    procedure ContextChanging;
    procedure ContextChanged;
    procedure AfterSubSvcAdded(ASvc: TJvDataConsumerAggregatedObject); virtual;
    procedure UpdateExtensions; virtual;
    procedure FixupExtensions;
    procedure FixupContext;
    procedure ViewChanged(AExtension: TJvDataConsumerAggregatedObject);
    procedure NotifyItemSelected(Value: IJvDataItem);
    procedure NotifyServerItemChanged(Server: IJvDataConsumerServerNotify; Value: IJvDataItem);
    procedure NotifyServerProviderChanged;
    function ExtensionCount: Integer;
    function Extension(Index: Integer): TJvDataConsumerAggregatedObject;
    function IsContextStored: Boolean;
    function GetNeedExtensionFixups: Boolean;
    function GetNeedContextFixup: Boolean;
    { Property access }
    function GetContext: TJvDataContextID;
    procedure SetContext(Value: TJvDataContextID);
    function GetServerCount: Integer;
    function GetServers(I: Integer): IJvDataConsumerServerNotify;
    { IJvDataProviderNotify methods }
    procedure DataProviderChanging(const ADataProvider: IJvDataProvider; AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DataProviderChanged(const ADataProvider: IJvDataProvider; AReason: TDataProviderChangeReason; Source: IUnknown);
    function Consumer: IJvDataConsumer;
    { IJvDataConsumer methods }
    function VCLComponent: TComponent;
    function AttributeApplies(Attr: Integer): Boolean;
    { IJvDataConsumerProvider methods }
    function IJvDataConsumerProvider.GetProvider = ProviderIntf;
    { IJvDataConsumerClientNotify methods }
    procedure IJvDataConsumerClientNotify.ItemSelected = ServerItemChanged;
    procedure ServerItemChanged(Server: IJvDataConsumerServerNotify; Value: IJvDataItem); virtual;
    procedure LinkAdded(Server: IJvDataConsumerServerNotify);
    procedure LinkRemoved(Server: IJvDataConsumerServerNotify);
    { States }
    property NeedExtensionFixups: Boolean read GetNeedExtensionFixups;
    property NeedContextFixup: Boolean read GetNeedContextFixup;
    { Other }
    property ServerCount: Integer read GetServerCount;
    property Servers[I: Integer]: IJvDataConsumerServerNotify read GetServers;
  public
    constructor Create(AOwner: TComponent; Attributes: array of Integer);
    destructor Destroy; override;
    { Direct link to actual provider interface. This is done to aid in the implementation (less
      IFDEF's in the code; always refer to ProviderIntf and it's working in all Delphi versions). }
    function ProviderIntf: IJvDataProvider; virtual;
    procedure SetProviderIntf(Value: IJvDataProvider); virtual;
    function ContextIntf: IJvDataContext; virtual;
    procedure SetContextIntf(Value: IJvDataContext); virtual;
    procedure Loaded; virtual;
    procedure Enter;
    procedure Leave;
    { Notifies the consumer the specified item is selected in the control. Will execute the item's
      IJvDataItemExecute interface if one is assigned to the item and notifies all service
      extensions of the selection change. }
    procedure ItemSelected(Value: IJvDataItem);
    function IsLoading: Boolean;

    property OnChanging: TJvDataConsumerChangeEvent read FOnChanging write FOnChanging;
    property OnChanged: TJvDataConsumerChangeEvent read FOnChanged write FOnChanged;
    property OnProviderChanging: TProviderNotifyEvent read FOnProviderChanging
      write FOnProviderChanging;
    property OnProviderChanged: TProviderNotifyEvent read FOnProviderChanged
      write FOnProviderChanged;
    property AfterCreateSubSvc: TAfterCreateSubSvcEvent read FAfterCreateSubSvc
      write FAfterCreateSubSvc;
    property BeforeCreateSubSvc: TBeforeCreateSubSvcEvent read FBeforeCreateSubSvc
      write FBeforeCreateSubSvc;
  published
    {$IFDEF COMPILER6_UP}
    property Provider: IJvDataProvider read ProviderIntf write SetProvider;
    {$ELSE}
    property Provider: TComponent read GetProviderComp write SetProviderComp;
    {$ENDIF COMPILER6_UP}
    property Context: TJvDataContextID read GetContext write SetContext stored IsContextStored;
  end;

  TJvDataConsumerAggregatedObject = class(TAggregatedPersistentEx)
  protected
    StreamedInWithoutProvider: Boolean;
    procedure DataProviderChanging(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); virtual;
    procedure DataProviderChanged(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); virtual;
    { Called when the Provider/Context are set and NotifyFixups has been called earlier. It doesn't
      matter which sub service called NotifyFixups, all services are notified if the
      provider/context are set. }
    procedure Fixup; virtual;
    { Called after a new provider is selected to determine if the sub service can stay around.
      Return False to have the sub service removed (the default implementation) or set to True to
      keep it around. Note that on entry to this method the new provider is already selected. }
    function KeepOnProviderChange: Boolean; virtual;
    { Called after a new context is selected to determine if the sub service can stay around.
      Return False to have the sub service removed or set to True to keep it around (default
      implementation). Note that on entry to this method the new context is already selected. }
    function KeepOnContextChange: Boolean; virtual;
    { Notifies the consumer service a change is about to take place. Sub services should call this
      method when something is changing. }
    procedure Changing(Reason: TJvDataConsumerChangeReason);
    { Notifies the consumer service a change has taken place. Sub services should call this method
      when something has changed. }
    procedure Changed(Reason: TJvDataConsumerChangeReason);
    { Notifies the consumer service (and other extensions) a change has taken place that might have
      influenced the view list. }
    procedure NotifyViewChanged;
    { Called after the view has changed by another extension. }
    procedure ViewChanged(AExtension: TJvDataConsumerAggregatedObject); virtual;
    { Called when an item has been selected by the consumer. }
    procedure ItemSelected(Value: IJvDataItem); virtual;
    { Called when a linked server consumer has selected a new item. }
    procedure ServerItemChanged(Server: IJvDataConsumerServerNotify; Value: IJvDataItem); virtual;
    { Signal to the consumer service that settings need to be applies but the provider/context was
      not yet available. This may occur during streaming in from the DFM. As soon as the provider is
      known, the context is also set and Fixup is called for all sub services. }
    procedure NotifyFixups;
    { Called when the provider is about to be changed. }
    procedure ProviderChanging; virtual;
    { Called when the provider has changed but only after KeepOnProviderChange returned True. }
    procedure ProviderChanged; virtual;