david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
549 lines
16 KiB
ObjectPascal
549 lines
16 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: JvProviderTreeListFrame.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):
|
|
|
|
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: JvProviderTreeListFrame.pas 11692 2008-01-12 12:51:55Z jedi_mbe $
|
|
|
|
unit JvProviderTreeListFrame;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes,
|
|
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls,
|
|
JvJCLUtils, JvDataProvider, JvDataProviderIntf;
|
|
|
|
type
|
|
TGetVirtualRootEvent = procedure(Sender: TObject; var AVirtualRoot: IJvDataItem) of object;
|
|
|
|
TMasterConsumer = class(TJvDataConsumer)
|
|
private
|
|
FSlave: TJvDataConsumer;
|
|
protected
|
|
OldOnChanged: TJvDataConsumerChangeEvent;
|
|
procedure SetSlave(Value: TJvDataConsumer);
|
|
procedure LimitSubServices(Sender: TJvDataConsumer;
|
|
var SubSvcClass: TJvDataConsumerAggregatedObjectClass);
|
|
procedure SlaveChanged(Sender: TJvDataConsumer; Reason: TJvDataConsumerChangeReason);
|
|
public
|
|
constructor Create(AOwner: TComponent);
|
|
destructor Destroy; override;
|
|
function ProviderIntf: IJvDataProvider; override;
|
|
procedure SetProviderIntf(Value: IJvDataProvider); override;
|
|
function ContextIntf: IJvDataContext; override;
|
|
procedure SetContextIntf(Value: IJvDataContext); override;
|
|
function GetInterface(const IID: TGUID; out Obj): Boolean; override;
|
|
|
|
property Slave: TJvDataConsumer read FSlave write SetSlave;
|
|
end;
|
|
|
|
TfmeJvProviderTreeList = class(TFrame)
|
|
lvProvider: TListView;
|
|
procedure lvProviderCustomDrawItem(Sender: TCustomListView;
|
|
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
|
|
procedure lvProviderData(Sender: TObject; Item: TListItem);
|
|
procedure lvProviderDblClick(Sender: TObject);
|
|
procedure lvProviderMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure lvProviderResize(Sender: TObject);
|
|
procedure lvProviderSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
private
|
|
FConsumerSvc: TMasterConsumer;
|
|
FOnGetVirtualRoot: TGetVirtualRootEvent;
|
|
FOnItemSelect: TNotifyEvent;
|
|
FUseVirtualRoot: Boolean;
|
|
FLastSelectIdx: Integer;
|
|
protected
|
|
FVirtualRoot: IJvDataItem;
|
|
function DoGetVirtualRoot: IJvDataItem;
|
|
procedure DoItemSelect;
|
|
procedure SetUseVirtualRoot(Value: Boolean);
|
|
function GetViewList: IJvDataConsumerViewList;
|
|
function UsingVirtualRoot: Boolean;
|
|
procedure UpdateColumnSize;
|
|
procedure NotifyConsumerItemSelect;
|
|
procedure UpdateSelectedItem; virtual;
|
|
procedure ConsumerChanged(Sender: TJvDataConsumer; Reason: TJvDataConsumerChangeReason); virtual;
|
|
procedure GenerateVirtualRoot; dynamic;
|
|
property LastSelectIdx: Integer read FLastSelectIdx write FLastSelectIdx;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetDataItem(Index: Integer): IJvDataItem; virtual;
|
|
function LocateID(ID: string): Integer; virtual;
|
|
procedure SelectItemID(ID: string);
|
|
function GetSelectedIndex: Integer;
|
|
procedure UpdateViewList; virtual;
|
|
property OnGetVirtualRoot: TGetVirtualRootEvent read FOnGetVirtualRoot write FOnGetVirtualRoot;
|
|
property OnItemSelect: TNotifyEvent read FOnItemSelect write FOnItemSelect;
|
|
property Provider: TMasterConsumer read FConsumerSvc;
|
|
property UseVirtualRoot: Boolean read FUseVirtualRoot write SetUseVirtualRoot;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
CommCtrl,
|
|
JvDsgnConsts, JvConsts;
|
|
|
|
{$R *.dfm}
|
|
|
|
function GetItemIndexAt(LV: TListView; X, Y: Integer): Integer;
|
|
var
|
|
Info: TLVHitTestInfo;
|
|
begin
|
|
if LV.HandleAllocated then
|
|
begin
|
|
Info.pt := Point(X, Y);
|
|
Result := ListView_HitTest(LV.Handle, Info);
|
|
if Result >= LV.Items.Count then
|
|
Result := -1;
|
|
end
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
//=== { TMasterConsumer } ====================================================
|
|
|
|
constructor TMasterConsumer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner, [DPA_ConsumerDisplaysList, DPA_RenderDisabledAsGrayed]);
|
|
BeforeCreateSubSvc := LimitSubServices;
|
|
end;
|
|
|
|
destructor TMasterConsumer.Destroy;
|
|
begin
|
|
Slave := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMasterConsumer.SetSlave(Value: TJvDataConsumer);
|
|
var
|
|
CtxList: IJvDataContexts;
|
|
begin
|
|
if Value <> Slave then
|
|
begin
|
|
ProviderChanging;
|
|
Changing(ccrProviderSelect);
|
|
if Slave <> nil then
|
|
Slave.OnChanged := OldOnChanged;
|
|
FSlave := Value;
|
|
if Slave <> nil then
|
|
begin
|
|
OldOnChanged := Slave.OnChanged;
|
|
Slave.OnChanged := SlaveChanged;
|
|
end;
|
|
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;
|
|
if NeedExtensionFixups then
|
|
FixupExtensions;
|
|
ViewChanged(nil);
|
|
Changed(ccrProviderSelect);
|
|
end;
|
|
end;
|
|
|
|
procedure TMasterConsumer.LimitSubServices(Sender: TJvDataConsumer;
|
|
var SubSvcClass: TJvDataConsumerAggregatedObjectClass);
|
|
begin
|
|
if (Slave <> nil) and not SubSvcClass.InheritsFrom(TJvDataConsumerContext) and
|
|
not SubSvcClass.InheritsFrom(TJvDataConsumerItemSelect) and
|
|
not SubSvcClass.InheritsFrom(TJvCustomDataConsumerViewList) then
|
|
SubSvcClass := nil;
|
|
end;
|
|
|
|
procedure TMasterConsumer.SlaveChanged(Sender: TJvDataConsumer;
|
|
Reason: TJvDataConsumerChangeReason);
|
|
begin
|
|
if Reason = ccrViewChange then
|
|
ViewChanged(nil);
|
|
Changed(Reason);
|
|
end;
|
|
|
|
function TMasterConsumer.ProviderIntf: IJvDataProvider;
|
|
begin
|
|
if Slave <> nil then
|
|
Result := Slave.ProviderIntf
|
|
else
|
|
Result := inherited ProviderIntf;
|
|
end;
|
|
|
|
procedure TMasterConsumer.SetProviderIntf(Value: IJvDataProvider);
|
|
begin
|
|
if Slave <> nil then
|
|
Slave.SetProviderIntf(Value)
|
|
else
|
|
inherited SetProviderIntf(Value);
|
|
end;
|
|
|
|
function TMasterConsumer.ContextIntf: IJvDataContext;
|
|
begin
|
|
if Slave <> nil then
|
|
Result := Slave.ContextIntf
|
|
else
|
|
Result := inherited ContextIntf;
|
|
end;
|
|
|
|
procedure TMasterConsumer.SetContextIntf(Value: IJvDataContext);
|
|
begin
|
|
if Slave <> nil then
|
|
Slave.SetContextIntf(Value)
|
|
else
|
|
inherited SetContextIntf(Value);
|
|
end;
|
|
|
|
function TMasterConsumer.GetInterface(const IID: TGUID; out Obj): Boolean;
|
|
begin
|
|
Result := inherited GetInterface(IID, Obj);
|
|
if not Result and not IsEqualGUID(IID, IJvDataConsumerItemSelect) and (Slave <> nil) then
|
|
Result := Slave.GetInterface(IID, Obj);
|
|
end;
|
|
|
|
//=== { TfmeJvProviderTreeList } =============================================
|
|
|
|
constructor TfmeJvProviderTreeList.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FConsumerSvc := TMasterConsumer.Create(Self);
|
|
FConsumerSvc.OnChanged := ConsumerChanged;
|
|
end;
|
|
|
|
destructor TfmeJvProviderTreeList.Destroy;
|
|
begin
|
|
FreeAndNil(FConsumerSvc);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.DoGetVirtualRoot: IJvDataItem;
|
|
begin
|
|
Result := nil;
|
|
if Assigned(FOnGetVirtualRoot) then
|
|
FOnGetVirtualRoot(Self, Result);
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.DoItemSelect;
|
|
begin
|
|
if Assigned(FOnItemSelect) then
|
|
FOnItemSelect(Self);
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.SetUseVirtualRoot(Value: Boolean);
|
|
begin
|
|
if Value <> UseVirtualRoot then
|
|
begin
|
|
FUseVirtualRoot := Value;
|
|
if not Value then
|
|
FVirtualRoot := nil
|
|
else
|
|
GenerateVirtualRoot;
|
|
ConsumerChanged(Provider, ccrViewChange);
|
|
end;
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.GetViewList: IJvDataConsumerViewList;
|
|
begin
|
|
Supports(Provider as IJvDataConsumer, IJvDataConsumerViewList, Result);
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.UsingVirtualRoot: Boolean;
|
|
begin
|
|
Result := UseVirtualRoot and (FVirtualRoot <> nil);
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.UpdateColumnSize;
|
|
begin
|
|
lvProvider.Columns[0].Width := lvProvider.ClientWidth;
|
|
lvProvider.Invalidate;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.NotifyConsumerItemSelect;
|
|
var
|
|
Item: IJvDataItem;
|
|
begin
|
|
if lvProvider.Selected <> nil then
|
|
Item := GetDataItem(lvProvider.Selected.Index)
|
|
else
|
|
Item := nil;
|
|
if Provider.Slave <> nil then
|
|
Provider.Slave.ItemSelected(Item);
|
|
Provider.ItemSelected(Item);
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.UpdateSelectedItem;
|
|
begin
|
|
NotifyConsumerItemSelect;
|
|
DoItemSelect;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.ConsumerChanged(Sender: TJvDataConsumer;
|
|
Reason: TJvDataConsumerChangeReason);
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if UseVirtualRoot and not UsingVirtualRoot then
|
|
GenerateVirtualRoot;
|
|
if Reason in [ccrProviderSelect, ccrViewChange] then
|
|
UpdateViewList;
|
|
if (lvProvider.Items.Count > 0) and (Reason = ccrViewChange) then
|
|
with lvProvider do
|
|
UpdateItems(TopItem.Index, TopItem.Index + VisibleRowCount);
|
|
lvProvider.Invalidate;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.GenerateVirtualRoot;
|
|
begin
|
|
FVirtualRoot := DoGetVirtualRoot;
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.GetDataItem(Index: Integer): IJvDataItem;
|
|
begin
|
|
Provider.Enter;
|
|
try
|
|
if UsingVirtualRoot and (Index = 0) then
|
|
Result := FVirtualRoot
|
|
else
|
|
if (Index >= Ord(UsingVirtualRoot)) and ((Index - Ord(UsingVirtualRoot)) < GetViewList.Count) then
|
|
Result := GetViewList.Item(Index - Ord(UsingVirtualRoot));
|
|
finally
|
|
Provider.Leave;
|
|
end;
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.LocateID(ID: string): Integer;
|
|
begin
|
|
Provider.Enter;
|
|
try
|
|
if UsingVirtualRoot and AnsiSameText(ID, FVirtualRoot.GetID) then
|
|
Result := 0
|
|
else
|
|
begin
|
|
Result := GetViewList.IndexOfID(ID);
|
|
if UsingVirtualRoot and (Result >= 0) then
|
|
Inc(Result);
|
|
end;
|
|
finally
|
|
Provider.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.SelectItemID(ID: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if ID = '' then
|
|
I := -1
|
|
else
|
|
I := LocateID(ID);
|
|
if I > -1 then
|
|
ListView_SetItemState(lvProvider.Handle, I, LVIS_SELECTED or LVIS_FOCUSED,
|
|
LVIS_SELECTED or LVIS_FOCUSED)
|
|
else
|
|
lvProvider.Selected := nil;
|
|
UpdateSelectedItem;
|
|
end;
|
|
|
|
function TfmeJvProviderTreeList.GetSelectedIndex: Integer;
|
|
begin
|
|
if lvProvider.Selected = nil then
|
|
Result := -1
|
|
else
|
|
Result := lvProvider.Selected.Index;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.UpdateViewList;
|
|
var
|
|
ViewList: IJvDataConsumerViewList;
|
|
begin
|
|
ViewList := GetViewList;
|
|
if ViewList <> nil then
|
|
lvProvider.Items.Count := ViewList.Count + Ord(UsingVirtualRoot)
|
|
else
|
|
lvProvider.Items.Count := 0;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderCustomDrawItem(
|
|
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
|
|
var DefaultDraw: Boolean);
|
|
var
|
|
ACanvas: TCanvas;
|
|
ARect: TRect;
|
|
BtnWdth: Integer;
|
|
MidX, MidY: Integer;
|
|
begin
|
|
ARect := Item.DisplayRect(drBounds);
|
|
ARect.Right := Sender.ClientRect.Right;
|
|
|
|
ACanvas := Sender.Canvas;
|
|
DefaultDraw := False;
|
|
if Item.Selected then
|
|
begin
|
|
ACanvas.Brush.Color := clHighlight;
|
|
ACanvas.Brush.Style := bsSolid;
|
|
ACanvas.Font.Color := clHighlightText;
|
|
ACanvas.FillRect(ARect);
|
|
end
|
|
else
|
|
begin
|
|
ACanvas.Brush.Color := clWindow;
|
|
ACanvas.Brush.Style := bsSolid;
|
|
ACanvas.Font.Color := clWindowText;
|
|
ACanvas.FillRect(ARect);
|
|
end;
|
|
BtnWdth := Succ(ARect.Bottom - ARect.Top) + 2;
|
|
ARect.Left := ARect.Left + (BtnWdth * Item.Indent);
|
|
if (UsingVirtualRoot and (Item.Index = 0)) or
|
|
GetViewList.ItemHasChildren(Item.Index - Ord(UsingVirtualRoot)) then
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
MidX := ARect.Left + (BtnWdth - 3) div 2;
|
|
MidY := ARect.Top + (BtnWdth - 3) div 2;
|
|
Pen.Color := ACanvas.Font.Color;
|
|
Pen.Style := psSolid;
|
|
Pen.Width := 1;
|
|
MoveTo(ARect.Left + 3, ARect.Top + 3);
|
|
LineTo(ARect.Left + BtnWdth - 6, ARect.Top + 3);
|
|
LineTo(ARect.Left + BtnWdth - 6, ARect.Top + BtnWdth - 6);
|
|
LineTo(ARect.Left + 3, ARect.Top + BtnWdth - 6);
|
|
LineTo(ARect.Left + 3, ARect.Top + 3);
|
|
|
|
MoveTo(ARect.Left + 5, MidY);
|
|
LineTo(ARect.Left + BtnWdth - 7, MidY);
|
|
|
|
if (not UsingVirtualRoot or (Item.Index <> 0)) and
|
|
not GetViewList.ItemIsExpanded(Item.Index - Ord(UsingVirtualRoot)) then
|
|
begin
|
|
MoveTo(MidX, ARect.Top + 5);
|
|
LineTo(MidX, ARect.Top + BtnWdth - 7);
|
|
end;
|
|
end;
|
|
end;
|
|
ARect.Left := ARect.Left + BtnWdth;
|
|
DrawText(ACanvas.Handle, TCaption(Item.Caption), Length(Item.Caption), ARect,
|
|
DT_SINGLELINE + DT_LEFT + DT_END_ELLIPSIS);
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderData(Sender: TObject;
|
|
Item: TListItem);
|
|
var
|
|
DataItem: IJvDataItem;
|
|
ItemText: IJvDataItemText;
|
|
begin
|
|
if (Provider.ProviderIntf = nil) or
|
|
((Item.Index - Ord(UsingVirtualRoot)) >= GetViewList.Count) then
|
|
Exit;
|
|
Provider.Enter;
|
|
try
|
|
if UsingVirtualRoot and (Item.Index = 0) then
|
|
begin
|
|
DataItem := FVirtualRoot;
|
|
Item.Indent := 0;
|
|
end
|
|
else
|
|
begin
|
|
DataItem := GetViewList.Item(Item.Index - Ord(UsingVirtualRoot));
|
|
Item.Indent := GetViewList.ItemLevel(Item.Index - Ord(UsingVirtualRoot)) + Ord(UsingVirtualRoot);
|
|
end;
|
|
if DataItem <> nil then
|
|
begin
|
|
if Supports(DataItem, IJvDataItemText, ItemText) then
|
|
Item.Caption := ItemText.Text
|
|
else
|
|
begin
|
|
if DataItem = FVirtualRoot then
|
|
Item.Caption := RsDataItemRootCaption
|
|
else
|
|
Item.Caption := RsDataItemNoTextIntf;
|
|
end;
|
|
end
|
|
finally
|
|
Provider.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderDblClick(Sender: TObject);
|
|
begin
|
|
Provider.Enter;
|
|
try
|
|
if lvProvider.Selected <> nil then
|
|
if lvProvider.Selected.Index >= Ord(UsingVirtualRoot) then
|
|
GetViewList.ToggleItem(lvProvider.Selected.Index - Ord(UsingVirtualRoot));
|
|
finally
|
|
Provider.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Item: Integer;
|
|
ItemLevel: Integer;
|
|
TmpRect: TRect;
|
|
begin
|
|
Provider.Enter;
|
|
try
|
|
Item := GetItemIndexAt(lvProvider, X, Y);
|
|
if Item <> -1 then
|
|
begin
|
|
if UsingVirtualRoot and (Item = 0) then
|
|
ItemLevel := 0
|
|
else
|
|
ItemLevel := GetViewList.ItemLevel(Item - Ord(UsingVirtualRoot)) + Ord(UsingVirtualRoot);
|
|
ListView_GetItemRect(lvProvider.Handle, Item, TmpRect, LVIR_BOUNDS);
|
|
TmpRect.Right := TmpRect.Left + (Succ((TmpRect.Bottom - TmpRect.Top) + 2) * Succ(ItemLevel));
|
|
if (X < TmpRect.Right) and (X > TmpRect.Right - ((TmpRect.Bottom - TmpRect.Top) + 2)) then
|
|
if Item >= Ord(UsingVirtualRoot) then
|
|
GetViewList.ToggleItem(Item - Ord(UsingVirtualRoot));
|
|
end;
|
|
finally
|
|
Provider.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderResize(Sender: TObject);
|
|
begin
|
|
UpdateColumnSize;
|
|
end;
|
|
|
|
procedure TfmeJvProviderTreeList.lvProviderSelectItem(Sender: TObject;
|
|
Item: TListItem; Selected: Boolean);
|
|
begin
|
|
UpdateSelectedItem;
|
|
if Selected then
|
|
FLastSelectIdx := Item.Index
|
|
else
|
|
FLastSelectIdx := -1;
|
|
end;
|
|
|
|
end.
|