jvdataprovider.pas

East make Tray Icon in delphi

    { 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(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);