Componentes.Terceros.jvcl/official/3.00/design/JvProviderTreeListFrame.pas

629 lines
18 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,v 1.26 2005/03/10 09:13:00 marquardt Exp $
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
{$IFDEF VCL}
CommCtrl,
{$ENDIF VCL}
JvDsgnConsts, JvConsts;
{$R *.dfm}
function GetItemIndexAt(LV: TListView; X, Y: Integer): Integer;
var
{$IFDEF VCL}
Info: TLVHitTestInfo;
{$ENDIF VCL}
{$IFDEF VisualCLX}
Item: TListItem;
{$ENDIF VisualCLX}
begin
if LV.HandleAllocated then
begin
{$IFDEF VCL}
Info.pt := Point(X, Y);
Result := ListView_HitTest(LV.Handle, Info);
if Result >= LV.Items.Count then
Result := -1;
{$ENDIF VCL}
{$IFDEF VisualCLX}
Item := LV.GetItemAt(X, Y);
if Item <> nil then
Result := Item.Index
else
Result := -1;
{$ENDIF VisualCLX}
end
else
Result := -1;
end;
{$IFDEF VisualCLX}
function GetVisibleRowCount(LV: TListView): Integer;
var
Item1, Item2: TListItem;
begin
Result := LV.Items.Count;
Item1 := LV.TopItem;
if Item1 <> nil then
begin
Item2 := LV.GetItemAt(LV.Width div 2, LV.ClientHeight - 1);
if Item2 <> nil then
Result := Item2.Index - Item1.Index + 1;
end;
end;
{$ENDIF VisualCLX}
//=== { 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
{$IFDEF VCL}
with lvProvider do
UpdateItems(TopItem.Index, TopItem.Index + VisibleRowCount);
{$ENDIF VCL}
{$IFDEF VisualCLX}
with lvProvider do
UpdateItems(TopItem.Index, TopItem.Index + GetVisibleRowCount(lvProvider));
{$ENDIF VisualCLX}
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
{$IFDEF VCL}
ListView_SetItemState(lvProvider.Handle, I, LVIS_SELECTED or LVIS_FOCUSED,
LVIS_SELECTED or LVIS_FOCUSED)
{$ENDIF VCL}
{$IFDEF VisualCLX}
begin
lvProvider.Items[I].Selected := True;
lvProvider.Items[I].Focused := True;
end
{$ENDIF VisualCLX}
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;
{$IFDEF VCL}
var
ViewList: IJvDataConsumerViewList;
{$ENDIF VCL}
begin
{$IFDEF VCL}
ViewList := GetViewList;
if ViewList <> nil then
lvProvider.Items.Count := ViewList.Count + Ord(UsingVirtualRoot)
else
lvProvider.Items.Count := 0;
{$ENDIF VCL}
end;
procedure TfmeJvProviderTreeList.lvProviderCustomDrawItem(
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
ACanvas: TCanvas;
ARect: TRect;
BtnWdth: Integer;
MidX, MidY: Integer;
begin
{$IFDEF VCL}
ARect := Item.DisplayRect(drBounds);
ARect.Right := Sender.ClientRect.Right;
ACanvas := Sender.Canvas;
{$ENDIF VCL}
{$IFDEF VisualCLX}
ARect := Item.DisplayRect;
ARect.Right := Sender.ClientRect.Right;
ACanvas := TControlCanvas.Create;
TControlCanvas(ACanvas).Control := Sender;
try
ACanvas.Start;
{$ENDIF VisualCLX}
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;
{$IFDEF VCL}
ARect.Left := ARect.Left + (BtnWdth * Item.Indent);
{$ENDIF VCL}
{$IFDEF VisualCLX}
ARect.Left := ARect.Left + (BtnWdth * 1);
{$ENDIF VisualCLX}
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);
{$IFDEF VisualCLX}
ACanvas.Stop;
finally
ACanvas.Free;
end;
{$ENDIF VisualCLX}
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;
{$IFDEF VCL}
Item.Indent := 0;
{$ENDIF VCL}
end
else
begin
DataItem := GetViewList.Item(Item.Index - Ord(UsingVirtualRoot));
{$IFDEF VCL}
Item.Indent := GetViewList.ItemLevel(Item.Index - Ord(UsingVirtualRoot)) + Ord(UsingVirtualRoot);
{$ENDIF VCL}
end;
if DataItem <> nil then
begin
if Supports(DataItem, IJvDataItemText, ItemText) then
Item.Caption := ItemText.Caption
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);
{$IFDEF VCL}
ListView_GetItemRect(lvProvider.Handle, Item, TmpRect, LVIR_BOUNDS);
{$ENDIF VCL}
{$IFDEF VisualCLX}
TmpRect := lvProvider.Items[Item].DisplayRect;
{$ENDIF VisualCLX}
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.