Componentes.Terceros.jvcl/official/3.32/run/JvContextProvider.pas

655 lines
19 KiB
ObjectPascal

{-----------------------------------------------------------------------------
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: JvContextProvider.pas 10612 2006-05-19 19:04:09Z jfudickar $
unit JvContextProvider;
{$I jvcl.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
Classes,
JvDataProvider, JvDataProviderIntf;
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
{$IFDEF COMPILER6_UP}
property Provider: IJvDataProvider read GetProviderIntf write SetProviderIntf;
{$ELSE}
property Provider: TComponent read GetProviderComp write SetProviderComp;
{$ENDIF COMPILER6_UP}
end;
TJvContextProviderServerNotify = class(TJvDataConsumerServerNotify)
protected
procedure ItemSelected(Value: IJvDataItem); override;
function IsValidClient(Client: IJvDataConsumerClientNotify): Boolean; override;
end;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvContextProvider.pas $';
Revision: '$Revision: 10612 $';
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
uses
SysUtils,
JvTypes, JvResources;
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;
end
else
ParentList := Self;
GetProvider.Changing(pcrAdd, ParentList);
end;
pcrContextDelete:
begin
{ Source is the IJvDataContext that is about to be destroyed. }
CtxItem := Find(IJvDataContext(Source), True);
GetProvider.Changing(pcrDelete, CtxItem);
end;
pcrContextUpdate:
begin
{ Source is the IJvDataContext that is about to be changed. }
CtxItem := Find(IJvDataContext(Source), True);
GetProvider.Changing(pcrUpdateItem, CtxItem);
end;
end;
end;
procedure TContextRootItems.DataProviderChanged(ADataProvider: IJvDataProvider;
AReason: TDataProviderChangeReason; Source: IUnknown);
var
CtxItem: IJvDataItem;
ParentList: IJvDataItems;
begin
case AReason of
pcrContextAdd:
begin
{ Source contains the IJvDataContext that was just added. }
CtxItem := Find(IJvDataContext(Source), True);
GetProvider.Changed(pcrAdd, CtxItem);
end;
pcrContextDelete:
begin
{ Source is the IJvDataContext from which the item was just removed or nil if the removed
context was at 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;
end
else
ParentList := Self;
GetProvider.Changed(pcrDelete, ParentList);
end;
pcrContextUpdate:
begin
{ Source is the IJvDataContext that has changed. }
CtxItem := Find(IJvDataContext(Source), True);
GetProvider.Changed(pcrUpdateItem, CtxItem);
end;
end;
end;
function TContextRootItems.GetContexts: IJvDataContexts;
var
ParentCtx: IJvDataContext;
begin
if GetParent <> nil then
begin
if Supports(GetParent, IJvDataContext, ParentCtx) then
Supports(ParentCtx, IJvDataContexts, Result);
end
else
Supports(ClientProvider, IJvDataContexts, Result);
end;
//=== { TContextItem } =======================================================
constructor TContextItem.CreateCtx(AOwner: IJvDataItems; AContext: IJvDataContext);
begin
Create(AOwner);
FContext := AContext;
end;
function TContextItem.GetContext: IJvDataContext;
begin
Result := FContext;
end;
function TContextItem.GetCaption: string;
begin
if Context <> nil then
Result := Context.Name
else
Result := RsContextItemEmptyCaption;
end;
procedure TContextItem.SetCaption(const Value: string);
var
CtxMan: IJvDataContextManager;
begin
if Context <> nil then
begin
if Supports(Context, IJvDataContextManager, CtxMan) then
begin
if Context.Name <> Value then
begin
GetItems.GetProvider.Changing(pcrUpdateItem, Self as IJvDataItem);
CtxMan.SetName(Value);
GetItems.GetProvider.Changed(pcrUpdateItem, Self as IJvDataItem);
end;
end;
end
else
raise EJVCLException.CreateRes(@RsENoContextAssigned);
end;
function TContextItem.Editable: Boolean;
begin
Result := True;
end;
procedure TContextItem.InitID;
var
S: string;
Ctx: IJvDataContext;
begin
S := GetContext.Name;
Ctx := GetContext.Contexts.Ancestor;
while Ctx <> nil do
begin
S := Ctx.Name + '\' + S;
Ctx := Ctx.Contexts.Ancestor;
end;
SetID('CTX:' + S);
end;
function TContextItem.IsDeletable: Boolean;
begin
if GetContext <> nil then
Result := GetContext.IsDeletable
else
Result := True;
end;
//=== { TContextItemsManager } ===============================================
function TContextItemsManager.GetContexts: IJvDataContexts;
var
ICI: IJvDataContextItems;
begin
if Supports(Items, IJvDataContextItems, ICI) then
Result := ICI.GetContexts
else
Result := nil;
end;
function TContextItemsManager.Add(Item: IJvDataItem): IJvDataItem;
var
Contexts: IJvDataContexts;
Mngr: IJvDataContextsManager;
CtxItem: IJvDataContextItem;
begin
Contexts := GetContexts;
if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
begin
if Supports(Item, IJvDataContextItem, CtxItem) then
Result := Item
else
raise EJVCLException.CreateRes(@RsENoContextItem);
end;
end;
function TContextItemsManager.New: IJvDataItem;
var
Contexts: IJvDataContexts;
Mngr: IJvDataContextsManager;
begin
Contexts := GetContexts;
if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
Result := Add(TContextItem.CreateCtx(Items, Mngr.New));
end;
procedure TContextItemsManager.Clear;
var
Contexts: IJvDataContexts;
Mngr: IJvDataContextsManager;
begin
Contexts := GetContexts;
if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
Mngr.Clear;
end;
procedure TContextItemsManager.Delete(Index: Integer);
var
Item: IJvDataItem;
begin
Item := Items.GetItem(Index);
if Item <> nil then
Remove(Item);
end;
procedure TContextItemsManager.Remove(var Item: IJvDataItem);
var
Contexts: IJvDataContexts;
Mngr: IJvDataContextsManager;
CtxItem: IJvDataContextItem;
Ctx: IJvDataContext;
begin
Contexts := GetContexts;
if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
begin
if Supports(Item, IJvDataContextItem, CtxItem) then
begin
Ctx := CtxItem.GetContext;
Item := nil;
CtxItem := nil;
Mngr.Delete(Ctx);
end;
end;
end;
//=== { TJvContextProvider } =================================================
function TJvContextProvider.GetProviderIntf: IJvDataProvider;
begin
Result := TContextRootItems(DataItemsImpl).ClientProvider;
end;
procedure TJvContextProvider.SetProviderIntf(Value: IJvDataProvider);
begin
if Value <> ProviderIntf then
TContextRootItems(DataItemsImpl).ClientProvider := Value;
end;
function TJvContextProvider.GetProviderComp: TComponent;
var
ICR: IInterfaceComponentReference;
begin
if Supports(ProviderIntf, IInterfaceComponentReference, ICR) then
Result := ICR.GetComponent
else
Result := nil;
end;
procedure TJvContextProvider.SetProviderComp(Value: TComponent);
var
PI: IJvDataProvider;
ICR: IInterfaceComponentReference;
begin
if (Value = nil) or Supports(Value, IJvDataProvider, PI) then
begin
if (Value = nil) or Supports(Value, IInterfaceComponentReference, ICR) then
ProviderIntf := PI
else
raise EJVCLException.CreateRes(@RsENotSupportedIInterfaceComponentReference);
end
else
raise EJVCLException.CreateRes(@RsENotSupportedIJvDataProvider);
end;
class function TJvContextProvider.ItemsClass: TJvDataItemsClass;
begin
Result := TContextRootItems;
end;
function TJvContextProvider.ConsumerClasses: TClassArray;
begin
Result := inherited ConsumerClasses;
AddToArray(Result, TJvContextProviderServerNotify);
end;
//=== { TJvContextProviderServerNotify } =====================================
procedure TJvContextProviderServerNotify.ItemSelected(Value: IJvDataItem);
var
CtxItem: IJvDataContextItem;
Ctx: IJvDataContext;
I: Integer;
ConCtx: IJvDataConsumerContext;
begin
// First we allow the default behavior to take place
inherited ItemSelected(Value);
// Now we find out which context is selected and update the linked client consumers accordingly.
if Supports(Value, IJvDataContextItem, CtxItem) then
Ctx := CtxItem.GetContext
else
Ctx := nil;
for I := 0 to Clients.Count - 1 do
if Supports(Clients[I], IJvDataConsumerContext, ConCtx) then
ConCtx.SetContext(Ctx);
end;
function TJvContextProviderServerNotify.IsValidClient(Client: IJvDataConsumerClientNotify): Boolean;
var
ClientProv: IJvDataProvider;
ConsumerProv: IJvDataConsumerProvider;
begin
{ Only allow client consumers whose Provider points to the ClientProvider of the context
provider this consumer is linked to. }
ClientProv := (ConsumerImpl.ProviderIntf as IJvDataContextProvider).ClientProvider;
Result := Supports(Client, IJvDataConsumerProvider, ConsumerProv) and
(ConsumerProv.GetProvider = ClientProv);
end;
initialization
{$IFDEF UNITVERSIONING}
RegisterUnitVersion(HInstance, UnitVersioning);
{$ENDIF UNITVERSIONING}
RegisterClasses([TJvContextProviderServerNotify]);
{$IFDEF UNITVERSIONING}
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.