Componentes.Terceros.DevExp.../internal/x.42/2/ExpressEditors Library 5/Sources/cxShellTreeView.pas

1164 lines
36 KiB
ObjectPascal

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressEditors }
{ }
{ Copyright (c) 1998-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSEDITORS AND ALL }
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{********************************************************************}
unit cxShellTreeView;
{$I cxVer.inc}
interface
uses
Windows, Messages, Classes, ComCtrls, CommCtrl, Controls, Forms, Graphics,
ImgList, Menus, ShlObj, StdCtrls, cxContainer, cxDataUtils, cxShellListView,
cxShellCommon, cxShellControls;
type
TcxCustomShellTreeView = class;
{ TcxInnerShellTreeView }
TcxInnerShellTreeView = class(TcxCustomInnerShellTreeView, IUnknown,
IcxContainerInnerControl)
private
// IcxContainerInnerControl
function GetControl: TWinControl;
function GetControlContainer: TcxContainer;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure DSMShellChangeNotify(var Message: TMessage); message DSM_SHELLCHANGENOTIFY;
procedure TVMEnsureVisible(var Message: TMessage); message TVM_ENSUREVISIBLE;
protected
FContainer: TcxCustomShellTreeView;
procedure Click; override;
procedure DblClick; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean); override;
function GetPopupMenu: TPopupMenu; override;
function IsLoading: Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure WndProc(var Message: TMessage); override;
procedure MouseEnter(AControl: TControl); dynamic;
procedure MouseLeave(AControl: TControl); dynamic;
property Container: TcxCustomShellTreeView read FContainer;
public
constructor Create(AOwner: TComponent); override;
function CanFocus: Boolean; override;
procedure DragDrop(Source: TObject; X, Y: Integer); override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
property Align;
property Anchors;
property AutoExpand;
property BorderStyle;
property ChangeDelay;
property Color;
property Ctl3D;
property Cursor;
property DragDropSettings;
property Enabled;
property Font;
property HideSelection;
property HotTrack;
property Indent;
property Items;
property ListView;
property Options;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RightClickSelect;
property Root;
property ShowButtons;
property ShowHint;
property ShowLines;
property ShowRoot;
property StateImages;
property TabOrder;
property TabStop default True;
property Visible;
property OnAddFolder;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnDblClick;
property OnEdited;
property OnEditing;
property OnEnter;
property OnExit;
property OnExpanded;
property OnExpanding;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnRootChanged;
property OnShellChange;
end;
{ TcxCustomShellTreeView }
TcxCustomShellTreeView = class(TcxContainer)
private
FInnerTreeView: TcxInnerShellTreeView;
FIsExitProcessing: Boolean;
FScrollBarsCalculating: Boolean;
FOnAddFolder: TcxShellAddFolderEvent;
FOnChange: TTVChangedEvent;
FOnChanging: TTVChangingEvent;
FOnCollapsed: TTVExpandedEvent;
FOnCollapsing: TTVCollapsingEvent;
FOnEdited: TTVEditedEvent;
FOnEditing: TTVEditingEvent;
FOnExpanded: TTVExpandedEvent;
FOnExpanding: TTVExpandingEvent;
FOnShellChange: TcxShellChangeEvent;
procedure AddFolderHandler(Sender: TObject; AFolder: TcxShellFolder;
var ACanAdd: Boolean);
procedure ChangeHandler(Sender: TObject; Node: TTreeNode);
procedure ChangingHandler(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
procedure CollapsedHandler(Sender: TObject; Node: TTreeNode);
procedure CollapsingHandler(Sender: TObject; Node: TTreeNode;
var AllowCollapse: Boolean);
procedure EditedHandler(Sender: TObject; Node: TTreeNode; var S: string);
procedure EditingHandler(Sender: TObject; Node: TTreeNode;
var AllowEdit: Boolean);
procedure ExpandedHandler(Sender: TObject; Node: TTreeNode);
procedure ExpandingHandler(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure ShellChangeHandler(Sender: TObject; AEventID: DWORD;
APIDL1, APIDL2: PItemIDList);
function GetAbsolutePIDL: PItemIDList;
function GetAutoExpand: Boolean;
function GetChangeDelay: Integer;
function GetDragDropSettings: TcxDragDropSettings;
function GetFolder(AIndex: Integer): TcxShellFolder;
function GetFolderCount: Integer;
function GetHideSelection: Boolean;
function GetIndent: Integer;
function GetOptions: TcxShellTreeViewOptions;
function GetPath: string;
function GetRightClickSelect: Boolean;
function GetRoot: TcxShellTreeRoot;
function GetShellListView: TcxCustomShellListView;
function GetShowButtons: Boolean;
function GetShowInfoTips: Boolean;
function GetShowLines: Boolean;
function GetShowRoot: Boolean;
function GetStateImages: TCustomImageList;
function GetTreeHotTrack: Boolean;
procedure SetAbsolutePIDL(Value: PItemIDList);
procedure SetAutoExpand(Value: Boolean);
procedure SetChangeDelay(Value: Integer);
procedure SetDragDropSettings(Value: TcxDragDropSettings);
procedure SetHideSelection(Value: Boolean);
procedure SetIndent(Value: Integer);
procedure SetOptions(Value: TcxShellTreeViewOptions);
procedure SetPath(const Value: string);
procedure SetRightClickSelect(Value: Boolean);
procedure SetRoot(Value: TcxShellTreeRoot);
procedure SetShellListView(Value: TcxCustomShellListView);
procedure SetShowButtons(Value: Boolean);
procedure SetShowInfoTips(Value: Boolean);
procedure SetShowLines(Value: Boolean);
procedure SetShowRoot(Value: Boolean);
procedure SetStateImages(Value: TCustomImageList);
procedure SetTreeHotTrack(Value: Boolean);
protected
FDataBinding: TcxCustomDataBinding;
procedure DoExit; override;
procedure Loaded; override;
function NeedsScrollBars: Boolean; override;
procedure Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode;
var AScrollPos: Integer); override;
procedure CurrentFolderChangedHandler(Sender: TObject; Root: TcxCustomShellRoot); virtual;
function GetDataBindingClass: TcxCustomDataBindingClass; virtual;
function GetViewOptions(AForNavigation: Boolean = False): TcxShellViewOptions;
property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False;
property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0;
property DataBinding: TcxCustomDataBinding read FDataBinding;
property DragDropSettings: TcxDragDropSettings read GetDragDropSettings write SetDragDropSettings;
property HideSelection: Boolean read GetHideSelection write SetHideSelection default True;
property Indent: Integer read GetIndent write SetIndent;
property Options: TcxShellTreeViewOptions read GetOptions write SetOptions;
property RightClickSelect: Boolean read GetRightClickSelect
write SetRightClickSelect default False;
property Root: TcxShellTreeRoot read GetRoot write SetRoot;
property ShellListView: TcxCustomShellListView read GetShellListView write SetShellListView;
property ShowButtons: Boolean read GetShowButtons write SetShowButtons default True;
property ShowInfoTips: Boolean read GetShowInfoTips
write SetShowInfoTips default False;
property ShowLines: Boolean read GetShowLines write SetShowLines default True;
property ShowRoot: Boolean read GetShowRoot write SetShowRoot default True;
property StateImages: TCustomImageList read GetStateImages write SetStateImages;
property TreeHotTrack: Boolean read GetTreeHotTrack write SetTreeHotTrack default False;
property OnAddFolder: TcxShellAddFolderEvent read FOnAddFolder write FOnAddFolder;
property OnChange: TTVChangedEvent read FOnChange write FOnChange;
property OnChanging: TTVChangingEvent read FOnChanging write FOnChanging;
property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed;
property OnCollapsing: TTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited;
property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing;
property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
property OnShellChange: TcxShellChangeEvent read FOnShellChange write FOnShellChange;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
procedure SetFocus; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function GetNodeAbsolutePIDL(ANode: TTreeNode): PItemIDList;
procedure UpdateContent;
property AbsolutePath: string read GetPath write SetPath; // deprecated;
property AbsolutePIDL: PItemIDList read GetAbsolutePIDL write SetAbsolutePIDL;
property FolderCount: Integer read GetFolderCount;
property Folders[AIndex: Integer]: TcxShellFolder read GetFolder;
property InnerTreeView: TcxInnerShellTreeView read FInnerTreeView;
property Path: string read GetPath write SetPath;
// property RelativePIDL: PItemIDList write SetRelativePIDL; // TODO
end;
{ TcxShellTreeView }
TcxShellTreeView = class(TcxCustomShellTreeView)
published
property Align;
property Anchors;
property AutoExpand;
property ChangeDelay;
property Constraints;
property DragDropSettings;
property Enabled;
property HideSelection;
property Indent;
property Options;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RightClickSelect;
property Root;
property ShellListView;
property ShowButtons;
property ShowHint;
property ShowInfoTips;
property ShowLines;
property ShowRoot;
property StateImages;
property Style;
property StyleDisabled;
property StyleFocused;
property StyleHot;
property TabOrder;
property TabStop;
property TreeHotTrack;
property Visible;
property OnAddFolder;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnDblClick;
property OnEdited;
property OnEditing;
property OnEnter;
property OnExit;
property OnExpanded;
property OnExpanding;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnShellChange;
end;
implementation
uses
SysUtils, cxClasses, cxEdit, cxScrollBar;
type
TcxContainerAccess = class(TcxContainer);
TcxCustomDataBindingAccess = class(TcxCustomDataBinding);
TcxInnerShellListViewAccess = class(TcxInnerShellListView);
TcxShellTreeItemProducerAccess = class(TcxShellTreeItemProducer);
{ TcxInnerShellTreeView }
constructor TcxInnerShellTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BorderStyle := bsNone;
ControlStyle := ControlStyle + [csDoubleClicks];
ParentColor := False;
ParentFont := True;
end;
function TcxInnerShellTreeView.CanFocus: Boolean;
begin
Result := Container.CanFocus;
end;
procedure TcxInnerShellTreeView.DragDrop(Source: TObject; X, Y: Integer);
begin
if Container <> nil then
Container.DragDrop(Source, Left + X, Top + Y);
end;
function TcxInnerShellTreeView.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or
TcxCustomDataBindingAccess(Container.FDataBinding).ExecuteAction(Action);
end;
function TcxInnerShellTreeView.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or
TcxCustomDataBindingAccess(Container.FDataBinding).UpdateAction(Action);
end;
procedure TcxInnerShellTreeView.Click;
begin
inherited Click;
if Container <> nil then
Container.Click;
end;
procedure TcxInnerShellTreeView.DblClick;
begin
inherited DblClick;
if Container <> nil then
Container.DblClick;
end;
function TcxInnerShellTreeView.DoMouseWheel(Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
Result := (Container <> nil) and Container.DoMouseWheel(Shift,
WheelDelta, MousePos);
if not Result then
inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;
procedure TcxInnerShellTreeView.DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if Container <> nil then
Container.DragOver(Source, Left + X, Top + Y, State, Accept);
end;
function TcxInnerShellTreeView.GetPopupMenu: TPopupMenu;
begin
if Container = nil then
Result := inherited GetPopupMenu
else
Result := Container.GetPopupMenu;
end;
function TcxInnerShellTreeView.IsLoading: Boolean;
begin
Result := csLoading in Container.ComponentState;
end;
procedure TcxInnerShellTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Container <> nil then
Container.KeyDown(Key, Shift);
if Key <> 0 then
inherited KeyDown(Key, Shift);
end;
procedure TcxInnerShellTreeView.KeyPress(var Key: Char);
begin
if Key = Char(VK_TAB) then
Key := #0;
if Container <> nil then
Container.KeyPress(Key);
if Word(Key) = VK_RETURN then
Key := #0;
if Key <> #0 then
inherited KeyPress(Key);
end;
procedure TcxInnerShellTreeView.KeyUp(var Key: Word; Shift: TShiftState);
begin
if Key = VK_TAB then
Key := 0;
if Container <> nil then
Container.KeyUp(Key, Shift);
if Key <> 0 then
inherited KeyUp(Key, Shift);
end;
procedure TcxInnerShellTreeView.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if Container <> nil then
with Container do
begin
InnerControlMouseDown := True;
try
MouseDown(Button, Shift, X + Self.Left, Y + Self.Top);
finally
InnerControlMouseDown := False;
end;
end;
end;
procedure TcxInnerShellTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if Container <> nil then
Container.MouseMove(Shift, X + Left, Y + Top);
end;
procedure TcxInnerShellTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if Container <> nil then
Container.MouseUp(Button, Shift, X + Left, Y + Top);
end;
procedure TcxInnerShellTreeView.CreateWindowHandle(const Params: TCreateParams);
begin
inherited CreateWindowHandle(Params);
Container.SetScrollBarsParameters;
end;
procedure TcxInnerShellTreeView.WndProc(var Message: TMessage);
begin
if (Container <> nil) and Container.InnerControlMenuHandler(Message) then
Exit;
{$IFNDEF DELPHI5}
if Message.Msg = WM_RBUTTONDOWN then
begin
Container.LockPopupMenu(True);
try
inherited WndProc(Message);
finally
Container.LockPopupMenu(False);
end;
Exit;
end;
{$ENDIF}
if Container <> nil then
if ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
(Container.DragMode = dmAutomatic) and not Container.IsDesigning then
begin
Container.BeginAutoDrag;
Exit;
end;
inherited WndProc(Message);
case Message.Msg of
WM_HSCROLL,
// WM_MOUSEWHEEL,
WM_VSCROLL,
WM_WINDOWPOSCHANGED,
CM_WININICHANGE:
Container.SetScrollBarsParameters;
end;
end;
procedure TcxInnerShellTreeView.MouseEnter(AControl: TControl);
begin
end;
procedure TcxInnerShellTreeView.MouseLeave(AControl: TControl);
begin
if Container <> nil then
Container.ShortRefreshContainer(True);
end;
function TcxInnerShellTreeView.GetControl: TWinControl;
begin
Result := Self;
end;
function TcxInnerShellTreeView.GetControlContainer: TcxContainer;
begin
Result := FContainer;
end;
procedure TcxInnerShellTreeView.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
if Container <> nil then
with Message do
begin
Result := Result or DLGC_WANTCHARS;
if GetKeyState(VK_CONTROL) >= 0 then
Result := Result or DLGC_WANTTAB;
end;
end;
procedure TcxInnerShellTreeView.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
if (Container <> nil) and not Container.IsDestroying then
Container.FocusChanged;
end;
procedure TcxInnerShellTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
if UsecxScrollBars and not Container.FScrollBarsCalculating then
Container.SetScrollBarsParameters;
end;
procedure TcxInnerShellTreeView.WMNCPaint(var Message: TMessage);
var
DC: HDC;
ABrush: HBRUSH;
begin
if not UsecxScrollBars then
begin
inherited;
Exit;
end;
Message.Result := 1;
if UsecxScrollBars and Container.HScrollBar.Visible and Container.VScrollBar.Visible then
begin
DC := GetWindowDC(Handle);
ABrush := 0;
try
with Container.LookAndFeel do
ABrush := CreateSolidBrush(ColorToRGB(Painter.DefaultSizeGripAreaColor));
FillRect(DC, GetSizeGripRect(Self), ABrush);
finally
if ABrush <> 0 then
DeleteObject(ABrush);
ReleaseDC(Handle, DC);
end;
end;
end;
procedure TcxInnerShellTreeView.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (Container <> nil) and not Container.IsDestroying and not(csDestroying in ComponentState)
and (Message.FocusedWnd <> Container.Handle) then
Container.FocusChanged;
end;
procedure TcxInnerShellTreeView.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
ARgn: HRGN;
begin
inherited;
if csDestroying in ComponentState then
Exit;
if Container.HScrollBar.Visible and Container.VScrollBar.Visible then
begin
ARgn := CreateRectRgnIndirect(GetSizeGripRect(Self));
SendMessage(Handle, WM_NCPAINT, ARgn, 0);
DeleteObject(ARgn);
end;
end;
procedure TcxInnerShellTreeView.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Message.lParam = 0 then
MouseEnter(Self)
else
MouseEnter(TControl(Message.lParam));
end;
procedure TcxInnerShellTreeView.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Message.lParam = 0 then
MouseLeave(Self)
else
MouseLeave(TControl(Message.lParam));
end;
procedure TcxInnerShellTreeView.DSMShellChangeNotify(var Message: TMessage);
begin
inherited;
Container.SetScrollBarsParameters;
end;
procedure TcxInnerShellTreeView.TVMEnsureVisible(var Message: TMessage);
begin
inherited;
Container.SetScrollBarsParameters;
end;
{ TcxCustomShellTreeView }
constructor TcxCustomShellTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataBinding := GetDataBindingClass.Create(Self, Self);
with TcxCustomDataBindingAccess(FDataBinding) do
begin
OnDataChange := Self.DataChange;
OnDataSetChange := Self.DataSetChange;
OnUpdateData := Self.UpdateData;
end;
FInnerTreeView := TcxInnerShellTreeView.Create(Self);
with FInnerTreeView do
begin
FContainer := Self;
LookAndFeel.MasterLookAndFeel := Self.Style.LookAndFeel;
Parent := Self;
OnAddFolder := Self.AddFolderHandler;
OnChange := Self.ChangeHandler;
OnChanging := Self.ChangingHandler;
OnCollapsed := Self.CollapsedHandler;
OnCollapsing := Self.CollapsingHandler;
OnEdited := Self.EditedHandler;
OnEditing := Self.EditingHandler;
OnExpanded := Self.ExpandedHandler;
OnExpanding := Self.ExpandingHandler;
OnRootChanged := Self.CurrentFolderChangedHandler;
OnShellChange := Self.ShellChangeHandler;
end;
InnerControl := FInnerTreeView;
HScrollBar.SmallChange := 1;
VScrollBar.SmallChange := 1;
Width := 121;
Height := 97;
end;
destructor TcxCustomShellTreeView.Destroy;
begin
FreeAndNil(FInnerTreeView);
FreeAndNil(FDataBinding);
inherited Destroy;
end;
function TcxCustomShellTreeView.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or
TcxCustomDataBindingAccess(FDataBinding).ExecuteAction(Action);
end;
procedure TcxCustomShellTreeView.SetFocus;
begin
if not IsDesigning then
inherited SetFocus;
end;
function TcxCustomShellTreeView.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or
TcxCustomDataBindingAccess(FDataBinding).UpdateAction(Action);
end;
function TcxCustomShellTreeView.GetNodeAbsolutePIDL(ANode: TTreeNode): PItemIDList;
var
AIFolder: IShellFolder;
AList: TStringList;
ATempPIDL1, ATempPIDL2: PItemIDList;
AViewOptions: TcxShellViewOptions;
I: Integer;
begin
with TcxShellTreeItemProducerAccess(ANode.Data) do
if FolderPidl <> nil then
begin
Result := GetPidlCopy(FolderPidl);
Exit;
end;
CheckShellRoot(Root);
Result := GetPidlCopy(Root.Pidl);
if ANode.Parent = nil then
Exit;
AList := TStringList.Create;
try
repeat
AList.Insert(0, ANode.Text);
ANode := ANode.Parent;
until ANode.Parent = nil;
AIFolder := Root.ShellFolder;
AViewOptions := GetViewOptions;
for I := 0 to AList.Count - 1 do
begin
ATempPIDL1 := InternalParseDisplayName(AIFolder, AList[I], AViewOptions);
ATempPIDL2 := Result;
Result := ConcatenatePidls(Result, ATempPIDL1);
if I < AList.Count - 1 then
AIFolder.BindToObject(ATempPIDL1, nil, IID_IShellFolder, Pointer(AIFolder));
DisposePidl(ATempPIDL1);
DisposePidl(ATempPIDL2);
end;
finally
AList.Free;
end;
end;
procedure TcxCustomShellTreeView.UpdateContent;
begin
FInnerTreeView.UpdateContent;
end;
procedure TcxCustomShellTreeView.DoExit;
begin
if IsDestroying or FIsExitProcessing then
Exit;
FIsExitProcessing := True;
try
try
DataBinding.UpdateDataSource;
except
SetFocus;
raise;
end;
inherited DoExit;
finally
FIsExitProcessing := False;
end;
end;
procedure TcxCustomShellTreeView.Loaded;
begin
inherited Loaded;
InnerTreeView.Loaded;
SetScrollBarsParameters;
end;
function TcxCustomShellTreeView.NeedsScrollBars: Boolean;
begin
Result := True;
end;
procedure TcxCustomShellTreeView.Scroll(AScrollBarKind: TScrollBarKind;
AScrollCode: TScrollCode; var AScrollPos: Integer);
var
AScrollInfo: TScrollInfo;
begin
inherited Scroll(AScrollBarKind, AScrollCode, AScrollPos);
if not Enabled then
Exit;
with FInnerTreeView do
if AScrollBarKind = sbHorizontal then
begin
CallWindowProc(DefWndProc, Handle, WM_HSCROLL, Word(AScrollCode) +
Word(AScrollPos) shl 16, HScrollBar.Handle);
AScrollPos := GetScrollPos(Handle, SB_HORZ);
end
else
begin
if (AScrollCode = scTrack) and (Win32MajorVersion >= 6) then
begin
AScrollInfo.cbSize := SizeOf(AScrollInfo);
AScrollInfo.fMask := SIF_POS;
AScrollInfo.nPos := AScrollPos;
SetScrollInfo(Handle, SB_VERT, AScrollInfo, True);
end;
CallWindowProc(DefWndProc, Handle, WM_VSCROLL, Word(AScrollCode) +
Word(AScrollPos) shl 16, VScrollBar.Handle);
AScrollPos := GetScrollPos(Handle, SB_VERT);
end;
SetScrollBarsParameters(True);
end;
procedure TcxCustomShellTreeView.CurrentFolderChangedHandler(Sender: TObject;
Root: TcxCustomShellRoot);
begin
SetScrollBarsParameters;
end;
function TcxCustomShellTreeView.GetDataBindingClass: TcxCustomDataBindingClass;
begin
Result := TcxDataBinding;
end;
function TcxCustomShellTreeView.GetViewOptions(AForNavigation: Boolean = False): TcxShellViewOptions;
begin
with InnerTreeView do
begin
Result := [];
if Options.ShowNonFolders then
Include(Result, svoShowFiles);
if Options.ShowFolders then
Include(Result, svoShowFolders);
if AForNavigation or Options.ShowHidden then
Include(Result, svoShowHidden);
end;
end;
procedure TcxCustomShellTreeView.AddFolderHandler(Sender: TObject;
AFolder: TcxShellFolder; var ACanAdd: Boolean);
begin
if Assigned(FOnAddFolder) then
FOnAddFolder(Self, AFolder, ACanAdd);
end;
procedure TcxCustomShellTreeView.ChangeHandler(Sender: TObject; Node: TTreeNode);
begin
try
if Assigned(FOnChange) then
FOnChange(Self, Node);
finally
SetScrollBarsParameters;
end;
end;
procedure TcxCustomShellTreeView.ChangingHandler(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
begin
if Assigned(FOnChanging) then
FOnChanging(Self, Node, AllowChange);
end;
procedure TcxCustomShellTreeView.CollapsedHandler(Sender: TObject;
Node: TTreeNode);
begin
try
if Assigned(FOnCollapsed) then
FOnCollapsed(Self, Node);
finally
SetScrollBarsParameters;
end;
end;
procedure TcxCustomShellTreeView.CollapsingHandler(Sender: TObject;
Node: TTreeNode; var AllowCollapse: Boolean);
begin
if Assigned(FOnCollapsing) then
FOnCollapsing(Self, Node, AllowCollapse);
end;
procedure TcxCustomShellTreeView.EditedHandler(Sender: TObject;
Node: TTreeNode; var S: string);
begin
try
if Assigned(FOnEdited) then
FOnEdited(Self, Node, S);
finally
SetScrollBarsParameters;
end;
end;
procedure TcxCustomShellTreeView.EditingHandler(Sender: TObject; Node: TTreeNode;
var AllowEdit: Boolean);
begin
if Assigned(FOnEditing) then
FOnEditing(Self, Node, AllowEdit);
end;
procedure TcxCustomShellTreeView.ExpandedHandler(Sender: TObject;
Node: TTreeNode);
begin
try
if Assigned(FOnExpanded) then
FOnExpanded(Self, Node);
finally
SetScrollBarsParameters;
end;
end;
procedure TcxCustomShellTreeView.ExpandingHandler(Sender: TObject;
Node: TTreeNode; var AllowExpansion: Boolean);
begin
if Assigned(FOnExpanding) then
FOnExpanding(Self, Node, AllowExpansion);
end;
procedure TcxCustomShellTreeView.ShellChangeHandler(Sender: TObject;
AEventID: DWORD; APIDL1, APIDL2: PItemIDList);
begin
if Assigned(FOnShellChange) then
FOnShellChange(Self, AEventID, APIDL1, APIDL2);
end;
function TcxCustomShellTreeView.GetAbsolutePIDL: PItemIDList;
begin
Result := nil;
if FInnerTreeView <> nil then
with FInnerTreeView do
if Selected <> nil then
Result := GetNodeAbsolutePIDL(Selected);
end;
function TcxCustomShellTreeView.GetAutoExpand: Boolean;
begin
Result := FInnerTreeView.AutoExpand;
end;
function TcxCustomShellTreeView.GetChangeDelay: Integer;
begin
Result := FInnerTreeView.ChangeDelay;
end;
function TcxCustomShellTreeView.GetDragDropSettings: TcxDragDropSettings;
begin
Result := TcxDragDropSettings(FInnerTreeView.DragDropSettings);
end;
function TcxCustomShellTreeView.GetFolder(AIndex: Integer): TcxShellFolder;
begin
Result := FInnerTreeView.Folders[AIndex];
end;
function TcxCustomShellTreeView.GetFolderCount: Integer;
begin
Result := FInnerTreeView.FolderCount;
end;
function TcxCustomShellTreeView.GetHideSelection: Boolean;
begin
Result := FInnerTreeView.HideSelection;
end;
function TcxCustomShellTreeView.GetIndent: Integer;
begin
Result := FInnerTreeView.Indent;
end;
function TcxCustomShellTreeView.GetOptions: TcxShellTreeViewOptions;
begin
Result := TcxShellTreeViewOptions(FInnerTreeView.Options);
end;
function TcxCustomShellTreeView.GetPath: string;
var
ATempPIDL: PItemIDList;
begin
Result := '';
if FInnerTreeView <> nil then
with FInnerTreeView do
if Selected <> nil then
begin
ATempPIDL := GetNodeAbsolutePIDL(Selected);
try
Result := GetPidlName(ATempPIDL);
finally
DisposePidl(ATempPIDL);
end;
end;
end;
function TcxCustomShellTreeView.GetRightClickSelect: Boolean;
begin
Result := FInnerTreeView.RightClickSelect;
end;
function TcxCustomShellTreeView.GetRoot: TcxShellTreeRoot;
begin
Result := TcxShellTreeRoot(FInnerTreeView.Root)
end;
function TcxCustomShellTreeView.GetShellListView: TcxCustomShellListView;
begin
if FInnerTreeView.ListView is TcxInnerShellListView then
Result := TcxInnerShellListViewAccess(FInnerTreeView.ListView).Container
else
Result := nil;
end;
function TcxCustomShellTreeView.GetShowButtons: Boolean;
begin
Result := FInnerTreeView.ShowButtons;
end;
function TcxCustomShellTreeView.GetShowInfoTips: Boolean;
begin
Result := FInnerTreeView.ShowInfoTips;
end;
function TcxCustomShellTreeView.GetShowLines: Boolean;
begin
Result := FInnerTreeView.ShowLines;
end;
function TcxCustomShellTreeView.GetShowRoot: Boolean;
begin
Result := FInnerTreeView.ShowRoot;
end;
function TcxCustomShellTreeView.GetStateImages: TCustomImageList;
begin
Result := FInnerTreeView.StateImages;
end;
function TcxCustomShellTreeView.GetTreeHotTrack: Boolean;
begin
Result := FInnerTreeView.HotTrack;
end;
procedure TcxCustomShellTreeView.SetAbsolutePIDL(Value: PItemIDList);
begin
if (FInnerTreeView <> nil) and FInnerTreeView.HandleAllocated then
begin
if not CheckAbsolutePIDL(Value, Root, True) then
Exit;
SendMessage(FInnerTreeView.Handle, DSM_DONAVIGATE, WPARAM(Value), 0);
FInnerTreeView.DoNavigateListView;
end;
end;
procedure TcxCustomShellTreeView.SetAutoExpand(Value: Boolean);
begin
FInnerTreeView.AutoExpand := Value;
end;
procedure TcxCustomShellTreeView.SetChangeDelay(Value: Integer);
begin
FInnerTreeView.ChangeDelay := Value;
end;
procedure TcxCustomShellTreeView.SetDragDropSettings(Value: TcxDragDropSettings);
begin
FInnerTreeView.DragDropSettings := Value;
end;
procedure TcxCustomShellTreeView.SetHideSelection(Value: Boolean);
begin
FInnerTreeView.HideSelection := Value;
end;
procedure TcxCustomShellTreeView.SetIndent(Value: Integer);
var
APrevIndent: Integer;
begin
APrevIndent := FInnerTreeView.Indent;
FInnerTreeView.Indent := Value;
if APrevIndent <> FInnerTreeView.Indent then
SetScrollBarsParameters;
end;
procedure TcxCustomShellTreeView.SetOptions(Value: TcxShellTreeViewOptions);
begin
FInnerTreeView.Options.Assign(Value);
end;
procedure TcxCustomShellTreeView.SetPath(const Value: string);
var
APIDL: PItemIDList;
begin
if (FInnerTreeView <> nil) and FInnerTreeView.HandleAllocated and (Path <> Value) then
begin
APIDL := PathToAbsolutePIDL(Value, Root, GetViewOptions(True));
if APIDL <> nil then
try
SendMessage(FInnerTreeView.Handle, DSM_DONAVIGATE, WPARAM(APIDL), 0);
FInnerTreeView.DoNavigateListView;
finally
DisposePidl(APIDL);
end;
end;
end;
procedure TcxCustomShellTreeView.SetRightClickSelect(Value: Boolean);
begin
FInnerTreeView.RightClickSelect := Value;
end;
procedure TcxCustomShellTreeView.SetRoot(Value: TcxShellTreeRoot);
begin
FInnerTreeView.Root := Value;
end;
procedure TcxCustomShellTreeView.SetShellListView(Value: TcxCustomShellListView);
begin
if Value = nil then
FInnerTreeView.ListView := nil
else
FInnerTreeView.ListView := Value.InnerListView;
end;
procedure TcxCustomShellTreeView.SetShowButtons(Value: Boolean);
begin
FInnerTreeView.ShowButtons := Value;
end;
procedure TcxCustomShellTreeView.SetShowInfoTips(Value: Boolean);
begin
FInnerTreeView.ShowInfoTips := Value;
end;
procedure TcxCustomShellTreeView.SetShowLines(Value: Boolean);
begin
FInnerTreeView.ShowLines := Value;
end;
procedure TcxCustomShellTreeView.SetShowRoot(Value: Boolean);
begin
FInnerTreeView.ShowRoot := Value;
end;
procedure TcxCustomShellTreeView.SetStateImages(Value: TCustomImageList);
begin
FInnerTreeView.StateImages := Value;
end;
procedure TcxCustomShellTreeView.SetTreeHotTrack(Value: Boolean);
begin
FInnerTreeView.HotTrack := Value;
end;
end.