jvqcontextprovider.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvContextProvider.pas, released on 2003-07-18.

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):

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQContextProvider.pas,v 1.14 2004/09/07 23:11:16 asnepvangers Exp $

unit JvQContextProvider;

{$I jvcl.inc}

interface

uses
  Classes,
  JvQDataProvider, JvQDataProviderIntf;

type
  { Context provider related interfaces. }
  IJvDataContextProvider = interface
    ['{78EB1037-11A5-4871-8115-4AE1AC60B59C}']
    function Get_ClientProvider: IJvDataProvider;
    procedure Set_ClientProvider(Value: IJvDataProvider);
    property ClientProvider: IJvDataProvider read Get_ClientProvider write Set_ClientProvider;
  end;

  IJvDataContextSearch = interface
    ['{C8513B84-FAA0-4794-A4A9-B2899797F52B}']
    function Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
    function FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
  end;

  IJvDataContextItems = interface
    ['{3303276D-2596-4FDB-BA1C-CE6E043BEB7A}']
    function GetContexts: IJvDataContexts;
  end;

  IJvDataContextItem = interface
    ['{7156CAC8-0DB9-43B7-96C5-5A56723C5158}']
    function GetContext: IJvDataContext;
  end;

  TJvContextProvider = class(TJvCustomDataProvider, IJvDataContextProvider)
    function IJvDataContextProvider.Get_ClientProvider = GetProviderIntf;
    procedure IJvDataContextProvider.Set_ClientProvider = SetProviderIntf;
  private
    function GetProviderIntf: IJvDataProvider;
    procedure SetProviderIntf(Value: IJvDataProvider);
    function GetProviderComp: TComponent;
    procedure SetProviderComp(Value: TComponent);
  protected
    class function ItemsClass: TJvDataItemsClass; override;
    function ConsumerClasses: TClassArray; override;
  public
    property ProviderComp: TComponent read GetProviderComp write SetProviderComp;
    property ProviderIntf: IJvDataProvider read GetProviderIntf write SetProviderIntf;
  published 
    property Provider: IJvDataProvider read GetProviderIntf write SetProviderIntf; 
  end;

  TJvContextProviderServerNotify = class(TJvDataConsumerServerNotify)
  protected
    procedure ItemSelected(Value: IJvDataItem); override;
    function IsValidClient(Client: IJvDataConsumerClientNotify): Boolean; override;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils,
  JvQTypes, JvQResources;

type
  TContextItems = class;
  TContextRootItems = class;
  TContextItem = class;
  TContextItemsManager = class;

  TContextItems = class(TJvBaseDataItems, IJvDataContextItems, IJvDataContextSearch)
  protected
    function GetContexts: IJvDataContexts; virtual;
    function Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
    function FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
    procedure InitImplementers; override;
    function GetCount: Integer; override;
    function GetItem(I: Integer): IJvDataItem; override;
  end;

  TContextRootItems = class(TContextItems)
  private
    FClientProvider: IJvDataProvider;
    FNotifier: TJvProviderNotification;
    procedure SetClientProvider(Value: IJvDataProvider);
    procedure DataProviderChanging(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DataProviderChanged(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
  protected
    function GetContexts: IJvDataContexts; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property ClientProvider: IJvDataProvider read FClientProvider write SetClientProvider;
  end;

  TContextItem = class(TJvBaseDataItem, IJvDataItemText, IJvDataContextItem)
  private
    FContext: IJvDataContext;
    { IContextItem methods }
    function GetContext: IJvDataContext;
    { IJvDataItemText methods }
    function GetCaption: string;
    procedure SetCaption(const Value: string);
    function Editable: Boolean;
  protected
    procedure InitID; override;
    function IsDeletable: Boolean; override;
    constructor CreateCtx(AOwner: IJvDataItems; AContext: IJvDataContext);
  public
    property Context: IJvDataContext read GetContext;
  end;

  TContextItemsManager = class(TJvBaseDataItemsManagement)
  protected
    function GetContexts: IJvDataContexts;
    { IJvDataItemManagement methods }
    function Add(Item: IJvDataItem): IJvDataItem; override;
    function New: IJvDataItem; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Remove(var Item: IJvDataItem); override;
  end;

//=== { TContextItems } ======================================================

function TContextItems.GetContexts: IJvDataContexts;
var
  ParentCtx: IJvDataContext;
begin
  if GetParent <> nil then
  begin
    if Supports(GetParent, IJvDataContext, ParentCtx) then
      Supports(ParentCtx, IJvDataContexts, Result);
  end
  else
    Result := nil;
end;

function TContextItems.Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
var
  CtxStack: array of IJvDataContext;
  CtxIdx: Integer;
begin
  if Context <> nil then
  begin
    if Context.Contexts = GetContexts then
      Result := TContextItem.CreateCtx(Self, Context)
    else
    if Recursive then
    begin
      SetLength(CtxStack, 128); // reserve some space; should be enough for most situations
      CtxIdx := 0;
      while (Context <> nil) and (Context.Contexts <> GetContexts) do
      begin
        if CtxIdx = Length(CtxStack) then
          SetLength(CtxStack, CtxIdx + 128);
        CtxStack[CtxIdx] := Context;
        Inc(CtxIdx);
        Context := Context.Contexts.Ancestor;
      end;
      if Context <> nil then
      begin
        // unwind the stack to create the actual data item
        Result := TContextItem.CreateCtx(Self, Context);
        Dec(CtxIdx);
        while (CtxIdx >= 0) do
        begin
          Result := TContextItem.CreateCtx(Result.GetItems, CtxStack[CtxIdx]);
          Dec(CtxIdx);
        end;
      end;
    end;
  end;
end;

function TContextItems.FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
var
  CtxList: IJvDataContexts;
  Ctx: IJvDataContext;
  I: Integer;
  CtxSubList: IJvDataContexts;
begin
  //TODO: Recursive only checks one level deep!!
  CtxList := GetContexts;
  if CtxList <> nil then
  begin
    Ctx := CtxList.GetContextByName(Name);
    if (Ctx = nil) and (Recursive) then
    begin
      I := 0;
      while I <= CtxList.GetCount do
      begin
        Ctx := CtxList.GetContext(I);
        if Supports(Ctx, IJvDataContexts, CtxSubList) then
        begin
          Ctx := CtxSubList.GetContextByName(Name);
          if Ctx <> nil then
            Break;
        end
        else
          Ctx := nil;
        Inc(I);
      end;
    end;
    if Ctx <> nil then
      Result := TContextItem.CreateCtx(Self, Ctx);
  end;
end;

procedure TContextItems.InitImplementers;
var
  CtxList: IJvDataContexts;
  CtxMan: IJvDataContextsManager;
begin
  CtxList := GetContexts;
  if (CtxList <> nil) and Supports(CtxList, IJvDataContextsManager, CtxMan) then
    TContextItemsManager.Create(Self);
end;

function TContextItems.GetCount: Integer;
var
  ParentCtxList: IJvDataContexts;
begin
  ParentCtxList := GetContexts;
  if ParentCtxList <> nil then
    Result := ParentCtxList.GetCount
  else
    Result := 0;
end;

function TContextItems.GetItem(I: Integer): IJvDataItem;
var
  CtxList: IJvDataContexts;
begin
  CtxList := GetContexts;
  if CtxList <> nil then
    Result := TContextItem.CreateCtx(Self, CtxList.GetContext(I));
end;

//=== { TContextRootItems } ==================================================

constructor TContextRootItems.Create;
begin
  inherited Create;
  FNotifier := TJvProviderNotification.Create;
  FNotifier.OnChanging := DataProviderChanging;
  FNotifier.OnChanged := DataProviderChanged;
end;

destructor TContextRootItems.Destroy;
begin
  FreeAndNil(FNotifier);
  inherited Destroy;
end;

procedure TContextRootItems.SetClientProvider(Value: IJvDataProvider);
begin
  if Value <> FClientProvider then
  begin
    GetProvider.Changing(pcrFullRefresh, nil);
    FClientProvider := Value;
    FNotifier.Provider := Value;
    ClearIntfImpl;
    if Value <> nil then
      InitImplementers;
    GetProvider.Changed(pcrFullRefresh, nil);
  end;
end;

procedure TContextRootItems.DataProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  CtxItem: IJvDataItem;
  ParentList: IJvDataItems;
begin
  case AReason of
    pcrDestroy:
      ClientProvider := nil;
    pcrContextAdd:
      begin
        { Source contains the IJvDataContext where the context is added to or nil if the new
          context is added to the root. }
        if Source <> nil then
        begin
          CtxItem := Find(IJvDataContext(Source), True);
          if CtxItem <> nil then
          begin
            if not Supports(CtxItem, IJvDataItems, ParentList) then
              ParentList := Self;
          end
          else
            ParentList := Self;