{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDataProviderImpl.pas, released on --.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2002 - 2003 Marcel Bestebroer
All Rights Reserved.

Contributor(s):
  Remko Bonte
  Peter Thörnqvist

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvDataProvider;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows,
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  Classes, Contnrs, Graphics, Controls, ImgList,
  JclBase,
  JvComponentBase, JvDataProviderIntf;

{$IFDEF COMPILER15_UP}
  // C++Builder XE now overloads GetInterface() with a generic version. But the Delphi compiler
  // only emits the old version if you use "const GUID: TGUID" as a parameter. This causes the
  // GetInterface() reintroduction, that this unit makes in TExtensibleInterfacedPersistent, to
  // generate compile errors in the C++ code.
  // With the new "HPPEMIT END" we can work around this by disabling the new
  // MANAGED_INTERFACE_OPERATORS define for this HPP file.

  {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT '  #undef MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT '  #define JvDataProviderHpp_MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT '#endif'}

  {$HPPEMIT END '#ifdef JvDataProviderHpp_MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT END '  #define MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT END '  #undef JvDataProviderHpp_MANAGED_INTERFACE_OPERATORS'}
  {$HPPEMIT END '#endif'}
{$ENDIF COMPILER15_UP}

type
  // Forwards
  TExtensibleInterfacedPersistent = class;
  TAggregatedPersistentEx = class;
  TJvBaseDataItem = class;
  TJvBaseDataItems = class;
  TJvBaseDataContexts = class;
  TJvBaseDataContextsManager = class;
  TJvBaseDataContext = class;
  TJvDataConsumer = class;
  TJvDataConsumerAggregatedObject = class;
  TJvDataConsumerServerNotify = class;
  TJvDataConsumerClientNotifyList = class;
  TJvDataConsumerClientNotifyItem = class;

  // Class references
  TAggregatedPersistentExClass = class of TAggregatedPersistentEx;
  TJvDataItemTextImplClass = class of TJvBaseDataItemTextImpl;
  TJvBaseDataItemClass = class of TJvBaseDataItem;
  TJvDataItemsClass = class of TJvBaseDataItems;
  TJvDataContextsClass = class of TJvBaseDataContexts;
  TJvDataContextsManagerClass = class of TJvBaseDataContextsManager;
  TJvDataContextClass = class of TJvBaseDataContext;
  TJvDataConsumerAggregatedObjectClass = class of TJvDataConsumerAggregatedObject;

  // Various types
  TProviderNotifyEvent = procedure(ADataProvider: IJvDataProvider;
    AReason: TDataProviderChangeReason; Source: IUnknown) of object;
  TJvDataProviderTree = type Integer;
  TJvDataProviderItemID = type string;
  TJvDataProviderContexts = type Integer;
  TBeforeCreateSubSvcEvent = procedure(Sender: TJvDataConsumer;
    var SubSvcClass: TJvDataConsumerAggregatedObjectClass) of object;
  TAfterCreateSubSvcEvent = procedure(Sender: TJvDataConsumer;
    SubSvc: TJvDataConsumerAggregatedObject) of object;
  TJvDataConsumerChangeReason = (ccrProviderSelect, ccrProviderChange, ccrViewChange,
    ccrContextChange, ccrOther);
  TJvDataConsumerChangeEvent = procedure(Sender: TJvDataConsumer;
    Reason: TJvDataConsumerChangeReason) of object;

  // Generic classes (move to some other unit?)
  TExtensibleInterfacedPersistent = class(TPersistent, IUnknown)
  private
    FAdditionalIntfImpl: TList;
  protected
    FRefCount: Integer;
    { IUnknown }
    function _AddRef: Integer; virtual; stdcall;
    function _Release: Integer; virtual; stdcall;
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    // implementer list
    procedure AddIntfImpl(const Obj: TAggregatedPersistentEx);
    procedure RemoveIntfImpl(const Obj: TAggregatedPersistentEx);
    function IndexOfImplClass(const AClass: TAggregatedPersistentExClass): Integer;
    function GetImplOfClass(AClass: TAggregatedPersistentExClass): TAggregatedPersistentEx;
    procedure ClearIntfImpl;
    procedure InitImplementers; virtual;
    function ImplCount: Integer;
    function GetImplementer(Index: Integer): TAggregatedPersistentEx;
    // refercence counting
    procedure SuspendRefCount;
    procedure ResumeRefCount;
    // streaming
    function IsStreamableExtension(AnExtension: TAggregatedPersistentEx): Boolean; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadImplementers(Reader: TReader);
    procedure WriteImplementers(Writer: TWriter);
    procedure ReadImplementer(Reader: TReader);
    procedure WriteImplementer(Writer: TWriter; Instance: TAggregatedPersistentEx);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    function GetInterface(const IID: TGUID; out Obj): Boolean; virtual;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;

  TAggregatedPersistent = class(TPersistent)
  private
    FController: Pointer;
    function GetController: IUnknown;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    function _AddRef: Integer; virtual; stdcall;
    function _Release: Integer; virtual; stdcall;
  public
    constructor Create(Controller: IUnknown);
    function GetInterface(const IID: TGUID; out Obj): Boolean; virtual;
    property Controller: IUnknown read GetController;
  end;

  TAggregatedPersistentEx = class(TAggregatedPersistent)
  private
    FOwner: TExtensibleInterfacedPersistent;
  protected
    property Owner: TExtensibleInterfacedPersistent read FOwner;
    function IsHidden: Boolean; virtual;
  public
    constructor Create(AOwner: TExtensibleInterfacedPersistent); virtual;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

  // Generic event based provider notification
  TJvProviderNotification = class(TObject, IUnknown, IJvDataProviderNotify)
  private
    FProvider: IJvDataProvider;
    FOnChanging: TProviderNotifyEvent;
    FOnChanged: TProviderNotifyEvent;
  protected
    procedure SetProvider(Value: IJvDataProvider);
    { IUnknown }
    function _AddRef: Integer; virtual; stdcall;
    function _Release: Integer; virtual; stdcall;
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    { IJvDataProviderNotify }
    procedure DataProviderChanging(const ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DataProviderChanged(const ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
    function Consumer: IJvDataConsumer;
  public
    destructor Destroy; override;
    property OnChanging: TProviderNotifyEvent read FOnChanging write FOnChanging;
    property OnChanged: TProviderNotifyEvent read FOnChanged write FOnChanged;
    property Provider: IJvDataProvider read FProvider write SetProvider;
  end;

  // Item implementation classes
  TJvDataItemAggregatedObject = class(TAggregatedPersistentEx)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;
    procedure ContextDestroying(Context: IJvDataContext); dynamic;
    function Item: IJvDataItem;
    function ItemImpl: TJvBaseDataItem;
  end;

  TJvBaseDataItem = class(TExtensibleInterfacedPersistent, IJvDataItem)
  private
    FItems: Pointer;
    FItemsIntf: IJvDataItems;
    FID: string;
  protected
    { Initialize ID. Each item must have an unique identification. Implementers may choose how this
      ID is generated. No checks are made when items are added to a provider to ensure it's
      unique. If multiple items with the same ID are added only the first item in the tree will be
      selectable at design time. }
    procedure InitID; virtual;
    { Set the ID string. Used by InitID to set the actual ID string. }
    procedure SetID(Value: string);
    { Reference counting: add 1 if this item is part of a dynamic list (Items.IsDynamic returns
      True). Otherwise reference counting is not used. }
    function _AddRef: Integer; override; stdcall;
    { Reference counting: substract 1 if this item is part of a dynamic list (Items.IsDynamic returns
      True). Otherwise reference counting is not used. }
    function _Release: Integer; override; stdcall;
    // design support
    function GetOwner: TPersistent; override;
    { Streaming of an item. }
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadSubItems(Reader: TReader);
    procedure WriteSubItems(Writer: TWriter);
    { IJvDataItem methods and properties. }
    function GetItems: IJvDataItems;
    function GetIndex: Integer;
    function GetImplementer: TObject;
    function GetID: string;
    procedure ContextDestroying(Context: IJvDataContext); dynamic;
    function IsParentOf(AnItem: IJvDataItem; DirectParent: Boolean = False): Boolean; virtual;
    function IsDeletable: Boolean; dynamic;
    property Items: IJvDataItems read GetItems;
    property Implementer: TObject read GetImplementer;
    { Optional IJvDataContextSensitive interface implementation }
    procedure RevertToAncestor; dynamic;
    function IsEqualToAncestor: Boolean; dynamic;
  public
    constructor Create(AOwner: IJvDataItems);
    procedure AfterConstruction; override;
    function GetNamePath: string; override;
  published
    property ID: string read GetID write SetID;
  end;

  TJvBaseDataItemTextImpl = class(TJvDataItemAggregatedObject, IJvDataItemText)
  protected
    function GetText: string; virtual; abstract;
    procedure SetText(const Value: string); virtual; abstract;
    function Editable: Boolean; virtual; abstract;
  public
    property Text: string read GetText write SetText;
  end;

  TJvBaseDataItemImageImpl = class(TJvDataItemAggregatedObject, IJvDataItemImage)
  protected
    function GetAlignment: TAlignment; virtual; abstract;
    procedure SetAlignment(Value: TAlignment); virtual; abstract;
    function GetImageIndex: Integer; virtual; abstract;
    procedure SetImageIndex(Index: Integer); virtual; abstract;
    function GetSelectedIndex: Integer; virtual; abstract;
    procedure SetSelectedIndex(Value: Integer); virtual; abstract;
  end;

  TJvBaseDataItemRenderer = class(TJvDataItemAggregatedObject, IJvDataItemRenderer)
  protected
    procedure Draw(ACanvas: TCanvas; var ARect: TRect; State: TProviderDrawStates); virtual; abstract;
    function Measure(ACanvas: TCanvas): TSize; virtual; abstract;
  end;

  TJvBaseDataItemStates = class(TJvDataItemAggregatedObject, IJvDataItemStates)
  protected
    function Get_Enabled: TDataItemState; virtual; abstract;
    procedure Set_Enabled(Value: TDataItemState); virtual; abstract;
    function Get_Checked: TDataItemState; virtual; abstract;
    procedure Set_Checked(Value: TDataItemState); virtual; abstract;
    function Get_Visible: TDataItemState; virtual; abstract;
    procedure Set_Visible(Value: TDataItemState); virtual; abstract;
  end;

  // Items implementation classes
  TJvDataItemsAggregatedObject = class(TAggregatedPersistentEx)
  protected
    procedure ContextDestroying(Context: IJvDataContext); dynamic;
    function Items: IJvDataItems;
    function ItemsImpl: TJvBaseDataItems;
  end;

  TJvBaseDataItems = class(TExtensibleInterfacedPersistent, IJvDataItems, IJvDataIDSearch)
    function IJvDataIDSearch.Find = FindByID;
  private
    FParent: Pointer;
    FParentIntf: IJvDataItem;
    FProvider: IJvDataProvider;
    FSubAggregate: TAggregatedPersistentEx;
  protected
    { Adds an item to the list. }
    procedure InternalAdd(Item: IJvDataItem); virtual; abstract;
    { Removes an item from the list. }
    procedure InternalDelete(Index: Integer); virtual; abstract;
    { Moves an item in the list to a new index. }
    procedure InternalMove(OldIndex, NewIndex: Integer); virtual; abstract;
    { Called by the IJvDataItemsManagement and IJvDataItemsDesigner implementations to add a new
      item. It will redirect it to InternalAdd. InternalAdd will perform the add, but may also
      perform addition steps if needed (in case of context specific list it might need to copy the
      list first). }
    procedure ItemAdd(Item: IJvDataItem);
    { Called by the IJvDataItemsManagement implementation to remove an item. It will redirect it to
      InternalDelete. InternalDelete will perform the removal, but may also perform addition steps
      if needed (i.e. notify the other contexts if the delete is performed on the context-less list
      or copy the list for a context specific list that inherits from an ancestor). }
    procedure ItemDelete(Index: Integer);
    { Called by the IJvDataItem implementation to move an item. It will redirect it to
      InternalMove. InternalMove will perform the moving if it's called from within a context.
      The context-less list does not allow moving of items. }
    procedure ItemMove(OldIndex, NewIndex: Integer);
    { Determines if the item is streamable. }
    function IsStreamableItem(Item: IJvDataItem): Boolean; virtual;
    function ScanForID(Items: IJvDataItems; ID: string; Recursive: Boolean): IJvDataItem;
    { Streaming methods }
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadItems(Reader: TReader);
    procedure WriteItems(Writer: TWriter);
    procedure ReadItem(Reader: TReader);
    procedure WriteItem(Writer: TWriter; Item: IJvDataItem);
    { IJvDataItems methods }
    function GetCount: Integer; virtual; abstract;
    function GetItem(I: Integer): IJvDataItem; virtual; abstract;
    function GetItemByID(ID: string): IJvDataItem;
    function GetItemByIndexPath(IndexPath: array of Integer): IJvDataItem;
    function GetParent: IJvDataItem; virtual;
    function GetProvider: IJvDataProvider;
    function GetImplementer: TObject;
    function IsDynamic: Boolean; virtual;
    procedure ContextDestroying(Context: IJvDataContext); dynamic;
    { IJvDataIDSearch methods }
    function FindByID(ID: string; const Recursive: Boolean = False): IJvDataItem;
  public
    constructor Create; overload; virtual;
    constructor Create(const Provider: IJvDataProvider); overload; virtual;
    constructor Create(const Parent: IJvDataItem); overload; virtual;
    procedure BeforeDestruction; override;
  end;

  TJvBaseDataItemsRenderer = class(TJvDataItemsAggregatedObject, IJvDataItemsRenderer)
  protected
    procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Item: IJvDataItem; State: TProviderDrawStates); virtual; abstract;
    function DoMeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize; virtual; abstract;
    { IJvDataItemsRenderer methods }
    procedure DrawItemByIndex(ACanvas: TCanvas; var ARect: TRect; Index: Integer;
      State: TProviderDrawStates); virtual;
    function MeasureItemByIndex(ACanvas: TCanvas; Index: Integer): TSize; virtual;
    procedure DrawItem(ACanvas: TCanvas; var ARect: TRect; Item: IJvDataItem;
      State: TProviderDrawStates); virtual;
    function MeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize; virtual;
    function AvgItemSize(ACanvas: TCanvas): TSize; virtual; abstract;
  end;

  TJvBaseDataItemsManagement = class(TJvDataItemsAggregatedObject, IJvDataItemsManagement)
  protected
    { IJvDataItemManagement methods }
    function Add(Item: IJvDataItem): IJvDataItem; virtual; abstract;
    function New: IJvDataItem; virtual; abstract;
    procedure Clear; virtual; abstract;
    procedure Delete(Index: Integer); virtual; abstract;
    procedure Remove(var Item: IJvDataItem); virtual; abstract;
  end;

  TJvBaseDataItemsImagesImpl = class(TJvDataItemsAggregatedObject, IJvDataItemsImages)
  protected
    { IJvDataItemImages methods }
    function GetDisabledImages: TCustomImageList; virtual; abstract;
    procedure SetDisabledImages(const Value: TCustomImageList); virtual; abstract;
    function GetHotImages: TCustomImageList; virtual; abstract;
    procedure SetHotImages(const Value: TCustomImageList); virtual; abstract;
    function GetImages: TCustomImageList; virtual; abstract;
    procedure SetImages(const Value: TCustomImageList); virtual; abstract;
  end;

  // Standard item implementers
  TJvDataItemTextImpl = class(TJvBaseDataItemTextImpl)
  private
    FText: string;
  protected
    function GetText: string; override;
    procedure SetText(const Value: string); override;
    function Editable: Boolean; override;
  published
    property Text: string read GetText write SetText;
  end;

  { Context sensitive text implementation: Retrieves/Sets the captiontext linked to the currently
    selected context. The implementation provides in a default text that is not linked to any
    context. If there's no active context set at the provider; this text will be retrieved/set.
    If the active context set at the provider has no text linked to it, the standard text
    is retrieved, but a new link is added when the text is changed. }
  TJvDataItemContextTextImpl = class(TJvDataItemTextImpl, IJvDataContextSensitive)
  private
    FContextStrings: TStringList;
  protected
    function GetText: string; override;
    procedure SetText(const Value: string); override;
    function Editable: Boolean; override;
  public
    constructor Create(AOwner: TExtensibleInterfacedPersistent); override;
    destructor Destroy; override;
    procedure RevertToAncestor; dynamic;
    function IsEqualToAncestor: Boolean; dynamic;
  end;

  { Blockable text implementation: allows to set the text portion to read-only, blocking any
    consumer-side editing (assuming the consumer respects the value returned by the
    IJvDataItemText.Editable function) }
  TJvDataItemBlockableTextImpl = class (TJvDataItemTextImpl)
  private
    FReadOnly: Boolean;
  protected
    procedure SetReadOnly(Value: Boolean);
    function Editable: Boolean; override;
  published
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  end;

  TJvDataItemImageImpl = class(TJvBaseDataItemImageImpl)
  private
    FAlignment: TAlignment;
    FImageIndex: Integer;
    FSelectedIndex: Integer;
  protected
    function GetAlignment: TAlignment; override;
    procedure SetAlignment(Value: TAlignment); override;
    function GetImageIndex: Integer; override;
    procedure SetImageIndex(Index: Integer); override;
    function GetSelectedIndex: Integer; override;
    procedure SetSelectedIndex(Value: Integer); override;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify;
    property ImageIndex: Integer read GetImageIndex write SetImageIndex default 0;
    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex default 0;
  end;

  TJvBaseDataItemSubItems = class(TJvDataItemAggregatedObject, IJvDataItems)
  private
    FItems: IJvDataItems;
  protected
    property Items: IJvDataItems read FItems implements IJvDataItems;
  public
    constructor Create(AOwner: TExtensibleInterfacedPersistent; AItems: TJvBaseDataItems); reintroduce; virtual;
    procedure BeforeDestruction; override;
    function GetInterface(const IID: TGUID; out Obj): Boolean; override;
  end;

  TJvCustomDataItemTextRenderer = class(TJvBaseDataItemRenderer)
  protected
    procedure Draw(ACanvas: TCanvas; var ARect: TRect; State: TProviderDrawStates); override;
    function Measure(ACanvas: TCanvas): TSize; override;
  end;

  TJvCustomDataItemRenderer = class(TJvBaseDataItemRenderer)
  protected
    procedure Draw(ACanvas: TCanvas; var ARect: TRect; State: TProviderDrawStates); override;
    function Measure(ACanvas: TCanvas): TSize; override;
  end;

  TJvCustomDataItemStates = class(TJvBaseDataItemStates)
  private
    FEnabled: TDataItemState;
    FChecked: TDataItemState;
    FVisible: TDataItemState;
  protected
    procedure InitStatesUsage(UseEnabled, UseChecked, UseVisible: Boolean);
    function Get_Enabled: TDataItemState; override;
    procedure Set_Enabled(Value: TDataItemState); override;
    function Get_Checked: TDataItemState; override;
    procedure Set_Checked(Value: TDataItemState); override;
    function Get_Visible: TDataItemState; override;
    procedure Set_Visible(Value: TDataItemState); override;
  published
    property Enabled: TDataItemState read Get_Enabled write Set_Enabled;
    property Checked: TDataItemState read Get_Checked write Set_Checked;
    property Visible: TDataItemState read Get_Visible write Set_Visible;
  end;

  // Standard items implementers
  TJvCustomDataItemsTextRenderer = class(TJvBaseDataItemsRenderer)
  protected
    procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Item: IJvDataItem;
      State: TProviderDrawStates); override;
    function DoMeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize; override;
    function AvgItemSize(ACanvas: TCanvas): TSize; override;
  end;

  TJvCustomDataItemsRenderer = class(TJvBaseDataItemsRenderer)
  protected
    procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Item: IJvDataItem;
      State: TProviderDrawStates); override;
    function DoMeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize; override;
    function AvgItemSize(ACanvas: TCanvas): TSize; override;
  end;

  TJvDataItemsList = class(TJvBaseDataItems)
  private
    FList: TObjectList;
  protected
    procedure InternalAdd(Item: IJvDataItem); override;
    procedure InternalDelete(Index: Integer); override;
    procedure InternalMove(OldIndex, NewIndex: Integer); override;
    function IsDynamic: Boolean; override;
    function GetCount: Integer; override;
    function GetItem(I: Integer): IJvDataItem; override;
  public
    constructor Create; override;
    destructor Destroy; override;

    property List: TObjectList read FList;
  end;

  TJvBaseDataItemsListManagement = class(TJvBaseDataItemsManagement)
  protected
    function Add(Item: IJvDataItem): IJvDataItem; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Remove(var Item: IJvDataItem); override;
  end;

  TJvCustomDataItemsImages = class(TJvBaseDataItemsImagesImpl)
  private
    FDisabledImages: TCustomImageList;
    FHotImages: TCustomImageList;
    FImages: TCustomImageList;
  protected
    function GetDisabledImages: TCustomImageList; override;
    procedure SetDisabledImages(const Value: TCustomImageList); override;
    function GetHotImages: TCustomImageList; override;
    procedure SetHotImages(const Value: TCustomImageList); override;
    function GetImages: TCustomImageList; override;
    procedure SetImages(const Value: TCustomImageList); override;
  published
    property DisabledImages: TCustomImageList read GetDisabledImages write SetDisabledImages;
    property HotImages: TCustomImageList read GetHotImages write SetHotImages;
    property Images: TCustomImageList read GetImages write SetImages;
  end;

  // Generic data provider implementation
  TJvCustomDataProvider = class(TJvComponent, IUnknown, IJvDataProvider)
  private
    FDataItems: IJvDataItems;
    FDataContextsImpl: TJvBaseDataContexts;
    FDataContextsIntf: IJvDataContexts;
    FNotifiers: TInterfaceList;
    FTreeItems: TJvDataProviderTree;
    FConsumerStack: TInterfaceList;
    FContextStack: TInterfaceList;
    FContexts: TJvDataProviderContexts;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; override;
    procedure Changing(ChangeReason: TDataProviderChangeReason; Source: IUnknown = nil);
    procedure Changed(ChangeReason: TDataProviderChangeReason; Source: IUnknown = nil);
    class function PersistentDataItems: Boolean; virtual;
    class function ItemsClass: TJvDataItemsClass; virtual;
    class function ContextsClass: TJvDataContextsClass; virtual;
    class function ContextsManagerClass: TJvDataContextsManagerClass; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadRoot(Reader: TReader);
    procedure WriteRoot(Writer: TWriter);
    procedure ReadContexts(Reader: TReader);
    procedure WriteContexts(Writer: TWriter);
    procedure ReadContext(Reader: TReader; Index: Integer);
    procedure WriteContext(Writer: TWriter; AContext: IJvDataContext);
    procedure AddToArray(var ClassArray: TClassArray; AClass: TClass);
    procedure DeleteFromArray(var ClassArray: TClassArray; Index: Integer);
    function IndexOfClass(AClassArray: TClassArray; AClass: TClass): Integer;
    procedure RemoveFromArray(var ClassArray: TClassArray; AClass: TClass);
    function IsTreeProvider: Boolean; dynamic;
    function GetDataItemsImpl: TJvBaseDataItems;
    { IDataProvider }
    function GetItems: IJvDataItems; virtual;
    procedure RegisterChangeNotify(ANotify: IJvDataProviderNotify); dynamic;
    procedure UnregisterChangeNotify(ANotify: IJvDataProviderNotify); dynamic;
    function ConsumerClasses: TClassArray; dynamic;
    procedure SelectConsumer(Consumer: IJvDataConsumer);
    function SelectedConsumer: IJvDataConsumer;
    procedure ReleaseConsumer;
    procedure SelectContext(Context: IJvDataContext);
    function SelectedContext: IJvDataContext;
    procedure ReleaseContext;
    procedure ContextAdded(Context: IJvDataContext); dynamic;
    procedure ContextDestroying(Context: IJvDataContext); dynamic;
    procedure ConsumerDestroying(Consumer: IJvDataConsumer); dynamic;
    function AllowProviderDesigner: Boolean; dynamic;
    function AllowContextManager: Boolean; dynamic;
    function GetNotifierCount: Integer;
    function GetNotifier(Index: Integer): IJvDataProviderNotify;
    function GetImplementer: TObject;

    property DataItemsImpl: TJvBaseDataItems read GetDataItemsImpl;
    property DataContextsImpl: TJvBaseDataContexts read FDataContextsImpl;
    property Items: TJvDataProviderTree read FTreeItems write FTreeItems stored False;
    property Contexts: TJvDataProviderContexts read FContexts write FContexts stored False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    function GetInterface(const IID: TGUID; out Obj): Boolean; virtual;
  end;

  // Basic context list
  TJvBaseDataContexts = class(TExtensibleInterfacedPersistent, IJvDataContexts)
  private
    FProvider: IJvDataProvider;
    FDsgnContext: IJvDataContext;
    FAncestor: IJvDataContext;
  protected
    procedure DoAddContext(Context: IJvDataContext); virtual; abstract;
    procedure DoDeleteContext(Index: Integer); virtual; abstract;
    procedure DoRemoveContext(Context: IJvDataContext); virtual; abstract;
    procedure DoClearContexts; virtual; abstract;
    function Provider: IJvDataProvider;
    function Ancestor: IJvDataContext;
    function GetCount: Integer; virtual; abstract;
    function GetContext(Index: Integer): IJvDataContext; virtual; abstract;
    function GetContextByName(Name: string): IJvDataContext; virtual;
    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);
  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
    property Provider: IJvDataProvider read ProviderIntf write SetProvider;
    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;
    { Called when the context is about to be changed. }
    procedure ContextChanging; virtual;
    { Called when the context has changed but only after KeepOnContextChange returned True. }
    procedure ContextChanged; virtual;
    { Reference to the consumer service interface. }
    function Consumer: IJvDataConsumer;
    { Reference to the consumer service implementation. }
    function ConsumerImpl: TJvDataConsumer;
    { Retrieve the root IJvDataItems reference. }
    function RootItems: IJvDataItems;
  end;

  { Consumer sub service to select the context to use for the consumer. Only needed for design time
    purposes; use TJvDataConsumer.Context to change it directly. }
  TJvDataConsumerContext = class(TJvDataConsumerAggregatedObject, IJvDataConsumerContext)
  protected
    function GetContextID: TJvDataContextID;
    procedure SetContextID(Value: TJvDataContextID);
    function GetContext: IJvDataContext;
    procedure SetContext(Value: IJvDataContext);
  public
    property ContextIntf: IJvDataContext read GetContext write SetContext;
  published
    property Context: TJvDataContextID read GetContextID write SetContextID;
  end;

  { Consumer sub service to select the item to display or item that serves as the root. }
  TJvDataConsumerItemSelect = class(TJvDataConsumerAggregatedObject, IJvDataConsumerItemSelect)
    { Method resolutions }
    function IJvDataConsumerItemSelect.GetItem = GetItemIntf;
    procedure IJvDataConsumerItemSelect.SetItem = SetItemIntf;
  private
    FItemID: TJvDataItemID;
    FItem: IJvDataItem;
  protected
    procedure Fixup; override;
    function GetItem: TJvDataItemID;
    procedure SetItem(Value: TJvDataItemID);
    procedure DataProviderChanging(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); override;
    procedure DataProviderChanged(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); override;
  public
    function GetItemIntf: IJvDataItem;
    procedure SetItemIntf(Value: IJvDataItem);
  published
    property Item: TJvDataItemID read GetItem write SetItem;
  end;

  { Consumer sub service to maintain a flat list of the data tree. }
  TJvCustomDataConsumerViewList = class(TJvDataConsumerAggregatedObject, IJvDataConsumerViewList)
  private
    FAutoExpandLevel: Integer;
    FExpandOnNewItem: Boolean;
    FLevelIndent: Integer;
  protected
    function KeepOnProviderChange: Boolean; override;
    procedure ProviderChanging; override;
    procedure ProviderChanged; override;
    procedure ContextChanged; override;
    procedure ViewChanged(AExtension: TJvDataConsumerAggregatedObject); override;
    procedure DataProviderChanging(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); override;
    procedure DataProviderChanged(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown); override;
    function InternalItemSibling(ParentIndex: Integer; var ScanIndex: Integer): Integer;
    function Get_AutoExpandLevel: Integer;
    procedure Set_AutoExpandLevel(Value: Integer);
    function Get_ExpandOnNewItem: Boolean;
    procedure Set_ExpandOnNewItem(Value: Boolean);
    function Get_LevelIndent: Integer;
    procedure Set_LevelIndent(Value: Integer);
    { Add an item as the sub item of the item specified. The parent item will be marked as being
      expanded. }
    procedure AddItem(Index: Integer; Item: IJvDataItem; ExpandToLevel: Integer = 0); virtual; abstract;
    { Add a list of items at the specified Index. The item preceding that index will be handled as
      if it was the parent of all items to be inserted. This will also mark that item as being
      expanded. }
    procedure AddItems(var Index: Integer; Items: IJvDataItems; ExpandToLevel: Integer = 0); virtual; abstract;
    procedure AddChildItem(ParentIndex: Integer; Item: IJvDataItem); virtual; abstract;
    procedure InsertItem(InsertIndex, ParentIndex: Integer; Item: IJvDataItem); virtual; abstract;
    { Delete the specified item and the items sub tree. }
    procedure DeleteItem(Index: Integer); virtual; abstract;
    { Deletes the specified items sub tree and mark the item as not-expanded }
    procedure DeleteItems(Index: Integer); virtual; abstract;
    procedure UpdateItemFlags(Index: Integer; Value, Mask: Integer); virtual; abstract;
    procedure ClearView; virtual;
    procedure RebuildView; virtual;
  public
    constructor Create(AOwner: TExtensibleInterfacedPersistent); override;
    procedure ExpandTreeTo(Item: IJvDataItem); virtual;
    { Toggles an item's expanded state. If an item becomes expanded, the item's sub item as present
      in the IJvDataItems instance will be added; if an item becomes collapsed the sub items are
      removed from the view. }
    procedure ToggleItem(Index: Integer); virtual; abstract;
    { Locate an item in the view list, returning it's absolute index. }
    function IndexOfItem(Item: IJvDataItem): Integer; virtual; abstract;
    { Locate an item ID in the view list, returning it's absolute index. }
    function IndexOfID(ID: TJvDataItemID): Integer; virtual; abstract;
    { Locate an item in the view list, returning it's index in the parent item. }
    function ChildIndexOfItem(Item: IJvDataItem): Integer; virtual; abstract;
    { Locate an item ID in the view list, returning it's index in the parent item. }
    function ChildIndexOfID(ID: TJvDataItemID): Integer; virtual; abstract;
    { Retrieve the IJvDataItem reference given the absolute index into the view list. }
    function Item(Index: Integer): IJvDataItem; virtual; abstract;
    { Retrieve an items level given the absolute index into the view list. }
    function ItemLevel(Index: Integer): Integer; virtual; abstract;
    { Retrieve an items expanded state given the absolute index into the view list. }
    function ItemIsExpanded(Index: Integer): Boolean; virtual; abstract;
    { Determine if an item has children given the absolute index into the view list. }
    function ItemHasChildren(Index: Integer): Boolean; virtual; abstract;
    { Retrieve an items parent given the absolute index into the view list. }
    function ItemParent(Index: Integer): IJvDataItem; virtual; abstract;
    { Retrieve an items parent absolute index given the absolute index into the view list. }
    function ItemParentIndex(Index: Integer): Integer; virtual; abstract;
    { Retrieve an items sibling given an absolute index. }
    function ItemSibling(Index: Integer): IJvDataItem; virtual; abstract;
    { Retrieve the index of an items sibling given an absolute index. }
    function ItemSiblingIndex(Index: Integer): Integer; virtual; abstract;
    { Retrieve the IJvDataItem reference given the child index and a parent item. }
    function SubItem(Parent: IJvDataItem; Index: Integer): IJvDataItem; overload; virtual; abstract;
    { Retrieve the IJvDataItem reference given the child index and a parent absolute index. }
    function SubItem(Parent, Index: Integer): IJvDataItem; overload; virtual; abstract;
    { Retrieve the absolute index given a child index and a parent item. }
    function SubItemIndex(Parent: IJvDataItem; Index: Integer): Integer; overload; virtual; abstract;
    { Retrieve the absolute index given a child index and a parent absolute index. }
    function SubItemIndex(Parent, Index: Integer): Integer; overload; virtual; abstract;
    { Retrieve info on grouping; each bit represents a level, if the bit is set the item at that
      level has another sibling. Can be used to render tree lines. Note that this is very generic
      implementation that is not the fastest. To make this info readily available will require
      a descendant that stores and updates this info on a per item basis. This method can then be
      adpated to use that info directly. }
    function ItemGroupInfo(Index: Integer): TDynIntegerArray; virtual;
    { Retrieve the number of viewable items. }
    function Count: Integer; virtual; abstract;

    property AutoExpandLevel: Integer read FAutoExpandLevel write FAutoExpandLevel;
    property ExpandOnNewItem: Boolean read FExpandOnNewItem write FExpandOnNewItem;
    property LevelIndent: Integer read Get_LevelIndent write Set_LevelIndent default 16;
  end;

  { View list; uses the least possible amount of memory but may be slow to find sibling/child
    items. }
  TViewListItem = record
    ItemID: string;
    Flags: Integer; // lower 24 bits contain item level
  end;
  TViewListItems = array of TViewListItem;

  TJvDataConsumerViewList = class(TJvCustomDataConsumerViewList)
  private
    FViewItems: TViewListItems;
  protected
    procedure AddItem(Index: Integer; Item: IJvDataItem; ExpandToLevel: Integer = 0); override;
    procedure AddChildItem(ParentIndex: Integer; Item: IJvDataItem); override;
    procedure AddItems(var Index: Integer; Items: IJvDataItems; ExpandToLevel: Integer = 0); override;
    procedure InsertItem(InsertIndex, ParentIndex: Integer; Item: IJvDataItem); override;
    procedure DeleteItem(Index: Integer); override;
    procedure DeleteItems(Index: Integer); override;
    procedure UpdateItemFlags(Index: Integer; Value, Mask: Integer); override;
  public
    procedure ToggleItem(Index: Integer); override;
    function IndexOfItem(Item: IJvDataItem): Integer; override;
    function IndexOfID(ID: TJvDataItemID): Integer; override;
    function ChildIndexOfItem(Item: IJvDataItem): Integer; override;
    function ChildIndexOfID(ID: TJvDataItemID): Integer; override;
    function Item(Index: Integer): IJvDataItem; override;
    function ItemLevel(Index: Integer): Integer; override;
    function ItemIsExpanded(Index: Integer): Boolean; override;
    function ItemHasChildren(Index: Integer): Boolean; override;
    function ItemParent(Index: Integer): IJvDataItem; override;
    function ItemParentIndex(Index: Integer): Integer; override;
    function ItemSibling(Index: Integer): IJvDataItem; override;
    function ItemSiblingIndex(Index: Integer): Integer; override;
    function SubItem(Parent: IJvDataItem; Index: Integer): IJvDataItem; override;
    function SubItem(Parent, Index: Integer): IJvDataItem; override;
    function SubItemIndex(Parent: IJvDataItem; Index: Integer): Integer; override;
    function SubItemIndex(Parent, Index: Integer): Integer; override;
    function Count: Integer; override;
  published
    property LevelIndent;
  end;

  TJvDataConsumerServerNotify = class(TJvDataConsumerAggregatedObject, IJvDataConsumerServerNotify)
  private
    FClients: TJvDataConsumerClientNotifyList;
  protected
    procedure SetClients(Value: TJvDataConsumerClientNotifyList);
    procedure ItemSelected(Value: IJvDataItem); override;
    function GetOwner: TPersistent; override;
    procedure NotifyItemSelected(Value: IJvDataItem);
    { IJvDataConsumerServerNotify }
    procedure AddClient(Client: IJvDataConsumerClientNotify);
    procedure RemoveClient(Client: IJvDataConsumerClientNotify);
    procedure NotifyProviderChanged(Client: IJvDataConsumerClientNotify); virtual;
    function IsValidClient(Client: IJvDataConsumerClientNotify): Boolean; virtual;
  public
    constructor Create(AOwner: TExtensibleInterfacedPersistent); override;
    destructor Destroy; override;
  published
    property Clients: TJvDataConsumerClientNotifyList read FClients write SetClients;
  end;

  TJvDataConsumerClientNotifyList = class(TOwnedCollection)
  private
    FServer: TJvDataConsumerServerNotify;
  protected
    function GetServer: TJvDataConsumerServerNotify;
    function GetNotifyItems(I: Integer): TJvDataConsumerClientNotifyItem;
    function GetConsumer(I: Integer): IJvDataConsumer;
    procedure SetItemName(Item: TCollectionItem); override;
  public
    constructor Create(AServer: TJvDataConsumerServerNotify);

    procedure Add(AComponent: TComponent); overload;
    procedure Add(AConsumer: IJvDataConsumer); overload;
    procedure Delete(Index: Integer); overload;
    procedure Delete(AComponent: TComponent); overload;
    procedure Delete(AConsumer: IJvDataConsumer); overload;
    function IndexOf(AComponent: TComponent): Integer; overload;
    function IndexOf(AConsumer: IJvDataConsumer): Integer; overload;

    property Server: TJvDataConsumerServerNotify read GetServer;
    property NotifyItems[I: Integer]: TJvDataConsumerClientNotifyItem read GetNotifyItems;
    property Clients[I: Integer]: IJvDataConsumer read GetConsumer; default;
  end;

  TJvDataConsumerClientNotifyItem = class(TCollectionItem)
  private
    FNotifier: IJvDataConsumerClientNotify;
  protected
    function GetList: TJvDataConsumerClientNotifyList;
    function GetConsumer: IJvDataConsumer;
    function GetComponent: TComponent;
    procedure SetComponent(Value: TComponent);
    procedure SetNotifier(Value: IJvDataConsumerClientNotify);
    function GetDisplayName: string; override;
  public
    destructor Destroy; override;

    property List: TJvDataConsumerClientNotifyList read GetList;
    property Notifier: IJvDataConsumerClientNotify read FNotifier write SetNotifier;
  published
    property Component: TComponent read GetComponent write SetComponent;
  end;

  { TStrings descendant that will use the specified consumer's view list to retrieve the individual
    items.  }
  TJvConsumerStrings = class(TStrings)
  private
    FConsumer: TJvDataConsumer;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    property Consumer: TJvDataConsumer read FConsumer;
  public
    constructor Create(AConsumer: TJvDataConsumer);
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;

// Helper routines
{ Locate nearest IJvDataItems* implementation for a specific item. }
function DP_FindItemsIntf(AItem: IJvDataItem; IID: TGUID; out Obj): Boolean;
{ Locate nearest IJvDataItemsRenderer implementation for a specific item. }
function DP_FindItemsRenderer(AItem: IJvDataItem; out Renderer: IJvDataItemsRenderer): Boolean;
{ Locate nearest IJvDataItemsImages implementation for a specific item. }
function DP_FindItemsImages(AItem: IJvDataItem; out Images: IJvDataItemsImages): Boolean;
{ Generate items list to emulate trees in a flat list control }
procedure DP_GenItemsList(RootList: IJvDataItems; ItemList: TStrings);
{ Convert TOwnerDrawState to TProviderDrawStates }
function DP_OwnerDrawStateToProviderDrawState(const State: TOwnerDrawState): TProviderDrawStates;
{ Atomically select a consumer/context pair, pushing the current consumer/context onto their
  internal stacks. }
procedure DP_SelectConsumerContext(Provider: IJvDataProvider; Consumer: IJvDataConsumer; Context: IJvDataContext);
{ Atomically release a consumer/context pair, reinstating the prior pair on the respective stacks. }
procedure DP_ReleaseConsumerContext(Provider: IJvDataProvider);
{ Retrieve the specified context's name path. }
function GetContextPath(Context: IJvDataContext): string;
{ Retrieve the specified item's ID path. The path is based on the currently active context. }
function GetItemIDPath(Item: IJvDataItem): string;
{ Retrieve the specified item's index path. The path is based on the currently active context. }
function GetItemIndexPath(Item: IJvDataItem): TDynIntegerArray;
{ Determine a unique context name for the given prefix in the given context list. }
function GetUniqueCtxName(Contexts: IJvDataContexts; Prefix: string): string;
{ Determine checked state for an item, combining both consumer and provider info. }
function GetItemCheckedState(Item: IJvDataItem): TDataItemState;
{ Determine enabled state for an item, combining both consumer and provider info. }
function GetItemEnabledState(Item: IJvDataItem): TDataItemState;
{ Determine visible state for an item, combining both consumer and provider info. }
function GetItemVisibleState(Item: IJvDataItem): TDataItemState;

// Rename and move to JvFunctions? Converts a buffer into a string of hex digits.
function HexBytes(const Buf; Length: Integer): string;
// Move to other unit? Render text in a disabled way (much like TLabel does)
procedure DisabledTextRect(ACanvas: TCanvas; var ARect: TRect; Left, Top: Integer; Text: string);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Revision$';
    Date: '$Date$';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF MSWINDOWS}
  ActiveX,
  {$ENDIF MSWINDOWS}
  Types, SysUtils, TypInfo, RTLConsts,
  JclStrings,
  JvTypes, JvConsts, JvResources, JvJCLUtils;

const
  vifHasChildren = Integer($80000000);
  vifCanHaveChildren = Integer($40000000);
  vifExpanded = Integer($20000000);

  cClassName = 'ClassName';
  cName = 'Name';
  cProvider = 'Provider';

function HexBytes(const Buf; Length: Integer): string;
var
  P: PChar;
begin
  Result := '';
  P := @Buf;
  while Length > 1 do
  begin
    Result := Result + IntToHex(Ord(P^), 2);
    Inc(P);
    Dec(Length);
  end;
end;

//TODO: Copied from JvLabel.pas to avoid dependency. Must move to another unit.

type
  TShadowPosition = (spLeftTop, spLeftBottom, spRightBottom, spRightTop);

function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
  Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
  ShadowPos: TShadowPosition): Integer;
var
  RText, RShadow: TRect;
  Color: TColorRef;
  OldBkMode: Integer;
begin
  RText := Rect;
  RShadow := Rect;
  Color := SetTextColor(DC, ShadowColor);
  case ShadowPos of
    spLeftTop:
      OffsetRect(RShadow, -ShadowSize, -ShadowSize);
    spRightBottom:
      OffsetRect(RShadow, ShadowSize, ShadowSize);
    spLeftBottom:
      begin
        {OffsetRect(RText, ShadowSize, 0);}
        OffsetRect(RShadow, -ShadowSize, ShadowSize);
      end;
    spRightTop:
      begin
        {OffsetRect(RText, 0, ShadowSize);}
        OffsetRect(RShadow, ShadowSize, -ShadowSize);
      end;
  end;
  Result := DrawText(DC, Str, Count, RShadow, Format);
  if Result > 0 then
    Inc(Result, ShadowSize);
  SetTextColor(DC, Color);
  OldBkMode := SetBkMode(DC, TRANSPARENT);
  try
    DrawText(DC, Str, Count, RText, Format);
  finally
    SetBkMode(DC, OldBkMode);
  end;
  UnionRect(Rect, RText, RShadow);
end;

procedure DisabledTextRect(ACanvas: TCanvas; var ARect: TRect; Left, Top: Integer; Text: string);
begin
  ACanvas.Font.Color := clGrayText;
  DrawShadowText(ACanvas.Handle, PChar(Text), Length(Text), ARect, 0, 1, ColorToRGB(clBtnHighlight),
    spRightBottom);
end;

procedure AddItemsToList(AItems: IJvDataItems; ItemList: TStrings; Level: Integer);
var
  I: Integer;
  ThisItem: IJvDataItem;
  SubItems: IJvDataItems;
begin
  for I := 0 to AItems.Count - 1 do
  begin
    ThisItem := AItems.Items[I];
    ItemList.AddObject(ThisItem.GetID, TObject(Level));
    if Supports(ThisItem, IJvDataItems, SubItems) then
      AddItemsToList(SubItems, ItemList, Level + 1);
  end;
end;

function DP_FindItemsIntf(AItem: IJvDataItem; IID: TGUID; out Obj): Boolean;
begin
  while (AItem <> nil) and not Supports(AItem.GetItems, IID, Obj) do
    AItem := AItem.GetItems.Parent;
  Result := AItem <> nil;
end;

function DP_FindItemsRenderer(AItem: IJvDataItem; out Renderer: IJvDataItemsRenderer): Boolean;
begin
  Result := DP_FindItemsIntf(AItem, IJvDataItemsRenderer, Renderer);
end;

function DP_FindItemsImages(AItem: IJvDataItem; out Images: IJvDataItemsImages): Boolean;
begin
  Result := DP_FindItemsIntf(AItem, IJvDataItemsImages, Images);
end;

procedure DP_GenItemsList(RootList: IJvDataItems; ItemList: TStrings);
begin
  ItemList.Clear;
  AddItemsToList(RootList, ItemList, 0);
end;

function DP_OwnerDrawStateToProviderDrawState(const State: TOwnerDrawState): TProviderDrawStates;
var
  S: TOwnerDrawState;
begin
  Result := [];
  S := State; // Help the 64-bit compiler with the optimization
  if odSelected in S then
    Include(Result, pdsSelected);
  if odGrayed in S then
    Include(Result, pdsGrayed);
  if odDisabled in S then
    Include(Result, pdsDisabled);
  if odChecked in S then
    Include(Result, pdsChecked);
  if odFocused in S then
    Include(Result, pdsFocused);
  if odDefault in S then
    Include(Result, pdsDefault);
  if odHotLight in S then
    Include(Result, pdsHot);
end;

procedure DP_SelectConsumerContext(Provider: IJvDataProvider; Consumer: IJvDataConsumer; Context: IJvDataContext);
begin
  Provider.SelectConsumer(Consumer);
  try
    Provider.SelectContext(Context);
  except
    Provider.ReleaseConsumer;
    raise;
  end;
end;

procedure DP_ReleaseConsumerContext(Provider: IJvDataProvider);
var
  CurConsumer: IJvDataConsumer;
begin
  CurConsumer := Provider.SelectedConsumer;
  Provider.ReleaseConsumer;
  try
    Provider.ReleaseContext;
  except
    Provider.SelectConsumer(CurConsumer);
    raise;
  end;
end;

function IsExtensionSpecificIntf(IID: TGUID): Boolean;
begin
  Result := IsEqualGuid(IID, IJvDataContextSensitive);
end;

function GetContextPath(Context: IJvDataContext): string;
begin
  if Context <> nil then
  begin
    Result := Context.Name;
    while Context <> nil do
    begin
      Context := Context.Contexts.Ancestor;
      if Context <> nil then
        Result := Context.Name + '\' + Result;
    end;
  end;
end;

function GetItemIDPath(Item: IJvDataItem): string;
begin
  if Item <> nil then
  begin
    Result := Item.GetID;
    while Item <> nil do
    begin
      Item := Item.Items.Parent;
      if Item <> nil then
        Result := Item.GetID + '\' + Result;
    end;
  end;
end;

procedure InsertIntArray(var Arr: TDynIntegerArray; Index: Integer; Item: Integer);
begin
  SetLength(Arr, Length(Arr) + 1);
  if Index < High(Arr) then
    Move(Arr[Index], Arr[Index + 1], (High(Arr) - Index) * SizeOf(Integer));
  Arr[Index] := Item;
end;

function GetItemIndexPath(Item: IJvDataItem): TDynIntegerArray;
begin
  if Item <> nil then
  begin
    SetLength(Result, 1);
    Result[0] := Item.GetIndex;
    while Item <> nil do
    begin
      Item := Item.Items.Parent;
      if Item <> nil then
        InsertIntArray(Result, 0, Item.GetIndex);
    end;
  end
  else
    SetLength(Result, 0);
end;

function GetUniqueCtxName(Contexts: IJvDataContexts; Prefix: string): string;
var
  PrefixLen: Integer;
  SuffixNum: Int64;
  CtxIdx: Integer;
  TmpNum: Int64;
begin
  PrefixLen := Length(Prefix);
  SuffixNum := 1;
  for CtxIdx := 0 to Contexts.GetCount - 1 do
    if AnsiSameStr(Prefix, Copy(Contexts.GetContext(CtxIdx).Name, 1, PrefixLen)) then
      with Contexts.GetContext(CtxIdx) do
      begin
        if StrIsSubset(Copy(Name, PrefixLen + 1, Length(Name) - PrefixLen), CharIsDigit) then
        begin
          TmpNum := StrToInt64(Copy(Name, PrefixLen + 1, Length(Name) - PrefixLen));
          if TmpNum >= SuffixNum then
            SuffixNum := TmpNum + 1;
        end;
      end;
  Result := Prefix + IntToStr(SuffixNum);
end;

function GetItemCheckedState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.Provider;
    if Supports(Provider.SelectedConsumer, IJvDataConsumerItemState, ConsState) then
      Result := ConsState.Checked(Item);
    if (Result = disNotUsed) and Supports(Item, IJvDataItemStates, ItemState) then
      Result := ItemState.Checked;
  end;
end;

function GetItemEnabledState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.Provider;
    if Supports(Provider.SelectedConsumer, IJvDataConsumerItemState, ConsState) then
      Result := ConsState.Enabled(Item);
    if (Result <> disFalse) and Supports(Item, IJvDataItemStates, ItemState) then
      Result := ItemState.Enabled;
  end;
end;

function GetItemVisibleState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.Provider;
    if Supports(Provider.SelectedConsumer, IJvDataConsumerItemState, ConsState) then
      Result := ConsState.Visible(Item);
    if (Result in [disIndetermined, disNotUsed]) and Supports(Item, IJvDataItemStates,
        ItemState) then
      Result := ItemState.Visible;
  end;
end;

//=== { TJvDP_ProviderBaseRender } ===========================================

constructor TJvDP_ProviderBaseRender.Create(AItem: IJvDataItem; ACanvas: TCanvas; AState: TProviderDrawStates);
begin
  inherited Create;
  FItem := AItem;
  FCanvas := ACanvas;
  FState := AState;
end;

class procedure TJvDP_ProviderBaseRender.Draw(AItem: IJvDataItem; ACanvas: TCanvas; var ARect: TRect; AState: TProviderDrawStates);
begin
  with Self.Create(AItem, ACanvas, AState) do
  try
    Rect := ARect;
    Prepare(False);
    DoDraw;
  finally
    Free;
  end;
end;

class function TJvDP_ProviderBaseRender.Measure(AItem: IJvDataItem; ACanvas: TCanvas; AState: TProviderDrawStates): TSize;
begin
  with Self.Create(AItem, ACanvas, AState) do
  try
    Prepare(True);
    Result := DoMeasure;
  finally
    Free;
  end;
end;

//=== { TJvDP_ProviderTextOnlyRender } =======================================

procedure TJvDP_ProviderTextOnlyRender.Prepare(ForMeasure: Boolean);
var
  TextIntf: IJvDataItemText;
begin
  HasNoText := not Supports(Item, IJvDataItemText, TextIntf);
  if HasNoText then
    FText := RsDataItemRenderHasNoText
  else
    FText := TextIntf.Text;
end;

procedure TJvDP_ProviderTextOnlyRender.DoDraw;
begin
  Canvas.TextRect(Rect, Rect.Left, Rect.Top, FText);
end;

function TJvDP_ProviderTextOnlyRender.DoMeasure: TSize;
begin
  Result := Canvas.TextExtent(FText);
end;

//=== { TJvDP_ProviderImgAndTextRender } =====================================

procedure TJvDP_ProviderImgAndTextRender.Prepare(ForMeasure: Boolean);
var
  ImgIntf: IJvDataItemImage;
  ImgsIntf: IJvDataItemsImages;
begin
  inherited Prepare(ForMeasure);
  FImageIndex := -1;
  FImages := nil;
  if Supports(Item, IJvDataItemImage, ImgIntf) then
  begin
    FAlignment := ImgIntf.Alignment;
    if DP_FindItemsImages(Item, ImgsIntf) then
    begin
      { We have an item that supports an image and one of it's parents has an imagelist assigned. }
      if (pdsDisabled in State) and (ImgsIntf.DisabledImages <> nil) then
      begin
        FImages := ImgsIntf.DisabledImages;
        FHasDisabledImage := True;
      end
      else
      begin
        FHasDisabledImage := False;
        if (pdsHot in State) and (ImgsIntf.HotImages <> nil) then
          FImages := ImgsIntf.HotImages
        else
          FImages := ImgsIntf.Images;
      end;
      if (pdsSelected in State) and (ImgIntf.SelectedIndex <> -1) then
        FImageIndex := ImgIntf.SelectedIndex
      else
      begin
        FImageIndex := ImgIntf.ImageIndex;
        if FImageIndex < 0 then
          FImageIndex := ImgIntf.SelectedIndex;
      end;
    end;
  end;
  FHasImage := (FImages <> nil) and (FImageIndex > -1);
  if HasImage and HasNoText then
    Text := '';
end;

procedure TJvDP_ProviderImgAndTextRender.DoDraw;
var
  Rgn: HRGN;
  iSaveDC: Integer;
  TxtW: Integer;
  Clipped: Boolean;
begin
  Rgn := CreateRectRgn(0, 0, 1, 1);
  Clipped := GetClipRgn(Canvas.Handle, Rgn) = 1;
  try
    IntersectClipRect(Canvas.Handle, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    if HasImage then
    begin
      iSaveDC := SaveDC(Canvas.Handle);
      try
        // Apply alignment rules and render the image
        case Alignment of
          taLeftJustify:
            begin
              Images.Draw(Canvas, Rect.Left, Rect.Top, ImageIndex,
                  HasDisabledImage or not (pdsDisabled in State));
              Rect.Left := Rect.Left + Images.Width + 2;
            end;
          taRightJustify:
            begin
              Images.Draw(Canvas, Rect.Right - Images.Width, Rect.Top, ImageIndex,
                  HasDisabledImage or not (pdsDisabled in State));
              Rect.Right := Rect.Right - Images.Width - 2;
            end;
          taCenter:
            begin
              Images.Draw(Canvas, Rect.Left + ((Rect.Right - Rect.Left - Images.Width) div 2),
                Rect.Top, ImageIndex,  HasDisabledImage or not (pdsDisabled in State));
              Rect.Top := Rect.Top + Images.Height + 2;
              TxtW := Canvas.TextWidth(Text);
              Rect.Left := Rect.Left + ((Rect.Right - Rect.Left - TxtW) div 2);
            end;
        end;
      finally
        if iSaveDC <> 0 then
          RestoreDC(Canvas.Handle, iSaveDC);
      end;
    end;
    if pdsGrayed in State then
      Canvas.Font.Color := clGrayText;
    if (pdsDisabled in State) and not (pdsGrayed in State) then
      DisabledTextRect(Canvas, Rect, Rect.Left, Rect.Top, Text)
    else
      Canvas.TextRect(Rect, Rect.Left, Rect.Top, Text);
  finally
    if Rgn <> 0 then
    begin
      if Clipped then
        SelectClipRgn(Canvas.Handle, Rgn)
      else
        SelectClipRgn(Canvas.Handle, 0);
      DeleteObject(Rgn);
    end;
  end;
end;

function TJvDP_ProviderImgAndTextRender.DoMeasure: TSize;
begin
  if HasImage then
  begin
    // Apply alignment rules and render the image
    case Alignment of
      taLeftJustify,
      taRightJustify:
        begin
          Result := Canvas.TextExtent(Text);
          Inc(Result.cx, Images.Width + 2);
          if Images.Height > Result.cy then
            Result.cy := Images.Height;
        end;
      taCenter:
        begin
          Result := Canvas.TextExtent(Text);
          Inc(Result.cy, Images.Height + 2);
          if Images.Width > Result.cx then
            Result.cx := Images.Width;
        end;
    end;
  end
  else
    Result := inherited DoMeasure;
end;

type
  TReaderAccessProtected = class(TReader);

  {$TYPEINFO ON}
  THackWriter = class(TWriter)
    // (rom) public or protected missing
    function GetPropPath: string;
    function PropPathField: PString;
    procedure SetPropPath(const NewPath: string);
    property PropPath: string read GetPropPath write SetPropPath;
  published
    property RootAncestor;
  end;
  {$IFNDEF TYPEINFO_ON}
  {$TYPEINFO OFF}
  {$ENDIF !TYPEINFO_ON}

function THackWriter.GetPropPath: string;
begin
  Result := PropPathField^;
end;

function THackWriter.PropPathField: PString;
var
  RAPI: PPropInfo;
begin
  RAPI := GetPropInfo(THackWriter, 'RootAncestor');
  if RAPI = nil then // Should never happen
    raise EJVCLException.CreateRes(@RsEInternalError);
  Result := Pointer(UINT_PTR(RAPI.GetProc) and $00FFFFFF + UINT_PTR(Self) + 4);
end;

procedure THackWriter.SetPropPath(const NewPath: string);
begin
  if NewPath <> PropPath then
    PropPathField^ := NewPath;
end;

//=== { TJvDataItemAggregatedObject } ========================================

function TJvDataItemAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if not GetInterface(IID, Obj) then
  begin
    if IsExtensionSpecificIntf(IID) then
      Result := E_NOINTERFACE
    else
      Result := inherited QueryInterface(IID, Obj);
  end
  else
    Result := S_OK;
end;

procedure TJvDataItemAggregatedObject.ContextDestroying(Context: IJvDataContext);
begin
end;

function TJvDataItemAggregatedObject.Item: IJvDataItem;
begin
  Result := Owner as IJvDataItem;
end;

function TJvDataItemAggregatedObject.ItemImpl: TJvBaseDataItem;
begin
  Result := Owner as TJvBaseDataItem;
end;

//=== { TJvCustomDataItemsTextRenderer } =====================================

procedure TJvCustomDataItemsTextRenderer.DoDrawItem(ACanvas: TCanvas; var ARect: TRect;
  Item: IJvDataItem; State: TProviderDrawStates);
begin
  TJvDP_ProviderTextOnlyRender.Draw(Item, ACanvas, ARect, State);
end;

function TJvCustomDataItemsTextRenderer.DoMeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize;
begin
  Result := TJvDP_ProviderTextOnlyRender.Measure(Item, ACanvas, []);
end;

function TJvCustomDataItemsTextRenderer.AvgItemSize(ACanvas: TCanvas): TSize;
begin
  Result := ACanvas.TextExtent('WyWyWyWyWyWyWyWyWyWy');
end;

//=== { TJvCustomDataItemsRenderer } =========================================

procedure TJvCustomDataItemsRenderer.DoDrawItem(ACanvas: TCanvas; var ARect: TRect;
  Item: IJvDataItem; State: TProviderDrawStates);
begin
  TJvDP_ProviderImgAndTextRender.Draw(Item, ACanvas, ARect, State);
end;

function TJvCustomDataItemsRenderer.DoMeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize;
begin
  Result := TJvDP_ProviderImgAndTextRender.Measure(Item, ACanvas, []);
end;

function TJvCustomDataItemsRenderer.AvgItemSize(ACanvas: TCanvas): TSize;
begin
  Result := ACanvas.TextExtent('WyWyWyWyWyWyWyWyWyWy');
end;

//=== { TJvDataItemTextImpl } ================================================

function TJvDataItemTextImpl.GetText: string;
begin
  Result := FText;
end;

function TJvDataItemTextImpl.Editable: Boolean;
begin
  Result := True;
end;

procedure TJvDataItemTextImpl.SetText(const Value: string);
begin
  if Text <> Value then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FText := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

//=== { TJvDataItemContextTextImpl } =========================================

constructor TJvDataItemContextTextImpl.Create(AOwner: TExtensibleInterfacedPersistent);
begin
  inherited Create(AOwner);
  FContextStrings := TStringList.Create;
end;

destructor TJvDataItemContextTextImpl.Destroy;
begin
  FreeAndNil(FContextStrings);
  inherited Destroy;
end;

function TJvDataItemContextTextImpl.GetText: string;
var
  CurCtx: IJvDataContext;
begin
  CurCtx := Item.GetItems.Provider.SelectedContext;
  while (CurCtx <> nil) and (FContextStrings.IndexOfObject(TObject(CurCtx)) = -1) do
    CurCtx := CurCtx.Contexts.Ancestor;
  if (CurCtx <> nil) and (FContextStrings.IndexOfObject(TObject(CurCtx)) > -1) then
    Result := FContextStrings[FContextStrings.IndexOfObject(TObject(CurCtx))]
  else
    Result := inherited GetText;
end;

function TJvDataItemContextTextImpl.Editable: Boolean;
begin
  Result := True;
end;

procedure TJvDataItemContextTextImpl.SetText(const Value: string);
var
  CurCtx: IJvDataContext;
  I: Integer;
begin
  CurCtx := Item.GetItems.Provider.SelectedContext;
  if CurCtx <> nil then
  begin
    if Text <> Value then
    begin
      Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
      I := FContextStrings.IndexOfObject(TObject(CurCtx));
      if I > -1 then
        FContextStrings[I] := Value
      else
        FContextStrings.AddObject(Value, TObject(CurCtx));
      Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
    end;
  end
  else
    inherited SetText(Value);
end;

procedure TJvDataItemContextTextImpl.RevertToAncestor;
var
  CurCtx: IJvDataContext;
  I: Integer;
begin
  CurCtx := Item.GetItems.Provider.SelectedContext;
  if CurCtx <> nil then
  begin
    I := FContextStrings.IndexOfObject(TObject(CurCtx));
    if I > -1 then
    begin
      Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
      FContextStrings.Delete(I);
      Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
    end;
  end;
end;

function TJvDataItemContextTextImpl.IsEqualToAncestor: Boolean;
var
  CurCtx: IJvDataContext;
begin
  CurCtx := Item.GetItems.Provider.SelectedContext;
  Result := FContextStrings.IndexOfObject(TObject(CurCtx)) = -1;
end;

//=== { TJvDataItemBlockableTextImpl } ========================================

function TJvDataItemBlockableTextImpl.Editable: Boolean;
begin
  Result := not FReadOnly;
end;

procedure TJvDataItemBlockableTextImpl.SetReadOnly(Value: Boolean);
begin
  if ReadOnly <> Value then
  begin
    Item.Items.Provider.Changing(pcrUpdateItem, Item);
    FReadOnly := Value;
    Item.Items.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

//=== { TJvDataItemImageImpl } ===============================================

function TJvDataItemImageImpl.GetAlignment: TAlignment;
begin
  Result := FAlignment;
end;

procedure TJvDataItemImageImpl.SetAlignment(Value: TAlignment);
begin
  if GetAlignment <> Value then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FAlignment := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

function TJvDataItemImageImpl.GetImageIndex: Integer;
begin
  Result := FImageIndex;
end;

procedure TJvDataItemImageImpl.SetImageIndex(Index: Integer);
begin
  if GetImageIndex <> Index then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FImageIndex := Index;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

function TJvDataItemImageImpl.GetSelectedIndex: Integer;
begin
  Result := FSelectedIndex;
end;

procedure TJvDataItemImageImpl.SetSelectedIndex(Value: Integer);
begin
  if GetSelectedIndex <> Value then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FSelectedIndex := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

//=== { TExtensibleInterfacedPersistent } ====================================

constructor TExtensibleInterfacedPersistent.Create;
begin
  inherited Create;
  FAdditionalIntfImpl := TList.Create;
end;

destructor TExtensibleInterfacedPersistent.Destroy;
begin
  ClearIntfImpl;
  FreeAndNil(FAdditionalIntfImpl);
  inherited Destroy;
end;

procedure TExtensibleInterfacedPersistent.AfterConstruction;
begin
  inherited AfterConstruction;
  InitImplementers;
  // Release the constructor's implicit refcount
  InterlockedDecrement(FRefCount);
end;

procedure TExtensibleInterfacedPersistent.BeforeDestruction;
begin
  if RefCount <> 0 then
    RunError(2);
  inherited BeforeDestruction;
end;

function TExtensibleInterfacedPersistent._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TExtensibleInterfacedPersistent._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TExtensibleInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

procedure TExtensibleInterfacedPersistent.AddIntfImpl(const Obj: TAggregatedPersistentEx);
begin
  if IndexOfImplClass(TAggregatedPersistentExClass(Obj.ClassType)) >= 0 then
    raise EJVCLException.CreateRes(@RsEExtensibleIntObjDuplicateClass);
  FAdditionalIntfImpl.Add(Obj);
end;

procedure TExtensibleInterfacedPersistent.RemoveIntfImpl(const Obj: TAggregatedPersistentEx);
var
  I: Integer;
begin
  I := FAdditionalIntfImpl.IndexOf(Obj);
  if I > -1 then
  begin
    FAdditionalIntfImpl[I] := nil;
    Obj.Free;
    FAdditionalIntfImpl.Delete(I);
  end;
end;

function TExtensibleInterfacedPersistent.ImplCount: Integer;
begin
  Result := FAdditionalIntfImpl.Count;
end;

function TExtensibleInterfacedPersistent.IndexOfImplClass(const AClass: TAggregatedPersistentExClass): Integer;
begin
  Result := FAdditionalIntfImpl.Count - 1;
  while (Result >= 0) and not (TObject(FAdditionalIntfImpl[Result]) is AClass) do
    Dec(Result);
end;

procedure TExtensibleInterfacedPersistent.ClearIntfImpl;
var
  I: Integer;
  Obj: TObject;
begin
  for I := FAdditionalIntfImpl.Count - 1 downto 0 do
  begin
    Obj := TObject(FAdditionalIntfImpl[I]);
    FAdditionalIntfImpl[I] := nil;
    Obj.Free;
    FAdditionalIntfImpl.Delete(I);
  end;
  FAdditionalIntfImpl.Clear;
end;

procedure TExtensibleInterfacedPersistent.InitImplementers;
begin
end;

procedure TExtensibleInterfacedPersistent.SuspendRefCount;
begin
  InterlockedIncrement(FRefCount);
end;

procedure TExtensibleInterfacedPersistent.ResumeRefCount;
begin
  InterlockedDecrement(FRefCount);
end;

function TExtensibleInterfacedPersistent.IsStreamableExtension(AnExtension: TAggregatedPersistentEx): Boolean;
begin
  Result := GetClass(AnExtension.ClassName) <> nil;
end;

procedure TExtensibleInterfacedPersistent.DefineProperties(Filer: TFiler);
var
  I: Integer;
begin
  inherited DefineProperties(Filer);
  I := FAdditionalIntfImpl.Count - 1;
  while (I >= 0) and not IsStreamableExtension(TAggregatedPersistentEx(FAdditionalIntfImpl[I])) do
    Dec(I);
  Filer.DefineProperty('Extensions', ReadImplementers, WriteImplementers, I >= 0);
end;

procedure TExtensibleInterfacedPersistent.ReadImplementers(Reader: TReader);
begin
  { When loading implementers the interface of this object may be referenced. We don't want the
    instance destroyed yet, so reference counting will be suspended (by incrementing it) and resumed
    when we're done (by decrementing it without checking if it became zero) }
  SuspendRefCount;
  try
    if Reader.ReadValue <> vaCollection then
      raise EReadError.CreateRes(@RsEExtensibleIntObjCollectionExpected);
    while not Reader.EndOfList do
      ReadImplementer(Reader);
    Reader.ReadListEnd;
  finally
    ResumeRefCount;
  end;
end;

procedure TExtensibleInterfacedPersistent.WriteImplementers(Writer: TWriter);
var
  I: Integer;
  SavePropPath: string;
begin
  THackWriter(Writer).WriteValue(vaCollection);
  SavePropPath := THackWriter(Writer).PropPath;
  THackWriter(Writer).PropPath := '';
  try
    for I := 0 to FAdditionalIntfImpl.Count - 1 do
      if IsStreamableExtension(TAggregatedPersistentEx(FAdditionalIntfImpl[I])) then
        WriteImplementer(Writer, TAggregatedPersistentEx(FAdditionalIntfImpl[I]));
    Writer.WriteListEnd;
  finally
    THackWriter(Writer).PropPath := SavePropPath;
  end;
end;

procedure TExtensibleInterfacedPersistent.ReadImplementer(Reader: TReader);
var
  ClassName: string;
  ClassType: TPersistentClass;
  I: Integer;
  Impl: TAggregatedPersistentEx;
begin
  Reader.ReadListBegin;
  ClassName := Reader.ReadStr;
  if not AnsiSameText(ClassName, cClassName) then
    raise EReadError.CreateRes(@RsEExtensibleIntObjClassNameExpected);
  ClassName := Reader.ReadString;
  ClassType := FindClass(ClassName);
  if not ClassType.InheritsFrom(TAggregatedPersistentEx) then
    raise EReadError.CreateRes(@RsEExtensibleIntObjInvalidClass);
  I := IndexOfImplClass(TAggregatedPersistentExClass(ClassType));
  if I >= 0 then
    Impl := TAggregatedPersistentEx(FAdditionalIntfImpl[I])
  else
    Impl := TAggregatedPersistentExClass(ClassType).Create(Self);
  while not Reader.EndOfList do
    TReaderAccessProtected(Reader).ReadProperty(Impl);
  Reader.ReadListEnd;
end;

procedure TExtensibleInterfacedPersistent.WriteImplementer(Writer: TWriter;
  Instance: TAggregatedPersistentEx);
begin
  Writer.WriteListBegin;
  THackWriter(Writer).WritePropName(cClassName);
  Writer.WriteString(Instance.ClassName);
  THackWriter(Writer).WriteProperties(Instance);
  Writer.WriteListEnd;
end;

function TExtensibleInterfacedPersistent.GetImplementer(Index: Integer): TAggregatedPersistentEx;
begin
  Result := TAggregatedPersistentEx(FAdditionalIntfImpl[Index]);
end;

function TExtensibleInterfacedPersistent.GetImplOfClass(AClass: TAggregatedPersistentExClass): TAggregatedPersistentEx;
var
  idx: Integer;
begin
  idx := IndexOfImplClass(AClass);
  if idx >= 0 then
    Result := TAggregatedPersistentEx(FAdditionalIntfImpl[idx])
  else
    Result := nil;
end;

function TExtensibleInterfacedPersistent.GetInterface(const IID: TGUID; out Obj): Boolean;
var
  I: Integer;
begin
  Result := inherited GetInterface(IID, Obj);
  if not Result then
  begin
    I := FAdditionalIntfImpl.Count - 1;
    while (I >= 0) and ((FAdditionalIntfImpl[I] = nil) or TAggregatedPersistentEx(FAdditionalIntfImpl[I]).IsHidden or
        not TAggregatedPersistentEx(FAdditionalIntfImpl[I]).GetInterface(IID, Obj)) do
      Dec(I);
    Result := I >= 0;
  end;
end;

class function TExtensibleInterfacedPersistent.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  // set a refcount to avoid destruction due to refcounting during construction
  TExtensibleInterfacedPersistent(Result).FRefCount := 1;
end;

//=== { TAggregatedPersistent } ==============================================

constructor TAggregatedPersistent.Create(Controller: IUnknown);
begin
  inherited Create;
  FController := Pointer(Controller);
end;

function TAggregatedPersistent.GetController: IUnknown;
begin
  Result := IUnknown(FController);
end;

function TAggregatedPersistent.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  Result := Controller.QueryInterface(IID, Obj);
end;

function TAggregatedPersistent._AddRef: Integer;
begin
  Result := Controller._AddRef;
end;

function TAggregatedPersistent._Release: Integer;
begin
  Result := Controller._Release;
end;

function TAggregatedPersistent.GetInterface(const IID: TGUID; out Obj): Boolean;
begin
  Result := inherited GetInterface(IID, Obj);
end;

//=== { TAggregatedPersistentEx } ============================================

constructor TAggregatedPersistentEx.Create(AOwner: TExtensibleInterfacedPersistent);
begin
  inherited Create(AOwner);
  FOwner := AOwner;
end;

function TAggregatedPersistentEx.IsHidden: Boolean;
begin
  Result := False;
end;

procedure TAggregatedPersistentEx.AfterConstruction;
begin
  inherited AfterConstruction;
  FOwner.AddIntfImpl(Self);
end;

procedure TAggregatedPersistentEx.BeforeDestruction;
var
  I: Integer;
begin
  inherited BeforeDestruction;
  I := FOwner.FAdditionalIntfImpl.IndexOf(Self);
  if I >= 0 then
    FOwner.FAdditionalIntfImpl.Delete(I);
end;

//=== { TJvProviderNotification } ============================================

destructor TJvProviderNotification.Destroy;
begin
  Provider := nil;
  inherited Destroy;
end;

procedure TJvProviderNotification.SetProvider(Value: IJvDataProvider);
begin
  if Value <> Provider then
  begin
    if Provider <> nil then
      Provider.UnregisterChangeNotify(Self);
    FProvider := Value;
    if Provider <> nil then
      Provider.RegisterChangeNotify(Self);
  end;
end;

function TJvProviderNotification._AddRef: Integer;
begin
  Result := -1;
end;

function TJvProviderNotification._Release: Integer;
begin
  Result := -1;
end;

function TJvProviderNotification.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

procedure TJvProviderNotification.DataProviderChanging(const ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
  if (AReason = pcrDestroy) and (Provider <> nil) then
  begin
    Provider.UnregisterChangeNotify(Self);
    FProvider := nil;
  end;
  if Assigned(FOnChanging) then
    FOnChanging(ADataProvider, AReason, Source);
end;

procedure TJvProviderNotification.DataProviderChanged(const ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
  if Assigned(FOnChanged) then
    FOnChanged(ADataProvider, AReason, Source);
end;

function TJvProviderNotification.Consumer: IJvDataConsumer;
begin
  Result := nil;
end;

//=== { TJvBaseDataItems } ===================================================

constructor TJvBaseDataItems.Create;
begin
  inherited Create;
end;

constructor TJvBaseDataItems.Create(const Provider: IJvDataProvider);
begin
  Create;
  FProvider := Provider;
end;

constructor TJvBaseDataItems.Create(const Parent: IJvDataItem);
begin
  Create(Parent.GetItems.Provider);
  FParent := Pointer(Parent);
  if (Parent <> nil) and Parent.GetItems.IsDynamic then
    FParentIntf := Parent;
  if (Parent <> nil) and (Parent.GetImplementer is TExtensibleInterfacedPersistent) then
    FSubAggregate := TJvBaseDataItemSubItems.Create(
      TExtensibleInterfacedPersistent(Parent.GetImplementer), Self);
end;

procedure TJvBaseDataItems.ItemAdd(Item: IJvDataItem);
begin
  GetProvider.Changing(pcrAdd, Self);
  InternalAdd(Item);
  GetProvider.Changed(pcrAdd, Item);
end;

procedure TJvBaseDataItems.ItemDelete(Index: Integer);
var
  Item: IJvDataItem;
begin
  Item := GetItem(Index);
  if (Item <> nil) and (Item.IsDeletable) then
  begin
    GetProvider.Changing(pcrDelete, Item);
    Item := nil;
    InternalDelete(Index);
    GetProvider.Changed(pcrDelete, Self);
  end;
end;

procedure TJvBaseDataItems.ItemMove(OldIndex, NewIndex: Integer);
begin
  if OldIndex <> NewIndex then
  begin
    if (NewIndex <= GetCount) and (NewIndex >= 0) then
    begin
      if GetProvider.SelectedContext <> nil then
      begin
        GetProvider.Changing(pcrUpdateItems, Self);
        InternalMove(OldIndex, NewIndex);
        GetProvider.Changed(pcrUpdateItems, Self);
      end
      else
        raise EJVCLDataItems.CreateRes(@RsEItemsMayNotBeMovedInTheMainTree);
    end
    else
      raise EJVCLDataItems.CreateRes(@RsEInvalidIndex);
  end;
end;

function TJvBaseDataItems.IsStreamableItem(Item: IJvDataItem): Boolean;
var
  AClass: TPersistentClass;
begin
  AClass := GetClass(Item.GetImplementer.ClassName);
  Result := (AClass <> nil) and AClass.InheritsFrom(TJvBaseDataItem);
end;

function TJvBaseDataItems.ScanForID(Items: IJvDataItems; ID: string; Recursive: Boolean): IJvDataItem;
var
  I: Integer;
  SubItems: IJvDataItems;
begin
  if (Items <> nil) then
  begin
    Result := Items.GetItemByID(ID);
    if (Result = nil) and Recursive then
    begin
      I := Items.GetCount - 1;
      while (I >= 0) and (Result = nil) do
      begin
        if Supports(Items.GetItem(I), IJvDataItems, SubItems) then
          Result := ScanForID(SubItems, ID, True);
        Dec(I);
      end;
    end;
  end;
end;

procedure TJvBaseDataItems.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Items', ReadItems, WriteItems, True);
end;

procedure TJvBaseDataItems.ReadItems(Reader: TReader);
begin
  if Reader.ReadValue <> vaCollection then
    raise EReadError.CreateRes(@RsEExtensibleIntObjCollectionExpected);
  while not Reader.EndOfList do
    ReadItem(Reader);
  Reader.ReadListEnd;
end;

procedure TJvBaseDataItems.WriteItems(Writer: TWriter);
var
  I: Integer;
  SavePropPath: string;
begin
  THackWriter(Writer).WriteValue(vaCollection);
  SavePropPath := THackWriter(Writer).PropPath;
  THackWriter(Writer).PropPath := '';
  try
    for I := 0 to GetCount - 1 do
    begin
      if IsStreamableItem(GetItem(I)) then
        WriteItem(Writer, GetItem(I));
    end;
    Writer.WriteListEnd;
  finally
    THackWriter(Writer).PropPath := SavePropPath;
  end;
end;

procedure TJvBaseDataItems.ReadItem(Reader: TReader);
var
  PropName: string;
  ClassName: string;
  PerstClass: TPersistentClass;
  ItemClass: TJvBaseDataItemClass;
  ItemInstance: TJvBaseDataItem;
begin
  Reader.ReadListBegin;
  PropName := Reader.ReadStr;
  if not AnsiSameText(PropName, cClassName) then
    raise EReadError.CreateRes(@RsEExtensibleIntObjClassNameExpected);
  ClassName := Reader.ReadString;
  PerstClass := FindClass(ClassName);
  if not PerstClass.InheritsFrom(TJvBaseDataItem) then
    raise EReadError.CreateRes(@RsEExtensibleIntObjInvalidClass);
  ItemClass := TJvBaseDataItemClass(PerstClass);
  ItemInstance := ItemClass.Create(Self);
  try
    InternalAdd(ItemInstance);
  except
    ItemInstance.Free;
    raise;
  end;
  while not Reader.EndOfList do
    TReaderAccessProtected(Reader).ReadProperty(ItemInstance);
  Reader.ReadListEnd;
end;

procedure TJvBaseDataItems.WriteItem(Writer: TWriter; Item: IJvDataItem);
var
  Inst: TPersistent;
begin
  Writer.WriteListBegin;
  Inst := TPersistent(Item.GetImplementer);
  Writer.WriteStr(cClassName);
  Writer.WriteString(Inst.ClassName);
  THackWriter(Writer).WriteProperties(Inst);
  Writer.WriteListEnd;
end;

function TJvBaseDataItems.GetItemByID(ID: string): IJvDataItem;
var
  CurItems: IJvDataItems;
  PathSep: Integer;
  PathSep2: Integer;
  ThisPath: string;
  Idx: Integer;
begin
  CurItems := Self;
  while (CurItems <> nil) and (Result = nil) and (ID <> '') do
  begin
    PathSep := Pos('\', ID);
    PathSep2 := Pos('/', ID);
    if (PathSep > PathSep2) or (PathSep = 0) then
      PathSep := PathSep2;
    if PathSep = 0 then
      PathSep := Length(ID) + 1;
    ThisPath := Copy(ID, 1, PathSep - 1);
    if ThisPath = '..' then
    begin
      if GetParent <> nil then
        CurItems := GetParent.GetItems
      else
        CurItems := nil;
    end
    else
    if (ThisPath = '') and (GetParent <> nil) and (PathSep <> 0) then
      CurItems := GetProvider.GetItems
    else
    begin
      Idx := CurItems.GetCount - 1;
      while (Idx >= 0) and not AnsiSameText(CurItems.GetItem(Idx).GetID, ThisPath) do
        Dec(Idx);
      Delete(ID, 1, PathSep);
      if Idx >= 0 then
      begin
        if ID = '' then
          Result := CurItems.GetItem(Idx)
        else
          Supports(CurItems.GetItem(Idx), IJvDataItems, CurItems);
      end;
    end;
  end;
end;

function TJvBaseDataItems.GetItemByIndexPath(IndexPath: array of Integer): IJvDataItem;
var
  Idx: Integer;
  ItemList: IJvDataItems;
begin
  if Length(IndexPath) > 0 then
  begin
    ItemList := Self;
    Idx := 0;
    while (Idx < Length(IndexPath)) do
    begin
      Supports(ItemList.GetItem(IndexPath[Idx]), IJvDataItems, ItemList);
      Inc(Idx);
    end;
    Result := ItemList.GetParent;
  end;
end;

function TJvBaseDataItems.GetParent: IJvDataItem;
begin
  Result := IJvDataItem(FParent);
end;

function TJvBaseDataItems.GetProvider: IJvDataProvider;
begin
  Result := FProvider;
end;

function TJvBaseDataItems.GetImplementer: TObject;
begin
  Result := Self;
end;

function TJvBaseDataItems.IsDynamic: Boolean;
begin
  Result := True;
end;

procedure TJvBaseDataItems.ContextDestroying(Context: IJvDataContext);
var
  I: Integer;
begin
  for I := 0 to FAdditionalIntfImpl.Count - 1 do
    TJvDataItemsAggregatedObject(FAdditionalIntfImpl[I]).ContextDestroying(Context);
  for I := 0 to GetCount - 1 do
    GetItem(I).ContextDestroying(Context);
end;

function TJvBaseDataItems.FindByID(ID: string; const Recursive: Boolean): IJvDataItem;
begin
  Result := ScanForID(Self, ID, Recursive);
end;

procedure TJvBaseDataItems.BeforeDestruction;
begin
  inherited BeforeDestruction;
  if FSubAggregate <> nil then
    FreeAndNil(FSubAggregate);
end;

//=== { TJvBaseDataItemSubItems } ============================================

constructor TJvBaseDataItemSubItems.Create(AOwner: TExtensibleInterfacedPersistent;
  AItems: TJvBaseDataItems);
begin
  inherited Create(AOwner);
  FItems := AItems;
end;

procedure TJvBaseDataItemSubItems.BeforeDestruction;
begin
  inherited BeforeDestruction;
  if FItems.GetImplementer is TJvBaseDataItems then
    TJvBaseDataItems(FItems.GetImplementer).FSubAggregate := nil;
end;

function TJvBaseDataItemSubItems.GetInterface(const IID: TGUID; out Obj): Boolean;
begin
  Result := inherited GetInterface(IID, Obj) or Succeeded(FItems.QueryInterface(IID, Obj));
end;

//=== { TJvCustomDataItemTextRenderer } ======================================

procedure TJvCustomDataItemTextRenderer.Draw(ACanvas: TCanvas; var ARect: TRect; State: TProviderDrawStates);
begin
  TJvDP_ProviderTextOnlyRender.Draw(Item, ACanvas, ARect, State);
end;

function TJvCustomDataItemTextRenderer.Measure(ACanvas: TCanvas): TSize;
begin
  Result := TJvDP_ProviderTextOnlyRender.Measure(Item, ACanvas, []);
end;

//=== { TJvCustomDataItemRenderer } ==========================================

procedure TJvCustomDataItemRenderer.Draw(ACanvas: TCanvas; var ARect: TRect; State: TProviderDrawStates);
begin
  TJvDP_ProviderImgAndTextRender.Draw(Item, ACanvas, ARect, State);
end;

function TJvCustomDataItemRenderer.Measure(ACanvas: TCanvas): TSize;
begin
  Result := TJvDP_ProviderImgAndTextRender.Measure(Item, ACanvas, []);
end;

//=== { TJvCustomDataItemStates } ============================================

procedure TJvCustomDataItemStates.InitStatesUsage(UseEnabled, UseChecked, UseVisible: Boolean);
begin
  if UseEnabled then
    FEnabled := disTrue
  else
    FEnabled := disNotUsed;
  if UseChecked then
    FChecked := disFalse
  else
    FChecked := disNotUsed;
  if UseVisible then
    FVisible := disTrue
  else
    FVisible := disNotUsed;
end;

function TJvCustomDataItemStates.Get_Enabled: TDataItemState;
begin
  Result := FEnabled;
end;

procedure TJvCustomDataItemStates.Set_Enabled(Value: TDataItemState);
begin
  if Value = disNotUsed then
    Exit;
  if Value <> Get_Enabled then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FEnabled := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

function TJvCustomDataItemStates.Get_Checked: TDataItemState;
begin
  Result := FChecked;
end;

procedure TJvCustomDataItemStates.Set_Checked(Value: TDataItemState);
begin
  if Value = disNotUsed then
    Exit;
  if Value <> Get_Checked then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FChecked := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

function TJvCustomDataItemStates.Get_Visible: TDataItemState;
begin
  Result := FVisible;
end;

procedure TJvCustomDataItemStates.Set_Visible(Value: TDataItemState);
begin
  if Value = disNotUsed then
    Exit;
  if Value <> Get_Visible then
  begin
    Item.GetItems.Provider.Changing(pcrUpdateItem, Item);
    FVisible := Value;
    Item.GetItems.Provider.Changed(pcrUpdateItem, Item);
  end;
end;

//=== { TJvDataItemsAggregatedObject } =======================================

procedure TJvDataItemsAggregatedObject.ContextDestroying(Context: IJvDataContext);
begin
end;

function TJvDataItemsAggregatedObject.Items: IJvDataItems;
begin
  Result := Owner as IJvDataItems;
end;

function TJvDataItemsAggregatedObject.ItemsImpl: TJvBaseDataItems;
begin
  Result := Owner as TJvBaseDataItems;
end;

//=== { TJvBaseDataItemsRenderer } ===========================================

procedure TJvBaseDataItemsRenderer.DrawItemByIndex(ACanvas: TCanvas; var ARect: TRect;
  Index: Integer; State: TProviderDrawStates);
begin
  if (Index < 0) or (Index >= Items.Count) then
    raise EJVCLDataItems.CreateResFmt(@SListIndexError, [Index]);
  DrawItem(ACanvas, ARect, Items.Items[Index], State);
end;

function TJvBaseDataItemsRenderer.MeasureItemByIndex(ACanvas: TCanvas; Index: Integer): TSize;
begin
  if Index = -1 then
    Result := AvgItemSize(ACanvas)
  else
  begin
    if (Index < 0) or (Index >= Items.Count) then
      raise EJVCLDataItems.CreateResFmt(@SListIndexError, [Index]);
    Result := MeasureItem(ACanvas, Items.Items[Index]);
  end;
end;

procedure TJvBaseDataItemsRenderer.DrawItem(ACanvas: TCanvas; var ARect: TRect; Item: IJvDataItem;
  State: TProviderDrawStates);
var
  ImgRender: IJvDataItemRenderer;
begin
  if Supports(Item, IJvDataItemRenderer, ImgRender) then
    ImgRender.Draw(ACanvas, ARect, State)
  else
    DoDrawItem(ACanvas, ARect, Item, State);
end;

function TJvBaseDataItemsRenderer.MeasureItem(ACanvas: TCanvas; Item: IJvDataItem): TSize;
var
  ImgRender: IJvDataItemRenderer;
begin
  if Supports(Item, IJvDataItemRenderer, ImgRender) then
    Result := ImgRender.Measure(ACanvas)
  else
    Result := DoMeasureItem(ACanvas, Item);
end;

//=== { TJvDataItemsList } ===================================================

constructor TJvDataItemsList.Create;
begin
  inherited Create;
  FList := TObjectList.Create;
end;

destructor TJvDataItemsList.Destroy;
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TJvDataItemsList.InternalAdd(Item: IJvDataItem);
begin
  List.Add(Item.GetImplementer);
end;

procedure TJvDataItemsList.InternalDelete(Index: Integer);
begin
  List.Delete(Index);
end;

procedure TJvDataItemsList.InternalMove(OldIndex, NewIndex: Integer);
begin
  List.Move(OldIndex, NewIndex);
end;

function TJvDataItemsList.IsDynamic: Boolean;
begin
  Result := False;
end;

function TJvDataItemsList.GetCount: Integer;
begin
  Result := List.Count;
end;

function TJvDataItemsList.GetItem(I: Integer): IJvDataItem;
begin
  Result := (List[I] as TJvBaseDataItem) as IJvDataItem;
end;

//=== { TJvBaseDataItemsListManagement } =====================================

function TJvBaseDataItemsListManagement.Add(Item: IJvDataItem): IJvDataItem;
begin
  Items.Provider.Changing(pcrAdd, Items);
  TJvDataItemsList(ItemsImpl).List.Add(Item.GetImplementer);
  Result := Item;
  Items.Provider.Changed(pcrAdd, Result);
end;

procedure TJvBaseDataItemsListManagement.Clear;
begin
  Items.Provider.Changing(pcrUpdateItems, Items);
  TJvDataItemsList(ItemsImpl).List.Clear;
  Items.Provider.Changed(pcrUpdateItems, Items);
end;

procedure TJvBaseDataItemsListManagement.Delete(Index: Integer);
begin
  if (Items.GetItem(Index) <> nil) and Items.GetItem(Index).IsDeletable then
  begin
    Items.Provider.Changing(pcrDelete, Items.GetItem(Index));
    TJvDataItemsList(ItemsImpl).List.Delete(Index);
    Items.Provider.Changed(pcrDelete, nil);
  end
  else
  if Items.GetItem(Index) <> nil then
    raise EJVCLDataItems.CreateRes(@RsEItemCanNotBeDeleted);
end;

procedure TJvBaseDataItemsListManagement.Remove(var Item: IJvDataItem);
var
  Impl: TObject;
begin
  if (Item <> nil) and Item.IsDeletable then
  begin
    Impl := Item.GetImplementer;
    Pointer(Item) := nil;
    if (Impl is TExtensibleInterfacedPersistent) and
        (TExtensibleInterfacedPersistent(Impl).RefCount = 0) then
    begin
      TExtensibleInterfacedPersistent(Impl).SuspendRefCount;
      try
        Item := TExtensibleInterfacedPersistent(Impl) as IJvDataItem;
        try
          Items.Provider.Changing(pcrDelete, Item);
        finally
          Pointer(Item) := nil;
        end;
      finally
        TExtensibleInterfacedPersistent(Impl).ResumeRefCount;
      end;
      TJvDataItemsList(ItemsImpl).List.Remove(Impl);
      Items.Provider.Changed(pcrDelete, nil);
    end;
  end
  else
  if Item <> nil then
    raise EJVCLDataItems.CreateRes(@RsEItemCanNotBeDeleted);
end;

//=== { TJvCustomDataItemsImages } ===========================================

function TJvCustomDataItemsImages.GetDisabledImages: TCustomImageList;
begin
  Result := FDisabledImages;
end;

procedure TJvCustomDataItemsImages.SetDisabledImages(const Value: TCustomImageList);
begin
  if Value <> GetDisabledImages then
  begin
    (Owner as IJvDataItems).Provider.Changing(pcrUpdateItems, Items);
    FDisabledImages := Value;
    (Owner as IJvDataItems).Provider.Changed(pcrUpdateItems, Items);
  end;
end;

function TJvCustomDataItemsImages.GetHotImages: TCustomImageList;
begin
  Result := FHotImages;
end;

procedure TJvCustomDataItemsImages.SetHotImages(const Value: TCustomImageList);
begin
  if Value <> GetHotImages then
  begin
    (Owner as IJvDataItems).Provider.Changing(pcrUpdateItems, Items);
    FHotImages := Value;
    (Owner as IJvDataItems).Provider.Changed(pcrUpdateItems, Items);
  end;
end;

function TJvCustomDataItemsImages.GetImages: TCustomImageList;
begin
  Result := FImages;
end;

procedure TJvCustomDataItemsImages.SetImages(const Value: TCustomImageList);
begin
  if Value <> GetImages then
  begin
    (Owner as IJvDataItems).Provider.Changing(pcrUpdateItems, Items);
    FImages := Value;
    (Owner as IJvDataItems).Provider.Changed(pcrUpdateItems, Items);
  end;
end;

//=== { TJvBaseDataItem } ====================================================

constructor TJvBaseDataItem.Create(AOwner: IJvDataItems);
begin
  inherited Create;
  FItems := Pointer(AOwner);
  // Dynamically generated items will need a hard reference to the IJvDataItems owner.
  if AOwner.IsDynamic then
    FItemsIntf := AOwner;
end;

procedure TJvBaseDataItem.AfterConstruction;
begin
  InitID;
  inherited AfterConstruction;
end;

procedure TJvBaseDataItem.InitID;
var
  G: TGUID;
begin
  CoCreateGuid(G);
  FID := HexBytes(G, SizeOf(G));
end;

procedure TJvBaseDataItem.SetID(Value: string);
begin
  FID := Value;
end;

function TJvBaseDataItem._AddRef: Integer;
begin
  GetItems.GetProvider.SelectContext(nil);
  try
    if GetItems.IsDynamic then
      Result := inherited _AddRef
    else
      Result := -1;
  finally
    GetItems.GetProvider.ReleaseContext;
  end;
end;

function TJvBaseDataItem._Release: Integer;
var
  NeedsRelease: Boolean;
begin
  GetItems.GetProvider.SelectContext(nil);
  try
    NeedsRelease := GetItems.IsDynamic;
  finally
    GetItems.GetProvider.ReleaseContext;
  end;
  if NeedsRelease then
    Result := inherited _Release
  else
    Result := -1;
end;

procedure TJvBaseDataItem.DefineProperties(Filer: TFiler);
var
  Tmp: IJvDataItems;
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SubItems', ReadSubItems, WriteSubItems,
    Supports(Self as IJvDataItem, IJvDataItems, Tmp));
end;

procedure TJvBaseDataItem.ReadSubItems(Reader: TReader);
var
  PropName: string;
  ClassName: string;
  AClass: TPersistentClass;
  I: Integer;
begin
  { When loading sub items the interface of this object may be referenced. We don't want the
    instance destroyed yet, so reference counting will be suspended (by incrementing it) and resumed
    when we're done (by decrementing it without checking if it became zero) }
  SuspendRefCount;
  try
    if Reader.ReadValue <> vaCollection then
      raise EReadError.CreateRes(@RsEExtensibleIntObjCollectionExpected);
    Reader.ReadListBegin;
    PropName := Reader.ReadStr;
    if not AnsiSameText(PropName, cClassName) then
      raise EReadError.CreateRes(@RsEExtensibleIntObjClassNameExpected);
    ClassName := Reader.ReadString;
    AClass := FindClass(ClassName);
    if not AClass.InheritsFrom(TJvBaseDataItems) then
      raise EReadError.CreateRes(@RsEExtensibleIntObjInvalidClass);
    I := IndexOfImplClass(TJvBaseDataItemSubItems);
    if I > -1 then
    begin
      if TJvBaseDataItemSubItems(FAdditionalIntfImpl[I]).Items.GetImplementer.ClassType <> AClass then
      begin
        FAdditionalIntfImpl.Delete(I);
        I := -1;
      end;
    end;
    if I = -1 then
    begin
      TJvDataItemsClass(AClass).Create(Self);
      I := IndexOfImplClass(TJvBaseDataItemSubItems);
    end;
    while not Reader.EndOfList do
      TReaderAccessProtected(Reader).ReadProperty(
        TJvBaseDataItems(TJvBaseDataItemSubItems(FAdditionalIntfImpl[I]).Items.GetImplementer));
    Reader.ReadListEnd;
    Reader.ReadListEnd;
  finally
    ResumeRefCount;
  end;
end;

procedure TJvBaseDataItem.WriteSubItems(Writer: TWriter);
var
  Items: IJvDataItems;
  SavePropPath: string;
begin
  QueryInterface(IJvDataItems, Items);
  THackWriter(Writer).WriteValue(vaCollection);
  SavePropPath := THackWriter(Writer).PropPath;
  THackWriter(Writer).PropPath := '';
  try
    Writer.WriteListBegin;
    Writer.WriteStr(cClassName);
    Writer.WriteString(Items.GetImplementer.ClassName);
    THackWriter(Writer).WriteProperties(Items.GetImplementer as TPersistent);
    Writer.WriteListEnd;
    Writer.WriteListEnd;
  finally
    THackWriter(Writer).PropPath := SavePropPath;
  end;
end;

function TJvBaseDataItem.GetItems: IJvDataItems;
begin
  Result := IJvDataItems(FItems);
end;

function TJvBaseDataItem.GetNamePath: string;
var
  Comp: TPersistent;
begin
  Comp := GetOwner;
  if (Comp <> nil) and (Comp is TComponent) then
    Result := (Comp as TComponent).Name
  else
    Result := RsUnknown;
  Result := Result + ': Item[' + GetID + ']';
end;

function TJvBaseDataItem.GetOwner: TPersistent;
begin
  if Items <> nil then
    Result := (Items.Provider as IInterfaceComponentReference).GetComponent
  else
    Result := inherited GetOwner;
end;

function TJvBaseDataItem.GetIndex: Integer;
var
  Owner: IJvDataItems;
begin
  Owner := GetItems;
  Result := Owner.GetCount - 1;
  while (Result >= 0) and (Owner.GetItem(Result) <> Self as IJvDataItem) do
    Dec(Result);
end;

function TJvBaseDataItem.GetImplementer: TObject;
begin
  Result := Self;
end;

function TJvBaseDataItem.GetID: string;
begin
  Result := FID;
end;

procedure TJvBaseDataItem.ContextDestroying(Context: IJvDataContext);
var
  I: Integer;
  SubItems: IJvDataItems;
begin
  for I := 0 to FAdditionalIntfImpl.Count - 1 do
    TJvDataItemAggregatedObject(FAdditionalIntfImpl[I]).ContextDestroying(Context);
  if Supports(Self as IJvDataItem, IJvDataItems, SubItems) then
    SubItems.ContextDestroying(Context);
end;

function TJvBaseDataItem.IsParentOf(AnItem: IJvDataItem; DirectParent: Boolean): Boolean;
begin
  Result := AnItem.GetItems.Parent = (Self as IJvDataItem);
  if not Result and not DirectParent then
  begin
    AnItem := AnItem.GetItems.Parent;
    while (AnItem <> nil) and (AnItem <> (Self as IJvDataItem)) do
      AnItem := AnItem.GetItems.Parent;
    Result := AnItem = (Self as IJvDataItem);
  end;
end;

function TJvBaseDataItem.IsDeletable: Boolean;
begin
  Result := True;
end;

procedure TJvBaseDataItem.RevertToAncestor;
var
  I: Integer;
  Inst: TJvDataItemAggregatedObject;
  CtxSens: IJvDataContextSensitive;
begin
  for I := 0 to FAdditionalIntfImpl.Count - 1 do
  begin
    Inst := TJvDataItemAggregatedObject(FAdditionalIntfImpl[I]);
    if Inst.GetInterface(IJvDataContextSensitive, CtxSens) then
      CtxSens.RevertToAncestor;
  end;
end;

function TJvBaseDataItem.IsEqualToAncestor: Boolean;
var
  I: Integer;
  Inst: TJvDataItemAggregatedObject;
  CtxSens: IJvDataContextSensitive;
begin
  Result := True;
  I := 0;
  while Result and (I < FAdditionalIntfImpl.Count) do
  begin
    Inst := TJvDataItemAggregatedObject(FAdditionalIntfImpl[I]);
    if Inst.GetInterface(IJvDataContextSensitive, CtxSens) then
      Result := CtxSens.IsEqualToAncestor;
    Inc(I);
  end;
end;

//=== { TJvCustomDataProvider } ==============================================

constructor TJvCustomDataProvider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNotifiers := TInterfaceList.Create;
  FConsumerStack := TInterfaceList.Create;
  FContextStack := TInterfaceList.Create;
  if ContextsClass <> nil then
  begin
    FDataContextsImpl := ContextsClass.Create(Self, nil, ContextsManagerClass);
    FDataContextsIntf := FDataContextsImpl;
  end;
  if ItemsClass <> nil then
    FDataItems := ItemsClass.Create(Self)
  else
    raise EJVCLDataProvider.CreateRes(@RsEDataProviderNeedsItemsImpl);
end;

destructor TJvCustomDataProvider.Destroy;
begin
  FreeAndNil(FNotifiers);
  FreeAndNil(FConsumerStack);
  FreeAndNil(FContextStack);
  inherited Destroy;
end;

procedure TJvCustomDataProvider.BeforeDestruction;
begin
  inherited BeforeDestruction;
  Changing(pcrDestroy);
end;

function TJvCustomDataProvider.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

procedure TJvCustomDataProvider.Changing(ChangeReason: TDataProviderChangeReason; Source: IUnknown);
var
  I: Integer;
begin
  for I := FNotifiers.Count - 1 downto 0 do
    (FNotifiers[I] as IJvDataProviderNotify).DataProviderChanging(Self, ChangeReason, Source);
  if ChangeReason = pcrContextDelete then
    ContextDestroying(IJvDataContext(Source));
end;

procedure TJvCustomDataProvider.Changed(ChangeReason: TDataProviderChangeReason; Source: IUnknown);
var
  I: Integer;
begin
  for I := FNotifiers.Count - 1 downto 0 do
    (FNotifiers[I] as IJvDataProviderNotify).DataProviderChanged(Self, ChangeReason, Source);
  if ChangeReason = pcrContextAdd then
    ContextAdded(IJvDataContext(Source));
end;

class function TJvCustomDataProvider.PersistentDataItems: Boolean;
begin
  Result := False;
end;

class function TJvCustomDataProvider.ItemsClass: TJvDataItemsClass;
begin
  Result := TJvDataItemsList;
end;

class function TJvCustomDataProvider.ContextsClass: TJvDataContextsClass;
begin
  Result := nil;
end;

class function TJvCustomDataProvider.ContextsManagerClass: TJvDataContextsManagerClass;
begin
  Result := nil;
end;

procedure TJvCustomDataProvider.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  if (ContextsClass <> nil) and (ContextsManagerClass <> nil) then
    Filer.DefineProperty('ContextList', ReadContexts, WriteContexts, True);
  if PersistentDataItems then
    Filer.DefineProperty('Root', ReadRoot, WriteRoot, True);
end;

procedure TJvCustomDataProvider.ReadRoot(Reader: TReader);
begin
  if Reader.ReadValue <> vaCollection then
    raise EReadError.CreateRes(@RsEExtensibleIntObjCollectionExpected);
  Reader.ReadListBegin;
  // We don't really have a root item; just stream in the DataItemsImpl instance.
  while not Reader.EndOfList do
    TReaderAccessProtected(Reader).ReadProperty(DataItemsImpl);
  // (rom) why twice? Please comment.
  Reader.ReadListEnd;
  Reader.ReadListEnd;
end;

procedure TJvCustomDataProvider.WriteRoot(Writer: TWriter);
begin
  THackWriter(Writer).WriteValue(vaCollection);
  Writer.WriteListBegin;
  // We don't really have a root item; just stream out the DataItemsImpl instance.
  THackWriter(Writer).WriteProperties(DataItemsImpl);
  // (rom) why twice? Please comment.
  Writer.WriteListEnd;
  Writer.WriteListEnd;
end;

procedure TJvCustomDataProvider.ReadContexts(Reader: TReader);
var
  I: Integer;
begin
  if Reader.ReadValue <> vaCollection then
    raise EReadError.CreateRes(@RsEExtensibleIntObjCollectionExpected);
  for I := DataContextsImpl.GetCount - 1 downto 0 do
    if DataContextsImpl.GetContext(I).IsDeletable then
      DataContextsImpl.DoDeleteContext(I);
  I := 0;
  while not Reader.EndOfList do
  begin
    ReadContext(Reader, I);
    Inc(I);
  end;
  Reader.ReadListEnd;
end;

procedure TJvCustomDataProvider.WriteContexts(Writer: TWriter);
var
  I: Integer;
begin
  THackWriter(Writer).WriteValue(vaCollection);
  for I := 0 to FDataContextsImpl.GetCount - 1 do
    if not FDataContextsImpl.GetContext(I).IsDeletable and
        TJvBaseDataContext(FDataContextsImpl.GetContext(I).GetImplementer).IsStreamable then
      WriteContext(Writer, FDataContextsImpl.GetContext(I));
  for I := 0 to FDataContextsImpl.GetCount - 1 do
    if FDataContextsImpl.GetContext(I).IsDeletable then
      WriteContext(Writer, FDataContextsImpl.GetContext(I));
  Writer.WriteListEnd;
end;

procedure TJvCustomDataProvider.ReadContext(Reader: TReader; Index: Integer);
var
  ClassName: string;
  ClassType: TClass;
  CtxName: string;
  CtxInst: TJvBaseDataContext;
begin
  Reader.ReadListBegin;
  ClassType := nil;
  if Index >= DataContextsImpl.GetCount then
  begin
    ClassName := Reader.ReadStr;
    if not AnsiSameText(ClassName, cClassName) then
      raise EReadError.CreateRes(@RsEExtensibleIntObjClassNameExpected);
    ClassName := Reader.ReadString;
    ClassType := FindClass(ClassName);
    if not ClassType.InheritsFrom(TJvBaseDataContext) then
      raise EReadError.CreateRes(@RsEExtensibleIntObjInvalidClass);
  end;
  CtxName := Reader.ReadStr;
  if not AnsiSameText(CtxName, cName) then
    raise EReadError.CreateRes(@RsEContextNameExpected);
  CtxName := Reader.ReadString;
  if Index >= DataContextsImpl.GetCount then
  begin
    CtxInst := TJvDataContextClass(ClassType).Create(FDataContextsImpl, CtxName);
    try
      FDataContextsImpl.DoAddContext(CtxInst);
    except
      CtxInst.Free;
      raise;
    end;
  end
  else
    CtxInst := TJvBaseDataContext(DataContextsImpl.GetContextByName(CtxName).GetImplementer);
  while not Reader.EndOfList do
    TReaderAccessProtected(Reader).ReadProperty(CtxInst);
  Reader.ReadListEnd;
end;

procedure TJvCustomDataProvider.WriteContext(Writer: TWriter; AContext: IJvDataContext);
begin
  Writer.WriteListBegin;
  if AContext.IsDeletable then
  begin
    Writer.WriteStr(cClassName);
    Writer.WriteString(AContext.GetImplementer.ClassName);
  end;
  Writer.WriteStr(cName);
  Writer.WriteString(AContext.Name);
  THackWriter(Writer).WriteProperties(TPersistent(AContext.GetImplementer));
  Writer.WriteListEnd;
end;

procedure TJvCustomDataProvider.AddToArray(var ClassArray: TClassArray; AClass: TClass);
begin
  SetLength(ClassArray, Length(ClassArray) + 1);
  ClassArray[High(ClassArray)] := AClass;
end;

procedure TJvCustomDataProvider.DeleteFromArray(var ClassArray: TClassArray; Index: Integer);
begin
  if (Index >= 0) and (Index <= High(ClassArray)) then
  begin
    if Index < High(ClassArray) then
      Move(ClassArray[Index + 1], ClassArray[Index], SizeOf(TClass) * (High(ClassArray) - Index));
    SetLength(ClassArray, High(ClassArray));
  end;
end;

function TJvCustomDataProvider.IndexOfClass(AClassArray: TClassArray; AClass: TClass): Integer;
begin
  Result := High(AClassArray);
  while (Result >= 0) and (AClassArray[Result] <> AClass) do
    Dec(Result);
end;

procedure TJvCustomDataProvider.RemoveFromArray(var ClassArray: TClassArray; AClass: TClass);
var
  I: Integer;
begin
  I := IndexOfClass(ClassArray, AClass);
  if I > -1 then
    DeleteFromArray(ClassArray, I);
end;

function TJvCustomDataProvider.IsTreeProvider: Boolean;
var
  I: Integer;
  Obj: IJvDataItems;
begin
  I := GetItems.Count - 1;
  while (I >= 0) and not Supports(GetItems.GetItem(I), IJvDataItems, Obj) do
    Dec(I);
  Result := I >= 0;
end;

function TJvCustomDataProvider.GetDataItemsImpl: TJvBaseDataItems;
begin
  if FDataItems <> nil then
    Result := TJvBaseDataItems(FDataItems.GetImplementer)
  else
    Result := nil;
end;

function TJvCustomDataProvider.GetItems: IJvDataItems;
begin
  Result := FDataItems;
end;

procedure TJvCustomDataProvider.RegisterChangeNotify(ANotify: IJvDataProviderNotify);
begin
  if FNotifiers.IndexOf(ANotify) < 0 then
    FNotifiers.Add(ANotify);
end;

procedure TJvCustomDataProvider.UnregisterChangeNotify(ANotify: IJvDataProviderNotify);
begin
  FNotifiers.Remove(ANotify);
end;

function TJvCustomDataProvider.ConsumerClasses: TClassArray;
var
  Obj: IUnknown;
begin
  SetLength(Result, 0);

  // Generic provider based extensions
  if Supports(Self as IJvDataProvider, IJvDataContexts, Obj) then
    AddToArray(Result, TJvDataConsumerContext);

  // Consumer based extensions
  if SelectedConsumer <> nil then
  begin
    // Generic consumer based extensions
    if SelectedConsumer.AttributeApplies(DPA_RendersSingleItem) or IsTreeProvider then
      AddToArray(Result, TJvDataConsumerItemSelect);
    if SelectedConsumer.AttributeApplies(DPA_ConsumerDisplaysList) then
      AddToArray(Result, TJvDataConsumerViewList);
  end;
end;

procedure TJvCustomDataProvider.SelectConsumer(Consumer: IJvDataConsumer);
begin
  if FConsumerStack <> nil then
    FConsumerStack.Insert(0, Consumer);
end;

function TJvCustomDataProvider.SelectedConsumer: IJvDataConsumer;
begin
  if (FConsumerStack <> nil) and (FConsumerStack.Count > 0) then
    Result := IJvDataConsumer(FConsumerStack[0])
  else
    Result := nil;
end;

procedure TJvCustomDataProvider.ReleaseConsumer;
begin
  if (FConsumerStack <> nil) and (FConsumerStack.Count > 0) then
    FConsumerStack.Delete(0)
  else
  if FConsumerStack <> nil then
    raise EJVCLDataProvider.CreateRes(@RsEConsumerStackIsEmpty);
end;

procedure TJvCustomDataProvider.SelectContext(Context: IJvDataContext);
begin
  if FContextStack <> nil then
  FContextStack.Insert(0, Context);
end;

function TJvCustomDataProvider.SelectedContext: IJvDataContext;
begin
  if (FContextStack <> nil) and (FContextStack.Count > 0) then
    Result := IJvDataContext(FContextStack[0])
  else
    Result := nil;
end;

procedure TJvCustomDataProvider.ReleaseContext;
begin
  if (FContextStack <> nil) and (FContextStack.Count > 0) then
    FContextStack.Delete(0)
  else
  if FContextStack <> nil then
    raise EJVCLDataProvider.CreateRes(@RsEContextStackIsEmpty);
end;

procedure TJvCustomDataProvider.ContextAdded(Context: IJvDataContext);
begin
end;

procedure TJvCustomDataProvider.ContextDestroying(Context: IJvDataContext);
begin
  DataItemsImpl.ContextDestroying(Context);
end;

procedure TJvCustomDataProvider.ConsumerDestroying(Consumer: IJvDataConsumer);
begin
end;

function TJvCustomDataProvider.AllowProviderDesigner: Boolean;
begin
  Result := PersistentDataItems;
end;

function TJvCustomDataProvider.AllowContextManager: Boolean;
var
  CtxMan: IJvDataContextsManager;
begin
  Result := (FDataContextsImpl <> nil) and
    Supports(FDataContextsImpl as IJvDataContexts, IJvDataContextsManager, CtxMan);
end;

function TJvCustomDataProvider.GetNotifierCount: Integer;
begin
  Result := FNotifiers.Count;
end;

function TJvCustomDataProvider.GetNotifier(Index: Integer): IJvDataProviderNotify;
begin
  Result := IJvDataProviderNotify(FNotifiers[Index]);
end;

function TJvCustomDataProvider.GetImplementer: TObject;
begin
  Result := Self;
end;

function TJvCustomDataProvider.GetInterface(const IID: TGUID; out Obj): Boolean;
begin
  Result := inherited GetInterface(IID, Obj) or Supports(GetItems, IID, Obj) or (
    // If we have contexts, check the interface table of that implementation as well.
    (FDataContextsImpl <> nil) and Supports(TObject(FDataContextsImpl), IID, Obj)
  );
end;

//=== { TJvBaseDataContexts } ================================================

constructor TJvBaseDataContexts.Create(AProvider: IJvDataProvider; AAncestor: IJvDataContext;
  ManagerClass: TJvDataContextsManagerClass);
begin
  inherited Create;
  FProvider := AProvider;
  FAncestor := AAncestor;
  if ManagerClass <> nil then
    ManagerClass.Create(Self);
end;

function TJvBaseDataContexts.Provider: IJvDataProvider;
begin
  Result := FProvider;
end;

function TJvBaseDataContexts.Ancestor: IJvDataContext;
begin
  Result := FAncestor;
end;

function TJvBaseDataContexts.GetContextByName(Name: string): IJvDataContext;
var
  PathSep: Integer;
  PathSep2: Integer;
  ThisPath: string;
  Idx: Integer;
begin
  PathSep := Pos('\', Name);
  PathSep2 := Pos('/', Name);
  if (PathSep > PathSep2) or (PathSep = 0) then
    PathSep := PathSep2;
  if PathSep = 0 then
    PathSep := Length(Name) + 1;
  ThisPath := Copy(Name, 1, PathSep - 1);
  if ThisPath = '..' then
  begin
    if Ancestor <> nil then
      Result := Ancestor.Contexts.GetContextByName(Copy(Name, PathSep + 1, Length(Name) - PathSep));
  end
  else
  if (ThisPath = '') and (Ancestor <> nil) and (PathSep <> 0) then
    Result := (Provider as IJvDataContexts).GetContextByName(Copy(Name, PathSep + 1, Length(Name) - PathSep))
  else
  begin
    Idx := GetCount - 1;
    while (Idx >= 0) and not AnsiSameText(GetContext(Idx).Name, ThisPath) do
      Dec(Idx);
    if Idx >= 0 then
    begin
      Result := GetContext(Idx);
      if PathSep < Length(Name) then
        Result := Result.Contexts.GetContextByName(Copy(Name, PathSep + 1, Length(Name) - PathSep));
    end;
  end;
end;

function TJvBaseDataContexts.IndexOf(Ctx: IJvDataContext): Integer;
begin
  Result := GetCount - 1;
  while (Result >= 0) and (Ctx <> GetContext(Result)) do
    Dec(Result);
end;

//=== { TJvBaseDataContextsManager } =========================================

function TJvBaseDataContextsManager.Contexts: IJvDataContexts;
begin
  Result := Owner as IJvDataContexts;
end;

function TJvBaseDataContextsManager.ContextsImpl: TJvBaseDataContexts;
begin
  Result := Owner as TJvBaseDataContexts;
end;

function TJvBaseDataContextsManager.Add(Context: IJvDataContext): IJvDataContext;
begin
  Result := Context;
  ContextsImpl.DoAddContext(Result);
end;

procedure TJvBaseDataContextsManager.Delete(Context: IJvDataContext);
begin
  ContextsImpl.DoRemoveContext(Context);
end;

procedure TJvBaseDataContextsManager.Clear;
begin
  ContextsImpl.DoClearContexts;
end;

//=== { TJvBaseDataContext } =================================================

constructor TJvBaseDataContext.Create(AContexts: TJvBaseDataContexts; AName: string);
begin
  if AContexts <> nil then
  begin
    inherited Create;
    FContexts := AContexts;
    SetName(AName);
  end
  else
    raise EJVCLDataContexts.CreateRes(@RsECannotCreateAContextWithoutAContext);
end;

procedure TJvBaseDataContext.SetName(Value: string);
var
  ExistingContext: IJvDataContext;
begin
  if Value <> Name then
  begin
    ExistingContext := Contexts.GetContextByName(Value);
    if (ExistingContext = nil) or (ExistingContext = (Self as IJvDataContext)) then
      DoSetName(Value)
    else
      raise EJVCLDataContexts.CreateRes(@RsEAContextWithThatNameAlreadyExists);
  end;
end;

function TJvBaseDataContext.GetImplementer: TObject;
begin
  Result := Self;
end;

function TJvBaseDataContext.ContextsImpl: TJvBaseDataContexts;
begin
  Result := FContexts;
end;

function TJvBaseDataContext.Contexts: IJvDataContexts;
begin
  Result := FContexts;
end;

function TJvBaseDataContext.IsDeletable: Boolean;
begin
  Result := True;
end;

function TJvBaseDataContext.IsStreamable: Boolean;
begin
  Result := not IsDeletable;
end;

//=== { TJvBaseFixedDataContext } ============================================

function TJvBaseFixedDataContext.IsDeletable: Boolean;
begin
  Result := False;
end;

//=== { TJvDataContexts } ====================================================

constructor TJvDataContexts.Create(AProvider: IJvDataProvider; AAncestor: IJvDataContext;
  ManagerClass: TJvDataContextsManagerClass);
begin
  inherited Create(AProvider, AAncestor, ManagerClass);
  FContexts := TInterfaceList.Create;
end;

destructor TJvDataContexts.Destroy;
begin
  FreeAndNil(FContexts);
  inherited Destroy;
end;

procedure TJvDataContexts.DoAddContext(Context: IJvDataContext);
var
  Tmp: IJvDataContext;
begin
  Tmp := GetContextByName(Context.Name);
  if Tmp = nil then
  begin
    Provider.Changing(pcrContextAdd, Ancestor);
    FContexts.Add(Context);
    Provider.Changed(pcrContextAdd, Context);
  end
  else
  begin
    if Tmp <> Context then
      raise EJVCLDataContexts.CreateRes(@RsEAContextWithThatNameAlreadyExists);
  end;
end;

procedure TJvDataContexts.DoDeleteContext(Index: Integer);
var
  Ctx: IJvDataContext;
  Anc: IJvDataContext;
begin
  Ctx := GetContext(Index);
  if (Ctx <> nil) and Ctx.IsDeletable then
  begin
    Anc := Ctx.Contexts.Ancestor;
    Provider.Changing(pcrContextDelete, Ctx);
    Ctx := nil;
    FContexts.Delete(Index);
    Provider.Changed(pcrContextDelete, Anc);
  end;
end;

procedure TJvDataContexts.DoRemoveContext(Context: IJvDataContext);
var
  Idx: Integer;
begin
  Idx := GetCount - 1;
  while (Idx >= 0) and (GetContext(Idx) <> Context) do
    Dec(Idx);
  if Idx >= 0 then
    DoDeleteContext(Idx);
end;

procedure TJvDataContexts.DoClearContexts;
begin
  FContexts.Clear;
end;

function TJvDataContexts.GetCount: Integer;
begin
  Result := FContexts.Count;
end;

function TJvDataContexts.GetContext(Index: Integer): IJvDataContext;
begin
  Result := IJvDataContext(FContexts[Index]);
end;

//=== { TJvDataContext } =====================================================

procedure TJvDataContext.DoSetName(Value: string);
begin
  FName := Value;
end;

function TJvDataContext.Name: string;
begin
  Result := FName;
end;

//=== { TJvFixedDataContext } ================================================

function TJvFixedDataContext.IsDeletable: Boolean;
begin
  Result := False;
end;

//=== { TJvDataConsumer } ====================================================

constructor TJvDataConsumer.Create(AOwner: TComponent; Attributes: array of Integer);
var
  I: Integer;
begin
  inherited Create;
  FOwner := AOwner;
  FServerList := TInterfaceList.Create;
  for I := Low(Attributes) to High(Attributes) do
    DoAddAttribute(Attributes[I]);
end;

destructor TJvDataConsumer.Destroy;
begin
  // detach event handlers to avoid AVs when destroying
  FOnChanged := nil;
  FOnProviderChanging := nil;
  FOnProviderChanged := nil;
  FAfterCreateSubSvc := nil;
  FBeforeCreateSubSvc := nil;
  Provider := nil;
  FreeAndNil(FServerList);
  inherited Destroy;
end;

procedure TJvDataConsumer.SetProvider(Value: IJvDataProvider);
var
  CtxList: IJvDataContexts;
begin
  if FProvider <> Value then
  begin
    Changing(ccrProviderSelect);
    if FProvider <> nil then
      FProvider.UnregisterChangeNotify(Self);
    ProviderChanging;
    FProvider := Value;
    if FProvider <> nil then
      FProvider.RegisterChangeNotify(Self);
    if NeedContextFixup then
      FixupContext
    else
    begin
      if Supports(ProviderIntf, IJvDataContexts, CtxList) and (CtxList.GetCount >0 ) then
        SetContextIntf(CtxList.GetContext(0))
      else
        SetContextIntf(nil);
    end;
    ProviderChanged;
    NotifyServerProviderChanged;
    if NeedExtensionFixups then
      FixupExtensions;
    ViewChanged(nil);
    Changed(ccrProviderSelect);
  end;
end;

function TJvDataConsumer._AddRef: Integer;
begin
  Result := -1;
end;

function TJvDataConsumer._Release: Integer;
begin
  Result := -1;
end;

procedure TJvDataConsumer.DoProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
  if Assigned(FOnProviderChanging) then
    OnProviderChanging(ADataProvider, AReason, Source);
end;

procedure TJvDataConsumer.DoProviderChanged(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
  if Assigned(FOnProviderChanged) then
    OnProviderChanged(ADataProvider, AReason, Source);
end;

procedure TJvDataConsumer.DoAfterCreateSubSvc(ASvc: TJvDataConsumerAggregatedObject);
begin
  if Assigned(FAfterCreateSubSvc) then
    AfterCreateSubSvc(Self, ASvc);
end;

procedure TJvDataConsumer.DoBeforeCreateSubSvc(var AClass: TJvDataConsumerAggregatedObjectClass);
begin
  if Assigned(FBeforeCreateSubSvc) then
    BeforeCreateSubSvc(Self, AClass);
end;

procedure TJvDataConsumer.DoChanging(Reason: TJvDataConsumerChangeReason);
begin
  if Assigned(FOnChanging) then
    OnChanging(Self, Reason);
end;

procedure TJvDataConsumer.DoChanged(Reason: TJvDataConsumerChangeReason);
begin
  if Assigned(FOnChanged) then
    OnChanged(Self, Reason);
end;

procedure TJvDataConsumer.DoAddAttribute(Attr: Integer);
begin
  if not AttributeApplies(Attr) then
  begin
    SetLength(FAttrList, Length(FAttrList) + 1);
    FAttrList[High(FAttrList)] := Attr;
  end;
end;

procedure TJvDataConsumer.Changing(Reason: TJvDataConsumerChangeReason);
begin
  DoChanging(Reason);
end;

procedure TJvDataConsumer.Changed(Reason: TJvDataConsumerChangeReason);
begin
  if VCLComponent is TControl then
    TControl(VCLComponent).Invalidate;
  DoChanged(Reason);
end;

procedure TJvDataConsumer.ProviderChanging;
var
  I: Integer;
begin
  if FAdditionalIntfImpl <> nil then
  begin
    if not FNeedFixups and (FFixupContext = '') then
    begin
      I := 0;
      while I < ExtensionCount do
      begin
        Extension(I).ProviderChanging;
        Inc(I);
      end
    end;
  end;
end;

procedure TJvDataConsumer.ProviderChanged;
var
  I: Integer;
begin
  if FAdditionalIntfImpl <> nil then
  begin
    if not FNeedFixups and (FFixupContext = '') then
    begin
      I := 0;
      while I < ExtensionCount do
      begin
        if Extension(I).StreamedInWithoutProvider or Extension(I).KeepOnProviderChange then
        begin
          Extension(I).ProviderChanged;
          Inc(I);
        end
        else
          RemoveIntfImpl(Extension(I));
      end;
    end;
    UpdateExtensions;
  end;
end;

procedure TJvDataConsumer.ContextChanging;
var
  I: Integer;
begin
  if FAdditionalIntfImpl <> nil then
  begin
    if not FNeedFixups and (FFixupContext = '') then
    begin
      I := 0;
      while I < ExtensionCount do
      begin
        Extension(I).ContextChanging;
        Inc(I);
      end
    end;
  end;
end;

procedure TJvDataConsumer.ContextChanged;
var
  I: Integer;
begin
  if FAdditionalIntfImpl <> nil then
  begin
    if not FNeedFixups and (FFixupContext = '') then
    begin
      I := 0;
      while I < ExtensionCount do
      begin
        if Extension(I).StreamedInWithoutProvider or Extension(I).KeepOnContextChange then
        begin
          Extension(I).ContextChanged;
          Inc(I);
        end
        else
          RemoveIntfImpl(Extension(I));
      end;
    end;
    UpdateExtensions;
  end;
end;

procedure TJvDataConsumer.AfterSubSvcAdded(ASvc: TJvDataConsumerAggregatedObject);
begin
  DoAfterCreateSubSvc(ASvc);
  if ASvc is TJvCustomDataConsumerViewList then
    TJvCustomDataConsumerViewList(ASvc).RebuildView
end;

procedure TJvDataConsumer.UpdateExtensions;
var
  ImplArray: TClassArray;
  I: Integer;
  TmpClass: TJvDataConsumerAggregatedObjectClass;
begin
  SetLength(ImplArray, 0);
  if ProviderIntf <> nil then
  begin
    DP_SelectConsumerContext(ProviderIntf, Self, ContextIntf);
    try
      ImplArray := ProviderIntf.ConsumerClasses;
    finally
      DP_ReleaseConsumerContext(ProviderIntf);
    end;
    for I := Low(ImplArray) to High(ImplArray) do
    begin
      TmpClass := TJvDataConsumerAggregatedObjectClass(ImplArray[I]);
      if IndexOfImplClass(TmpClass) < 0 then
      begin
        DoBeforeCreateSubSvc(TmpClass);
        if TmpClass <> nil then
          DoAfterCreateSubSvc(TmpClass.Create(Self));
      end;
    end;
    if AttributeApplies(DPA_ConsumerDisplaysList) then
    begin
      TmpClass := TJvDataConsumerViewList;
      if IndexOfImplClass(TJvDataConsumerViewList) < 0 then
      begin
        DoBeforeCreateSubSvc(TmpClass);
        if TmpClass <> nil then
          AfterSubSvcAdded(TmpClass.Create(Self));
      end;
    end;
  end
  else
    ClearIntfImpl;
end;

procedure TJvDataConsumer.FixupExtensions;
var
  I: Integer;
begin
  for I := 0 to ExtensionCount - 1 do
    Extension(I).Fixup;
  FNeedFixups := False;
end;

procedure TJvDataConsumer.FixupContext;
begin
  Context := FFixupContext;
  FFixupContext := '';
end;

procedure TJvDataConsumer.ViewChanged(AExtension: TJvDataConsumerAggregatedObject);
var
  I: Integer;
begin
  try
    for I := 0 to ExtensionCount - 1 do
      if Extension(I) <> AExtension then
        Extension(I).ViewChanged(AExtension);
  finally
    Changed(ccrViewChange);
  end;
end;

procedure TJvDataConsumer.NotifyItemSelected(Value: IJvDataItem);
var
  I: Integer;
begin
  for I := 0 to ExtensionCount - 1 do
    Extension(I).ItemSelected(Value);
end;

procedure TJvDataConsumer.NotifyServerItemChanged(Server: IJvDataConsumerServerNotify;
  Value: IJvDataItem);
var
  I: Integer;
begin
  for I := 0 to ExtensionCount - 1 do
    Extension(I).ServerItemChanged(Server, Value);
end;

procedure TJvDataConsumer.NotifyServerProviderChanged;
var
  I: Integer;
begin
  if not IsLoading then
    for I := 0 to ServerCount - 1 do
      Servers[I].NotifyProviderChanged(Self);
end;

function TJvDataConsumer.ExtensionCount: Integer;
begin
  Result := FAdditionalIntfImpl.Count;
end;

function TJvDataConsumer.Extension(Index: Integer): TJvDataConsumerAggregatedObject;
begin
  Result := TJvDataConsumerAggregatedObject(FAdditionalIntfImpl[Index]);
end;

function TJvDataConsumer.IsContextStored: Boolean;
var
  CtxList: IJvDataContexts;
begin
  Result := (ProviderIntf <> nil) and Supports(ProviderIntf, IJvDataContexts, CtxList) and
    (CtxList.GetCount > 0) and (ContextIntf <> CtxList.GetContext(0));
end;

function TJvDataConsumer.GetNeedExtensionFixups: Boolean;
var
  I: Integer;
begin
  Result := FNeedFixups and ((VCLComponent = nil) or
    not (csLoading in VCLComponent.ComponentState));
  if not Result then
  begin
    I := ExtensionCount - 1;
    while not Result and (I >= 0) do
    begin
      Result := Extension(I).StreamedInWithoutProvider;
      Dec(I);
    end;
  end;
end;

function TJvDataConsumer.GetNeedContextFixup: Boolean;
begin
  Result := (FFixupContext <> '') and ((VCLComponent = nil) or
    not (csLoading in VCLComponent.ComponentState));
end;

function TJvDataConsumer.GetContext: TJvDataContextID;
begin
  if FContext = nil then
    Result := ''
  else
    Result := FContext.Name;
end;

procedure TJvDataConsumer.SetContext(Value: TJvDataContextID);
var
  ContextsIntf: IJvDataContexts;
  ContextIntf: IJvDataContext;
begin
  if not AnsiSameStr(Value, GetContext) then
  begin
    if ProviderIntf = nil then
    begin
      if (VCLComponent <> nil) and (csLoading in VCLComponent.ComponentState) then
        FFixupContext := Value
      else
        raise EJVCLDataConsumer.CreateRes(@RsEYouMustSpecifyAProviderBeforeSettin);
    end
    else
    begin
      if Value <> '' then
      begin
        if Supports(ProviderIntf, IJvDataContexts, ContextsIntf) then
        begin
          ContextIntf := ContextsIntf.GetContextByName(Value);
          if ContextIntf <> nil then
            SetContextIntf(ContextIntf)
          else
            raise EJVCLDataConsumer.CreateResFmt(@RsEProviderHasNoContextNameds, [Value]);
        end
        else
          raise EJVCLDataConsumer.CreateRes(@RsEProviderDoesNotSupportContexts);
      end
      else
        SetContextIntf(nil);
    end;
  end;
end;

function TJvDataConsumer.GetServerCount: Integer;
begin
  Result := FServerList.Count;
end;

function TJvDataConsumer.GetServers(I: Integer): IJvDataConsumerServerNotify;
begin
  Result := IJvDataConsumerServerNotify(FServerList[I]);
end;

procedure TJvDataConsumer.DataProviderChanging(const ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  I: Integer;
begin
  DoProviderChanging(ADataProvider, AReason, Source);
  for I := 0 to ExtensionCount - 1 do
    Extension(I).DataProviderChanging(ADataProvider, AReason, Source);
  if AReason = pcrDestroy then
    Provider := nil;
end;

procedure TJvDataConsumer.DataProviderChanged(const ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  I: Integer;
begin
  DoProviderChanged(ADataProvider, AReason, Source);
  for I := 0 to ExtensionCount - 1 do
    Extension(I).DataProviderChanged(ADataProvider, AReason, Source);
  if AReason = pcrFullRefresh then
    ViewChanged(nil)
  else
    Changed(ccrProviderChange);
end;

function TJvDataConsumer.Consumer: IJvDataConsumer;
begin
  Result := Self;
end;

function TJvDataConsumer.VCLComponent: TComponent;
begin
  Result := FOwner;
end;

function TJvDataConsumer.AttributeApplies(Attr: Integer): Boolean;
var
  I: Integer;
begin
  I := High(FAttrList);
  while (I >= 0) and (FAttrList[I] <> Attr) do
    Dec(I);
  Result := I >= 0;
end;

procedure TJvDataConsumer.ServerItemChanged(Server: IJvDataConsumerServerNotify; Value: IJvDataItem);
begin
  NotifyServerItemChanged(Server, Value);
end;

procedure TJvDataConsumer.LinkAdded(Server: IJvDataConsumerServerNotify);
begin
  FServerList.Add(Server);
end;

procedure TJvDataConsumer.LinkRemoved(Server: IJvDataConsumerServerNotify);
begin
  FServerList.Remove(Server);
end;

function TJvDataConsumer.ProviderIntf: IJvDataProvider;
begin
  Result := FProvider;
end;

procedure TJvDataConsumer.SetProviderIntf(Value: IJvDataProvider);
begin
  SetProvider(Value);
end;

function TJvDataConsumer.ContextIntf: IJvDataContext;
begin
  Result := FContext;
end;

procedure TJvDataConsumer.SetContextIntf(Value: IJvDataContext);
begin
  if Value <> ContextIntf then
  begin
    if (Value <> nil) and (Value.Contexts.Provider <> ProviderIntf) then
      raise EJVCLDataConsumer.CreateRes(@RsETheSpecifiedContextIsNotPartOfTheSa);
    Changing(ccrContextChange);
    ContextChanging;
    FContext := Value;
    ContextChanged;
    Changed(ccrContextChange);
  end;
end;

procedure TJvDataConsumer.Loaded;
begin
  if FFixupContext <> '' then
  begin
    Context := FFixupContext;
    FFixupContext := '';
  end;
  if FNeedFixups then
  begin
    FixupExtensions;
    FNeedFixups := False;
  end;
end;

procedure TJvDataConsumer.Enter;
begin
  DP_SelectConsumerContext(ProviderIntf, Self, ContextIntf);
end;

procedure TJvDataConsumer.Leave;
begin
  DP_ReleaseConsumerContext(ProviderIntf);
end;

procedure TJvDataConsumer.ItemSelected(Value: IJvDataItem);
var
  ItemAct: IJvDataItemBasicAction;
begin
  NotifyItemSelected(Value);
  if Supports(Value, IJvDataItemBasicAction, ItemAct) then
    ItemAct.Execute(VCLComponent);
end;

function TJvDataConsumer.IsLoading: Boolean;
begin
  Result := NeedExtensionFixups or NeedContextFixup;
end;

//=== { TJvDataConsumerAggregatedObject } ====================================

procedure TJvDataConsumerAggregatedObject.DataProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
end;

procedure TJvDataConsumerAggregatedObject.DataProviderChanged(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
end;

procedure TJvDataConsumerAggregatedObject.Fixup;
begin
end;

function TJvDataConsumerAggregatedObject.KeepOnProviderChange: Boolean;
begin
  Result := False;
end;

function TJvDataConsumerAggregatedObject.KeepOnContextChange: Boolean;
begin
  Result := True;
end;

procedure TJvDataConsumerAggregatedObject.Changing(Reason: TJvDataConsumerChangeReason);
begin
  ConsumerImpl.Changing(Reason);
end;

procedure TJvDataConsumerAggregatedObject.Changed(Reason: TJvDataConsumerChangeReason);
begin
  StreamedInWithoutProvider := ConsumerImpl.ProviderIntf = nil;
  ConsumerImpl.Changed(Reason);
end;

procedure TJvDataConsumerAggregatedObject.NotifyViewChanged;
begin
  ConsumerImpl.ViewChanged(Self);
end;

procedure TJvDataConsumerAggregatedObject.ViewChanged(AExtension: TJvDataConsumerAggregatedObject);
begin
end;

procedure TJvDataConsumerAggregatedObject.ItemSelected(Value: IJvDataItem);
begin
end;

procedure TJvDataConsumerAggregatedObject.ServerItemChanged(Server: IJvDataConsumerServerNotify;
  Value: IJvDataItem);
begin
end;

procedure TJvDataConsumerAggregatedObject.NotifyFixups;
begin
  ConsumerImpl.FNeedFixups := True;
  StreamedInWithoutProvider := True;
end;

procedure TJvDataConsumerAggregatedObject.ProviderChanging;
begin
end;

procedure TJvDataConsumerAggregatedObject.ProviderChanged;
begin
end;

procedure TJvDataConsumerAggregatedObject.ContextChanging;
begin
end;

procedure TJvDataConsumerAggregatedObject.ContextChanged;
begin
end;

function TJvDataConsumerAggregatedObject.Consumer: IJvDataConsumer;
begin
  Result := Owner as IJvDataConsumer;
end;

function TJvDataConsumerAggregatedObject.ConsumerImpl: TJvDataConsumer;
begin
  Result := Owner as TJvDataConsumer;
end;

function TJvDataConsumerAggregatedObject.RootItems: IJvDataItems;
var
  RootSelect: IJvDataConsumerItemSelect;
begin
  if Supports(Consumer, IJvDataConsumerItemSelect, RootSelect) and (RootSelect.GetItem <> nil) then
    RootSelect.GetItem.QueryInterface(IJvDataItems, Result)
  else
    ConsumerImpl.ProviderIntf.QueryInterface(IJvDataItems, Result);
end;

//=== { TJvDataConsumerContext } =============================================

function TJvDataConsumerContext.GetContextID: TJvDataContextID;
begin
  Result := ConsumerImpl.Context;
end;

procedure TJvDataConsumerContext.SetContextID(Value: TJvDataContextID);
begin
  ConsumerImpl.Context := Value;
end;

function TJvDataConsumerContext.GetContext: IJvDataContext;
begin
  Result := ConsumerImpl.ContextIntf;
end;

procedure TJvDataConsumerContext.SetContext(Value: IJvDataContext);
begin
  ConsumerImpl.SetContextIntf(Value);
end;

//=== { TJvDataConsumerItemSelect } ==========================================

procedure TJvDataConsumerItemSelect.Fixup;
begin
  SetItem(FItemID);
  FItemID := '';
end;

function TJvDataConsumerItemSelect.GetItem: TJvDataItemID;
begin
  if GetItemIntf = nil then
    Result := ''
  else
    Result := GetItemIntf.GetID;
end;

procedure TJvDataConsumerItemSelect.SetItem(Value: TJvDataItemID);
var
  TmpItem: IJvDataItem;
begin
  if not AnsiSameStr(Value, GetItem) then
  begin
    if Value = '' then
      SetItemIntf(nil)
    else
    begin
      if ConsumerImpl.ProviderIntf = nil then
      begin
        if (Consumer.VCLComponent <> nil) and (csLoading in Consumer.VCLComponent.ComponentState) then
        begin
          FItemID := Value;
          NotifyFixups;
          Exit;
        end
        else
          raise EJVCLDataConsumer.CreateRes(@RsEYouMustSpecifyAProviderBeforeSettin_);
      end
      else
      begin
        ConsumerImpl.Enter;
        try
          TmpItem := (ConsumerImpl.ProviderIntf as IJvDataIDSearch).Find(Value, True);
          if TmpItem <> nil then
            SetItemIntf(TmpItem)
          else
            raise EJVCLDataConsumer.CreateRes(@RsEItemNotFoundInTheSelectedContext);
        finally
          ConsumerImpl.Leave;
        end;
      end;
    end;
  end;
end;

procedure TJvDataConsumerItemSelect.DataProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  SourceItem: IJvDataItem;
begin
  if AReason = pcrDelete then
  begin
    SourceItem := IJvDataItem(Source);
    if (SourceItem <> nil) and (GetItemIntf <> nil) then
    begin
      ConsumerImpl.Enter;
      try
        if (SourceItem = GetItemIntf) or (SourceItem.IsParentOf(GetItemIntf)) then
          FItem := nil;
      finally
        ConsumerImpl.Leave;
      end;
    end;
  end;
end;

procedure TJvDataConsumerItemSelect.DataProviderChanged(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
begin
end;

function TJvDataConsumerItemSelect.GetItemIntf: IJvDataItem;
begin
  Result := FItem;
end;

procedure TJvDataConsumerItemSelect.SetItemIntf(Value: IJvDataItem);
begin
  if Value <> GetItemIntf then
  begin
    FItem := Value;
    NotifyViewChanged;
  end;
end;

//=== { TJvCustomDataConsumerViewList } ======================================

constructor TJvCustomDataConsumerViewList.Create(AOwner: TExtensibleInterfacedPersistent);
begin
  inherited Create(AOwner);
  FLevelIndent := 16;
  if ConsumerImpl.ProviderIntf <> nil then
    RebuildView;
end;

function TJvCustomDataConsumerViewList.KeepOnProviderChange: Boolean;
begin
  Result := True;
end;

procedure TJvCustomDataConsumerViewList.ProviderChanging;
begin
  ClearView;
end;

procedure TJvCustomDataConsumerViewList.ProviderChanged;
begin
  RebuildView;
end;

procedure TJvCustomDataConsumerViewList.ContextChanged;
begin
  RebuildView;
end;

procedure TJvCustomDataConsumerViewList.ViewChanged(AExtension: TJvDataConsumerAggregatedObject);
begin
  RebuildView;
end;

procedure TJvCustomDataConsumerViewList.DataProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  ItemIdx: Integer;
begin
  case AReason of
    pcrDelete:
      begin
        // Source is a reference to the item being deleted
        if Source <> nil then
        begin
          ConsumerImpl.Enter;
          try
            if IJvDataItem(Source) <> nil then
            begin
              ItemIdx := IndexOfItem(IJvDataItem(Source));
              if ItemIdx >= 0 then
              begin
                DeleteItem(ItemIdx);
                NotifyViewChanged;
              end;
            end;
          finally
            ConsumerImpl.Leave;
          end;
        end;
      end;
  end;
end;

procedure TJvCustomDataConsumerViewList.DataProviderChanged(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  ParItem: IJvDataItem;
  ParIdx: Integer;
begin
  case AReason of
    pcrAdd:
      begin
        // Source is a reference to the new item
        if Source <> nil then
        begin
          ConsumerImpl.Enter;
          try
            if IJvDataItem(Source) <> nil then
            begin
              ParItem := IJvDataItem(Source).GetItems.GetParent;
              if ParItem <> nil then
              begin
                ParIdx := IndexOfItem(ParItem);
                if (ParIdx < 0) and ExpandOnNewItem then
                begin
                  // Make sure the tree is expanded up to the parent item
                  ExpandTreeTo(ParItem);
                  ParIdx := IndexOfItem(ParItem);
                end;
                if ParIdx >= 0 then
                begin
                  if not ItemIsExpanded(ParIdx) and ExpandOnNewItem then
                  begin
                    // Expand parent item; will retrieve all sub items, including the newly added item
                    if not ItemHasChildren(ParIdx) then
                      UpdateItemFlags(ParIdx, vifHasChildren + vifCanHaveChildren,
                        vifHasChildren + vifCanHaveChildren);
                    ToggleItem(ParIdx);
                  end
                  else
                  if ItemIsExpanded(ParIdx) then
                  begin
                    // parent is expanded, add the new item to the view.
                    AddChildItem(ParIdx, IJvDataItem(Source));
                    NotifyViewChanged;
                  end;
                end;
              end
              else
              begin
                // Item at the root; always add it
                AddChildItem(-1, IJvDataItem(Source));
                NotifyViewChanged;
              end;
            end;
          finally
            ConsumerImpl.Leave;
          end;
        end;
      end;
  end;
end;

function TJvCustomDataConsumerViewList.InternalItemSibling(ParentIndex: Integer;
  var ScanIndex: Integer): Integer;
var
  Lvl: Integer;
begin
  Lvl := ItemLevel(ParentIndex);
  if ScanIndex <= ParentIndex then
    ScanIndex := ParentIndex + 1;
  while (ScanIndex < Count) and (ItemLevel(ScanIndex) > Lvl) do
    Inc(ScanIndex);
  if (ScanIndex >= Count) or (ItemLevel(ScanIndex) < Lvl) then
    Result := -1
  else
    Result := ScanIndex;
  if ScanIndex > Count then
    ScanIndex := Count;
end;

function TJvCustomDataConsumerViewList.Get_AutoExpandLevel: Integer;
begin
  Result := FAutoExpandLevel;
end;

procedure TJvCustomDataConsumerViewList.Set_AutoExpandLevel(Value: Integer);
begin
  FAutoExpandLevel := Value;
end;

function TJvCustomDataConsumerViewList.Get_ExpandOnNewItem: Boolean;
begin
  Result := FExpandOnNewItem;
end;

procedure TJvCustomDataConsumerViewList.Set_ExpandOnNewItem(Value: Boolean);
begin
  FExpandOnNewItem := Value;
end;

function TJvCustomDataConsumerViewList.Get_LevelIndent: Integer;
begin
  Result := FLevelIndent;
end;

procedure TJvCustomDataConsumerViewList.Set_LevelIndent(Value: Integer);
begin
  if Value <> LevelIndent then
  begin
    FLevelIndent := Value;
    Changed(ccrOther);
  end;
end;

procedure TJvCustomDataConsumerViewList.ClearView;
begin
  // override if the implementation can be optimized
  while Count > 0 do
    DeleteItem(0);
end;

procedure TJvCustomDataConsumerViewList.RebuildView;
var
  Idx: Integer;
begin
  ClearView;
  if (ConsumerImpl <> nil) and (ConsumerImpl.ProviderIntf <> nil) then
  begin
    ConsumerImpl.Enter;
    try
      Idx := 0;
      AddItems(Idx, RootItems, AutoExpandLevel);
    finally
      ConsumerImpl.Leave;
    end;
  end;
  NotifyViewChanged;
end;

procedure TJvCustomDataConsumerViewList.ExpandTreeTo(Item: IJvDataItem);
var
  ParIdx: Integer;
begin
  if (Item <> nil) and (GetItemVisibleState(Item) <> disFalse) then
  begin
    if (IndexOfID(Item.GetID) >= 0) and (Item.Items.GetParent <> nil) then
    begin
      ExpandTreeTo(Item.GetItems.GetParent);
      ParIdx := IndexOfID(Item.GetItems.GetParent.GetID);
      if ParIdx >= 0 then
      begin
        if ItemIsExpanded(ParIdx) then // we have a big problem <g>
          raise EJVCLDataConsumer.CreateRes(@RsEViewListOutOfSync);
        ToggleItem(ParIdx);
      end;
    end;
  end;
end;

procedure SetBit(var IntArray: array of Integer; BitNo: Integer);
var
  ArrayOffset: Integer;
  BitOffset: Integer;
begin
  ArrayOffset := BitNo div 32;
  BitOffset := BitNo mod 32;
  IntArray[ArrayOffset] := IntArray[ArrayOffset] or (1 shl BitOffset);
end;

function TJvCustomDataConsumerViewList.ItemGroupInfo(Index: Integer): TDynIntegerArray;
var
  LvlIdx: Integer;
  LastScanIndex: Integer;
begin
  LvlIdx := ItemLevel(Index) - 1;
  SetLength(Result, LvlIdx div 32 + Ord((LvlIdx mod 32) > 0));
  LastScanIndex := Index;
  { Keep using the last scanned item as a start point to find a sibling for the next parent. Reduces
    the number of compares to make. }
  while LvlIdx >= 0 do
  begin
    Index := ItemParentIndex(Index);
    if InternalItemSibling(Index, LastScanIndex) <> -1 then
      SetBit(Result, LvlIdx); // There's another sibling at this level; set the corresponding bit
    Dec(LvlIdx);
  end;
end;

//=== { TJvDataConsumerViewList } ============================================

procedure TJvDataConsumerViewList.AddItem(Index: Integer; Item: IJvDataItem; ExpandToLevel: Integer);
var
  Lvl: Integer;
  Idx: Integer;
  SubItems: IJvDataItems;
begin
  if GetItemVisibleState(Item) <> disFalse then
  begin
    if Index < 0 then
    begin
      Lvl := 0;
      Idx := Count;
    end
    else
    begin
      Lvl := Succ(ItemLevel(Index));
      Idx := Index + 1;
      if FViewItems[Index].Flags and (vifHasChildren + vifExpanded) = vifHasChildren then
      begin
        ToggleItem(Index);
        Exit;
      end;
    end;
    while (Idx < Count) and (ItemLevel(Idx) >= Lvl) do
      Inc(Idx);
    SetLength(FViewItems, Length(FViewItems) + 1);
    if Idx < High(FViewItems) then
    begin
      Move(FViewItems[Idx], FViewItems[Idx + 1], (High(FViewItems) - Idx) * SizeOf(FViewItems[0]));
      FillChar(FViewItems[Idx], SizeOf(FViewItems[0]), 0);
    end;
    with FViewItems[Idx] do
    begin
      ItemID := Item.GetID;
      if Supports(Item, IJvDataItems, SubItems) then
      begin
        if SubItems.Count > 0 then
          Flags := Lvl + vifHasChildren + vifCanHaveChildren
        else
          Flags := Lvl + vifCanHaveChildren
      end
      else
        Flags := Lvl;
    end;
    if Index > -1 then
      with FViewItems[Index] do
        Flags := Flags or vifHasChildren or vifCanHaveChildren or vifExpanded;
    if (ExpandToLevel <> 0) and (SubItems <> nil) and (SubItems.Count > 0) then
    begin
      Inc(Index);
      AddItems(Index, SubItems, ExpandToLevel - 1);
    end;
  end;
end;

procedure TJvDataConsumerViewList.AddChildItem(ParentIndex: Integer; Item: IJvDataItem);
var
  InsertIndex: Integer;
begin
  if GetItemVisibleState(Item) <> disFalse then
  begin
    InsertIndex := -1;
    if ParentIndex > -1 then
    begin
      if not ItemIsExpanded(ParentIndex) then
      begin
        if not ItemHasChildren(ParentIndex) then
          UpdateItemFlags(ParentIndex, vifHasChildren + vifCanHaveChildren, vifHasChildren +
            vifCanHaveChildren);
        ToggleItem(ParentIndex);
      end;
      if IndexOfItem(Item) < 0 then
        InternalItemSibling(ParentIndex, InsertIndex);
    end
    else
      InsertIndex := Count;
    if InsertIndex > -1 then
      InsertItem(InsertIndex, ParentIndex, Item);
  end;
end;

procedure TJvDataConsumerViewList.AddItems(var Index: Integer; Items: IJvDataItems; ExpandToLevel: Integer);
var
  SkipCount: Integer;
  I: Integer;
  J: Integer;
  SubItems: IJvDataItems;
begin
  J := Count;
  SetLength(FViewItems, Count + Items.Count);
  if Index < J then
  begin
    Move(FViewItems[Index], FViewItems[Index + Items.Count], (J - Index) * SizeOf(FViewItems[0]));
    FillChar(FViewItems[Index], Items.Count * SizeOf(FViewItems[0]), 0);
  end;
  J := 0;
  if Index > 0 then
  begin
    J := 1 + FViewItems[Index - 1].Flags and $00FFFFFF;
    FViewItems[Index - 1].Flags := FViewItems[Index - 1].Flags or vifExpanded;
  end;
  SkipCount := 0;
  for I  := 0 to Items.Count - 1 do
  begin
    if GetItemVisibleState(Items.Items[I]) <> disFalse then
    begin
      with FViewItems[Index] do
      begin
        ItemID := Items.Items[I].GetID;
        Flags := J;
        if Supports(Items.Items[I], IJvDataItems, SubItems) then
        begin
          Flags := Flags + vifCanHaveChildren;
          if SubItems.Count > 0 then
          begin
            Flags := Flags + vifHasChildren;
            if ExpandToLevel <> 0 then
            begin
              Inc(Index);
              AddItems(Index, SubItems, ExpandToLevel - 1);
              Dec(Index);
            end;
          end;
        end;
      end;
      Inc(Index);
    end
    else
      Inc(SkipCount);
  end;
  if SkipCount > 0 then
  begin
    if Index < High(FViewItems) then
      Move(FViewItems[Index + 1], FViewItems[Index], SkipCount * SizeOf(FViewItems[0]));
    FillChar(FViewItems[Length(FViewItems) - SkipCount], SkipCount * SizeOf(FViewItems[0]), 0);
    SetLength(FViewItems, Length(FViewItems) - SkipCount);
  end;
end;

procedure TJvDataConsumerViewList.InsertItem(InsertIndex, ParentIndex: Integer; Item: IJvDataItem);
var
  Level: Integer;
  SubItems: IJvDataItems;
begin
  if GetItemVisibleState(Item) <> disFalse then
  begin
    if ParentIndex < 0 then
      Level := 0
    else
      Level := Succ(ItemLevel(ParentIndex));
    SetLength(FViewItems, Count + 1);
    if InsertIndex < High(FViewItems) then
    begin
      Move(FViewItems[InsertIndex], FViewItems[InsertIndex + 1], (High(FViewItems) - InsertIndex) * SizeOf(FViewItems[0]));
      FillChar(FViewItems[InsertIndex], SizeOf(FViewItems[0]), 0);
    end;
    with FViewItems[InsertIndex] do
    begin
      ItemID := Item.GetID;
      if Supports(Item, IJvDataItems, SubItems) then
      begin
        Level := Level + vifCanHaveChildren;
        if SubItems.Count > 0 then
          Level := Level + vifHasChildren;
      end;
      Flags := Level;
    end;
    if ParentIndex >= 0 then
      FViewItems[ParentIndex].Flags := FViewItems[ParentIndex].Flags or (vifCanHaveChildren +
        vifHasChildren + vifExpanded);
  end;
end;

procedure TJvDataConsumerViewList.DeleteItem(Index: Integer);
var
  PrevIsParent: Boolean;
begin
  DeleteItems(Index);
  PrevIsParent := (Index > 0) and (ItemLevel(Index - 1) = (ItemLevel(Index) - 1));
  FViewItems[Index].ItemID := '';
  if Index < High(FViewItems) then
    Move(FViewItems[Index + 1], FViewItems[Index], (Length(FViewItems) - Index) * SizeOf(FViewItems[0]));
  FillChar(FViewItems[High(FViewItems)], SizeOf(FViewItems[0]), 0);
  SetLength(FViewItems, High(FViewItems));
  if PrevIsParent and ((Index = Length(FViewItems)) or (ItemLevel(Index - 1) <> (ItemLevel(Index) - 1))) then
    FViewItems[Index - 1].Flags := FViewItems[Index - 1].Flags and not (vifHasChildren or vifExpanded);
end;

procedure TJvDataConsumerViewList.DeleteItems(Index: Integer);
var
  Idx: Integer;
  Lvl: Integer;
begin
  if FViewItems[Index].Flags and (vifExpanded + vifHasChildren) = (vifExpanded + vifHasChildren) then
  begin
    Lvl := ItemLevel(Index) + 1;
    Idx := Index + 1;
    while (Idx < Length(FViewItems)) and (ItemLevel(Idx) >= Lvl) do
    begin
      FViewItems[Idx].ItemID := '';
      Inc(Idx);
    end;
    // Idx points to next item that is not a child
    if Idx < Count then
      Move(FViewItems[Idx], FViewItems[Index + 1], (Length(FViewItems) - Idx) * SizeOf(FViewItems[0]));
    FillChar(FViewItems[Length(FViewItems) - Pred(Idx - Index)], Pred(Idx - Index) * SizeOf(FViewItems[0]), 0);
    SetLength(FViewItems, Length(FViewItems) - (Idx - Index - 1));
    FViewItems[Index].Flags := FViewItems[Index].Flags and not vifExpanded;
  end;
end;

procedure TJvDataConsumerViewList.UpdateItemFlags(Index: Integer; Value, Mask: Integer);
begin
  FViewItems[Index].Flags := FViewItems[Index].Flags and not Mask or (Value and Mask);
end;

procedure TJvDataConsumerViewList.ToggleItem(Index: Integer);
var
  TmpItem: IJvDataItem;
  Items: IJvDataItems;
begin
  if ItemHasChildren(Index) then
  begin
    if ItemIsExpanded(Index) then
      DeleteItems(Index)
    else
    begin
      TmpItem := Item(Index);
      if (TmpItem <> nil) and Supports(TmpItem, IJvDataItems, Items) then
      begin
        Inc(Index);
        AddItems(Index, Items);
      end;
    end;
    NotifyViewChanged;
  end;
end;

function TJvDataConsumerViewList.IndexOfItem(Item: IJvDataItem): Integer;
begin
  Result := IndexOfID(Item.GetID);
end;

function TJvDataConsumerViewList.IndexOfID(ID: TJvDataItemID): Integer;
begin
  Result := Count - 1;
  while (Result >= 0) and not AnsiSameText(FViewItems[Result].ItemID, ID) do
    Dec(Result);
end;

function TJvDataConsumerViewList.ChildIndexOfItem(Item: IJvDataItem): Integer;
begin
  Result := ChildIndexOfID(Item.GetID);
end;

function TJvDataConsumerViewList.ChildIndexOfID(ID: TJvDataItemID): Integer;
var
  Index: Integer;
  ChildLevel: Integer;
begin
  Result := -1;
  Index := IndexOfID(ID);
  if Index >= 0 then
  begin
    Inc(Result);
    if Index > 0 then
    begin
      ChildLevel := ItemLevel(Index);
      Dec(Index);
      while (Index >= 0) and (ItemLevel(Index) >= ChildLevel) do
      begin
        if ItemLevel(Index) = ChildLevel then
          Inc(Result);
        Dec(Index);
      end;
    end;
  end;
end;

function TJvDataConsumerViewList.Item(Index: Integer): IJvDataItem;
var
  Items: IJvDataItems;
  Finder: IJvDataIDSearch;
  {$IFNDEF ViewList_UseFinder}
  ParIdx: Integer;
  {$ENDIF !ViewList_UseFinder}
begin
  {$IFDEF ViewList_UseFinder}
  { The easiest way: use IJvDataIDSearch to locate the item given it's ID value. Scans all items
    recursively until it finds a match or nothing at all. Could be rather slow on larger trees. }
  Items := RootItems;
  if Supports(RootItems, IJvDataIDSearch, Finder) then
    Result := Finder.Find(FViewItems[Index].ItemID, True);
  {$ELSE}
  { This should be faster, especially with larger trees. This will only scan the parent item's
    IJvDataItems list (the parent item is retrieved using this same method). This still saves a lot
    of ID comparisons in large trees and for dynamic items also an enormous amount of
    creation/destruction of items. The entire implementation of this class should be adapted to not
    store the ID but the item's index in the provider list, so we can streamline this method to use
    and index path only. }
  ParIdx := ItemParentIndex(Index);
  if ParIdx >= 0 then
    // Parent found, retrieve the IJVDataItems reference
    Item(ParIdx).QueryInterface(IJvDataItems, Items)
  else
    // Apparantly this item is at the root of the view; retrieve the proper IJvDataItems reference
    Items := RootItems;
  if Supports(Items, IJvDataIDSearch, Finder) then
    Result := Finder.Find(FViewItems[Index].ItemID, False);
  {$ENDIF ViewList_UseFinder}
end;

function TJvDataConsumerViewList.ItemLevel(Index: Integer): Integer;
begin
  Result := FViewItems[Index].Flags and $00FFFFFF;
end;

function TJvDataConsumerViewList.ItemIsExpanded(Index: Integer): Boolean;
begin
  Result := FViewItems[Index].Flags and vifExpanded <> 0;
end;

function TJvDataConsumerViewList.ItemHasChildren(Index: Integer): Boolean;
begin
  Result := FViewItems[Index].Flags and vifHasChildren <> 0;
end;

function TJvDataConsumerViewList.ItemParent(Index: Integer): IJvDataItem;
var
  ParIdx: Integer;
begin
  ParIdx := ItemParentIndex(Index);
  if ParIdx >= 0 then
    Result := Item(ParIdx);
end;

function TJvDataConsumerViewList.ItemParentIndex(Index: Integer): Integer;
var
  ParLevel: Integer;
begin
  ParLevel := ItemLevel(Index) - 1;
  Result := Index - 1;
  while (Result >= 0) and (ItemLevel(Result) > ParLevel) do
    Dec(Result);
end;

function TJvDataConsumerViewList.ItemSibling(Index: Integer): IJvDataItem;
var
  Idx: Integer;
begin
  Idx := ItemSiblingIndex(Index);
  if Idx > -1 then
    Result := Item(Idx)
  else
    Result := nil;
end;

function TJvDataConsumerViewList.ItemSiblingIndex(Index: Integer): Integer;
begin
  Result := InternalItemSibling(Index, Index);
end;

function TJvDataConsumerViewList.SubItem(Parent: IJvDataItem; Index: Integer): IJvDataItem;
begin
  Result := SubItem(IndexOfItem(Parent), Index);
end;

function TJvDataConsumerViewList.SubItem(Parent, Index: Integer): IJvDataItem;
var
  Idx: Integer;
begin
  Idx := SubItemIndex(Parent, Index);
  if Idx > -1 then
    Result := Item(Idx)
  else
    Result := nil;
end;

function TJvDataConsumerViewList.SubItemIndex(Parent: IJvDataItem; Index: Integer): Integer;
begin
  Result := SubItemIndex(IndexOfItem(Parent), Index);
end;

function TJvDataConsumerViewList.SubItemIndex(Parent, Index: Integer): Integer;
begin
  Result := Parent + 1;
  while (Result >= 0) and (Index >= 0) do
  begin
    Dec(Index);
    if Index >= 0 then
      Result := ItemSiblingIndex(Result);
  end;
end;

function TJvDataConsumerViewList.Count: Integer;
begin
  Result := Length(FViewItems);
end;

//=== { TJvDataConsumerServerNotify } ========================================

constructor TJvDataConsumerServerNotify.Create(AOwner: TExtensibleInterfacedPersistent);
begin
  inherited Create(AOwner);
  FClients := TJvDataConsumerClientNotifyList.Create(Self);
end;

destructor TJvDataConsumerServerNotify.Destroy;
begin
  FreeAndNil(FClients);
  inherited Destroy;
end;

procedure TJvDataConsumerServerNotify.SetClients(Value: TJvDataConsumerClientNotifyList);
begin
  if Value <> nil then
    FClients.Assign(Value)
  else
    FClients.Clear;
end;

procedure TJvDataConsumerServerNotify.ItemSelected(Value: IJvDataItem);
begin
  { Default behavior: notify clients about the newly selected item. Override the method to take
    other action (either in addition to or instead of the default behavior). }
  NotifyItemSelected(Value);
end;

function TJvDataConsumerServerNotify.GetOwner: TPersistent;
begin
  // To make the collection editor actually show up.
  Result := ConsumerImpl.VCLComponent;
end;

procedure TJvDataConsumerServerNotify.NotifyItemSelected(Value: IJvDataItem);
var
  I: Integer;
begin
  for I := 0 to Clients.Count - 1 do
    if Clients.NotifyItems[I].Notifier <> nil then
      Clients.NotifyItems[I].Notifier.ItemSelected(Self, Value);
end;

function TJvDataConsumerServerNotify.IsValidClient(Client: IJvDataConsumerClientNotify): Boolean;
begin
  // Override this method to determine if the specified client can be linked to this server.
  Result := False;
end;

procedure TJvDataConsumerServerNotify.AddClient(Client: IJvDataConsumerClientNotify);
begin
  if IsValidClient(Client) then
    FClients.Add(Client as IJvDataConsumer);
end;

procedure TJvDataConsumerServerNotify.RemoveClient(Client: IJvDataConsumerClientNotify);
begin
  FClients.Delete(Client as IJvDataConsumer);
end;

procedure TJvDataConsumerServerNotify.NotifyProviderChanged(Client: IJvDataConsumerClientNotify);
begin
  if not IsValidClient(Client) then
    RemoveClient(Client);
end;

//=== { TJvDataConsumerClientNotifyList } ====================================

constructor TJvDataConsumerClientNotifyList.Create(AServer: TJvDataConsumerServerNotify);
begin
  inherited Create(AServer.ConsumerImpl.VCLComponent, TJvDataConsumerClientNotifyItem);
  FServer := AServer;
end;

function TJvDataConsumerClientNotifyList.GetServer: TJvDataConsumerServerNotify;
begin
  Result := FServer;
end;

function TJvDataConsumerClientNotifyList.GetNotifyItems(
  I: Integer): TJvDataConsumerClientNotifyItem;
begin
  Result := TJvDataConsumerClientNotifyItem(Items[I]);
end;

function TJvDataConsumerClientNotifyList.GetConsumer(I: Integer): IJvDataConsumer;
var
  Item: TJvDataConsumerClientNotifyItem;
begin
  Item := GetNotifyItems(I);
  Supports(Item.Notifier, IJvDataConsumer, Result);
end;

procedure TJvDataConsumerClientNotifyList.SetItemName(Item: TCollectionItem);
begin
  Server.StreamedInWithoutProvider := Server.ConsumerImpl.ProviderIntf = nil;
end;

procedure TJvDataConsumerClientNotifyList.Add(AComponent: TComponent);
var
  PI: PPropInfo;
  Obj: TObject;
  Consumer: IJvDataConsumer;
begin
  if AComponent <> nil then
  begin
    PI := GetPropInfo(AComponent, cProvider);
    if PI <> nil then
    begin
      Obj := GetObjectProp(AComponent, cProvider);
      if (Obj <> nil) and Supports(Obj, IJvDataConsumer, Consumer) then
        Add(Consumer)
      else
        raise EJVCLDataConsumer.CreateResFmt(@RsEProviderIsNoIJvDataConsumer, [AComponent.Name]);
    end
    else
      raise EJVCLDataConsumer.CreateResFmt(@RsEComponentIsNotDataConsumer, [AComponent.Name]);
  end
  else
    raise EJVCLDataConsumer.CreateRes(@RsECannotAddNil);
end;

procedure TJvDataConsumerClientNotifyList.Add(AConsumer: IJvDataConsumer);
var
  Notifier: IJvDataConsumerClientNotify;
begin
  if AConsumer <> nil then
  begin
    if IndexOf(AConsumer) = -1 then
    begin
      if Supports(AConsumer, IJvDataConsumerClientNotify, Notifier) then
        TJvDataConsumerClientNotifyItem.Create(Self).Notifier := Notifier
      else
        raise EJVCLDataConsumer.CreateRes(@RsEConsumerNoSupportIJvDataConsumerClientNotify);
    end;
  end
  else
    raise EJVCLDataConsumer.CreateRes(@RsECannotAddNil);
end;

procedure TJvDataConsumerClientNotifyList.Delete(Index: Integer);
begin
  inherited Delete(Index);
end;

procedure TJvDataConsumerClientNotifyList.Delete(AComponent: TComponent);
var
  Idx: Integer;
begin
  Idx := IndexOf(AComponent);
  if Idx > -1 then
    Delete(Idx);
end;

procedure TJvDataConsumerClientNotifyList.Delete(AConsumer: IJvDataConsumer);
var
  Idx: Integer;
begin
  Idx := IndexOf(AConsumer);
  if Idx > -1 then
    Delete(Idx);
end;

function TJvDataConsumerClientNotifyList.IndexOf(AComponent: TComponent): Integer;
begin
  Result := Count - 1;
  while (Result >= 0) and (NotifyItems[Result].Component <> AComponent) do
    Dec(Result);
end;

function TJvDataConsumerClientNotifyList.IndexOf(AConsumer: IJvDataConsumer): Integer;
begin
  Result := Count - 1;
  while (Result >= 0) and (Clients[Result] <> AConsumer) do
    Dec(Result);
end;

//=== { TJvDataConsumerClientNotifyItem } ====================================

function TJvDataConsumerClientNotifyItem.GetList: TJvDataConsumerClientNotifyList;
begin
  Result := TJvDataConsumerClientNotifyList(Collection);
end;

function TJvDataConsumerClientNotifyItem.GetConsumer: IJvDataConsumer;
begin
  Supports(FNotifier, IJvDataConsumer, Result);
end;

function TJvDataConsumerClientNotifyItem.GetComponent: TComponent;
var
  Con: IJvDataConsumer;
begin
  Con := GetConsumer;
  if Con <> nil then
    Result := Con.VCLComponent
  else
    Result := nil;
end;

procedure TJvDataConsumerClientNotifyItem.SetComponent(Value: TComponent);
var
  PI: PPropInfo;
  Obj: TObject;
  Consumer: IJvDataConsumer;
  TmpNotifier: IJvDataConsumerClientNotify;
begin
  if Value <> Component then
  begin
    if Value <> nil then
    begin
      PI := GetPropInfo(Value, cProvider);
      if PI <> nil then
      begin
        Obj := GetObjectProp(Value, cProvider);
        if (Obj <> nil) and Supports(Obj, IJvDataConsumer, Consumer) then
        begin
          if Supports(Consumer, IJvDataConsumerClientNotify, TmpNotifier) then
          begin
            if Notifier <> nil then
              Notifier.LinkRemoved(List.Server);
            FNotifier := TmpNotifier;
            Notifier.LinkAdded(List.Server);
          end
          else
            raise EJVCLDataConsumer.CreateRes(@RsEConsumerNoSupportIJvDataConsumerClientNotify);
        end
        else
          raise EJVCLDataConsumer.CreateResFmt(@RsEProviderIsNoIJvDataConsumer, [Value.Name]);
      end
      else
        raise EJVCLDataConsumer.CreateResFmt(@RsEComponentIsNotDataConsumer, [Value.Name]);
    end
    else
      raise EJVCLDataConsumer.CreateRes(@RsECannotAddNil);
  end;
end;

procedure TJvDataConsumerClientNotifyItem.SetNotifier(Value: IJvDataConsumerClientNotify);
var
  Consumer: IJvDataConsumer;
begin
  if Value <> Notifier then
  begin
    if Value <> nil then
    begin
      if Supports(Value, IJvDataConsumer, Consumer) then
      begin
        if Notifier <> nil then
          Notifier.LinkRemoved(List.Server);
        FNotifier := Value;
        Notifier.LinkAdded(List.Server);
      end
      else
        raise EJVCLDataConsumer.CreateRes(@RsENotifierNoSupprtIJvDataConsumer);
    end
    else
      raise EJVCLDataConsumer.CreateRes(@RsECannotAddNil);
  end;
end;

function TJvDataConsumerClientNotifyItem.GetDisplayName: string;
begin
  if (Component = nil) or (Component.Name = '') then
    Result := inherited GetDisplayName
  else
    Result := Component.Name;
end;

destructor TJvDataConsumerClientNotifyItem.Destroy;
begin
  if Notifier <> nil then
    Notifier.LinkRemoved(List.Server);
  inherited Destroy;
end;

//=== { TJvConsumerStrings } =================================================

constructor TJvConsumerStrings.Create(AConsumer: TJvDataConsumer);
begin
  inherited Create;
  FConsumer := AConsumer;
end;

function TJvConsumerStrings.Get(Index: Integer): string;
var
  VL: IJvDataConsumerViewList;
  ItemText: IJvDataItemText;
begin
  if Index < 0 then
    Error(SListIndexError, Index);
  Result := '';
  Consumer.Enter;
  try
    if Supports(Consumer as IJvDataConsumer, IJvDataConsumerViewList, VL) then
    begin
      if Index >= VL.Count then
        Error(SListIndexError, Index);
      if Supports(VL.Item(Index), IJvDataItemText, ItemText) then
        Result := ItemText.Text;
    end;
  finally
    Consumer.Leave;
  end;
end;

function TJvConsumerStrings.GetCount: Integer;
var
  VL: IJvDataConsumerViewList;
begin
  Result := 0;
  Consumer.Enter;
  try
    if Supports(Consumer as IJvDataConsumer, IJvDataConsumerViewList, VL) then
      Result := VL.Count;
  finally
    Consumer.Leave;
  end;
end;

procedure TJvConsumerStrings.Clear;
begin
  // Do not allow the consumer view list to be modified this way.
end;

procedure TJvConsumerStrings.Delete(Index: Integer);
begin
  // Do not allow the consumer view list to be modified this way.
end;

procedure TJvConsumerStrings.Insert(Index: Integer; const S: string);
begin
  // Do not allow the consumer view list to be modified this way.
end;

//============================================================================

procedure Init;
begin
  {$IFDEF COMPILER7_UP}
  GroupDescendentsWith(TExtensibleInterfacedPersistent, TControl);
  GroupDescendentsWith(TAggregatedPersistent, TControl);
  {$ENDIF COMPILER7_UP}
  RegisterClasses([
    // Items related
    TJvDataItemsList, TJvCustomDataItemsImages, TJvCustomDataItemsTextRenderer,
    TJvBaseDataItemsListManagement,
    // Item related
    TJvBaseDataItem, TJvDataItemTextImpl, TJvDataItemImageImpl,
    TJvDataItemContextTextImpl, TJvDataItemBlockableTextImpl,
    // Consumer related
    TJvDataConsumer, TJvDataConsumerItemSelect,
    // Context list related
    TJvDataContexts,
    // Context related
    TJvDataContext, TJvManagedDataContext, TJvFixedDataContext]);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  Init;

{$IFDEF UNITVERSIONING}
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.
