Archivado/Componentes.Terceros.DevExpressVCL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
Componentes.Terceros.DevExp.../internal/x.42/2/ExpressEditors Library 5/Sources/cxShellControls.pas

2794 lines
84 KiB
ObjectPascal
Raw Permalink Blame History

{********************************************************************}
{ }
{ 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 cxShellControls;
{$I cxVer.inc}
interface
uses
Windows, ActiveX, Classes, ComCtrls, CommCtrl, ComObj, Controls, Dialogs,
Menus, Messages, ShellApi, ShlObj, SysUtils, cxShellCommon;
const
cxShellNormalItemOverlayIndex = -1;
cxShellSharedItemOverlayIndex = 0;
cxShellShortcutItemOverlayIndex = 1;
type
TcxCustomInnerShellListView = class;
TcxCustomInnerShellTreeView = class;
TcxListViewStyle=(lvsIcon, lvsSmallIcon, lvsList, lvsReport);
// Custom listview styles added because D4 and D5 does not allow detect
// the ViewStyle change. Also, we can add more styles to this component:
// Tile/Thumbnails/Custom...
TcxNavigationEvent = procedure (Sender:TcxCustomInnerShellListView;fqPidl:PItemIDList;
FolderPath:WideString) of object;
TcxShellAddFolderEvent = procedure(Sender: TObject; AFolder: TcxShellFolder;
var ACanAdd: Boolean) of object;
TcxShellChangeEvent = procedure(Sender: TObject; AEventID: DWORD;
APIDL1, APIDL2: PItemIDList) of object;
TcxShellCompareEvent = procedure(Sender: TObject;
AItem1, AItem2: TcxShellFolder; {$IFDEF BCB}var{$ELSE}out{$ENDIF} ACompare: Integer) of object;
TcxShellListViewProducer = class(TcxCustomItemProducer)
private
function GetListView: TcxCustomInnerShellListView;
protected
function AllowBackgroundProcessing: Boolean; override;
function CanAddFolder(AFolder: TcxShellFolder): Boolean; override;
function DoCompareItems(AItem1, AItem2: TcxShellFolder;
out ACompare: Integer): Boolean; override;
function GetEnumFlags: Cardinal; override;
function GetItemsInfoGatherer: TcxShellItemsInfoGatherer; override;
function GetShowToolTip: Boolean; override;
property ListView: TcxCustomInnerShellListView read GetListView;
public
procedure NotifyUpdateItem(AItem: PcxRequestItem); override;
procedure ProcessDetails(ShellFolder: IShellFolder; CharWidth: Integer); override;
end;
{ TcxShellListRoot }
TcxShellListRoot = class(TcxCustomShellRoot)
protected
procedure RootUpdated; override;
end;
TDropTargetType = (dttNone, dttOpenFolder, dttItem);
IcxDropTarget = interface(IDropTarget)
['{F688E250-96A6-4222-AF9D-049EB6E7D05B}']
end;
{ TcxShellListViewOptions }
TcxShellListViewOptions = class(TcxShellOptions)
private
FAutoExecute: Boolean;
FAutoNavigate: Boolean;
public
constructor Create(AOwner: TWinControl); override;
procedure Assign(Source: TPersistent); override;
published
property AutoExecute: Boolean read FAutoExecute write FAutoExecute default True;
property AutoNavigate: Boolean read FAutoNavigate write FAutoNavigate default True;
end;
IcxDataObject = interface(IDataObject)
['{9A9CDB78-150E-4469-A551-608EFF415145}']
end;
TcxShellChangeNotifierData = record
Handle: THandle;
PIDL: PItemIDList;
end;
{ TcxCustomInnerShellListView }
TcxCustomInnerShellListView = class(TCustomListView, IUnknown, IcxDropTarget)
private
FAfterNavigation: TcxNavigationEvent;
FBeforeNavigation: TcxNavigationEvent;
FComboBoxControl: TWinControl;
FCurrentDropTarget: IcxDropTarget;
FDragDropSettings: TcxDragDropSettings;
FDraggedObject: IcxDataObject;
FDropTargetItemIndex: Integer;
FFirstUpdateItem: Integer;
FInternalLargeImages: THandle;
FInternalSmallImages: THandle;
FItemProducer: TcxShellListViewProducer;
FItemsInfoGatherer: TcxShellItemsInfoGatherer;
FLastUpdateItem: Integer;
FListViewStyle: TcxListViewStyle;
FNotificationLock: Boolean;
FOptions: TcxShellListViewOptions;
FRoot: TcxShellListRoot;
FRootChanged: TcxRootChangedEvent;
FShellChangeNotifierData: TcxShellChangeNotifierData;
FTreeViewControl: TWinControl;
FOnAddFolder: TcxShellAddFolderEvent;
FOnCompare: TcxShellCompareEvent;
FOnShellChange: TcxShellChangeEvent;
function GetFolder(AIndex: Integer): TcxShellFolder;
function GetFolderCount: Integer;
procedure RootSettingsChanged(Sender: TObject);
procedure SetListViewStyle(const Value: TcxListViewStyle);
procedure SetDropTargetItemIndex(Value: Integer);
procedure DSMSynchronizeRoot(var Message: TMessage); message DSM_SYNCHRONIZEROOT;
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
function OwnerDataFetch(Item: TListItem; Request: TItemRequest): Boolean; override;
procedure DblClick; override;
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
function CanEdit(Item: TListItem): Boolean; override;
procedure Loaded;override;
procedure Edit(const Item: TLVItem); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DisplayContextMenu(const APos: TPoint);
procedure DoProcessDefaultCommand(Item:TcxShellItemInfo); virtual;
procedure DoProcessNavigation(Item:TcxShellItemInfo);
procedure DoBeforeNavigation(fqPidl:PItemIDList);
function DoAddFolder(AFolder: TcxShellFolder): Boolean;
procedure DoAfterNavigation;
function DoCompare(AItem1, AItem2: TcxShellFolder;
out ACompare: Integer): Boolean; virtual;
procedure CreateColumns;
procedure CreateDropTarget;
procedure CreateChangeNotification;
procedure RemoveColumns;
procedure RemoveDropTarget;
procedure RemoveChangeNotification;
procedure CheckUpdateItems;
procedure DoBeginDrag;
procedure DoNavigateTreeView;
procedure GetDropTarget(pt:TPoint;out New:Boolean);
procedure Navigate(APIDL: PItemIDList); virtual;
function TryReleaseDropTarget:HResult;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure DsmSetCount(var Message:TMessage); message DSM_SETCOUNT;
procedure DsmNotifyUpdateItem(var Message:TMessage); message DSM_NOTIFYUPDATE;
procedure DsmNotifyUpdateContents(var Message:TMessage); message DSM_NOTIFYUPDATECONTENTS;
procedure DsmShellChangeNotify(var Message:TMessage); message DSM_SHELLCHANGENOTIFY;
property ComboBoxControl: TWinControl read FComboBoxControl write FComboBoxControl;
property FirstUpdateItem:Integer read FFirstUpdateItem write FFirstUpdateItem;
property LastUpdateItem:Integer read FLastUpdateItem write FLastUpdateItem;
property ItemProducer:TcxShellListViewProducer read FItemProducer;
property CurrentDropTarget:IcxDropTarget read FCurrentDropTarget write FCurrentDropTarget;
property DropTargetItemIndex: Integer read FDropTargetItemIndex write SetDropTargetItemIndex;
property DraggedObject:IcxDataObject read FDraggedObject write FDraggedObject;
property TreeViewControl:TWinControl read FTreeViewControl write FTreeViewControl;
// IcxDropTarget methods
function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function IcxDropTarget.DragOver=IDropTargetDragOver;
function IDropTargetDragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult; stdcall;
function DragLeave: HResult; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult; stdcall;
property ItemsInfoGatherer: TcxShellItemsInfoGatherer read FItemsInfoGatherer;
property OnAddFolder: TcxShellAddFolderEvent read FOnAddFolder
write FOnAddFolder;
property OnCompare: TcxShellCompareEvent read FOnCompare write FOnCompare;
property OnShellChange: TcxShellChangeEvent read FOnShellChange write FOnShellChange;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure BrowseParent;
procedure SetTreeView(ATreeView:TWinControl);
procedure ProcessTreeViewNavigate(APIDL: PItemIDList);
procedure Sort;
procedure UpdateContent;
property DragDropSettings: TcxDragDropSettings read FDragDropSettings write FDragDropSettings;
property FolderCount: Integer read GetFolderCount;
property Folders[AIndex: Integer]: TcxShellFolder read GetFolder;
property ListViewStyle: TcxListViewStyle read FListViewStyle write SetListViewStyle;
property Options: TcxShellListViewOptions read FOptions write FOptions;
property Root: TcxShellListRoot read FRoot write FRoot;
property AfterNavigation: TcxNavigationEvent read FAfterNavigation write FAfterNavigation;
property BeforeNavigation: TcxNavigationEvent read FBeforeNavigation write FBeforeNavigation;
property OnRootChanged: TcxRootChangedEvent read FRootChanged write FRootChanged;
end;
TcxShellTreeRoot = class(TcxCustomShellRoot)
protected
procedure RootUpdated; override;
end;
TcxShellTreeItemProducer = class(TcxCustomItemProducer)
private
FNode: TTreeNode;
FOnDestroy: TNotifyEvent;
function GetTreeView: TcxCustomInnerShellTreeView;
protected
function AllowBackgroundProcessing: Boolean; override;
function CanAddFolder(AFolder: TcxShellFolder): Boolean; override;
function GetEnumFlags:Cardinal; override;
function GetItemsInfoGatherer: TcxShellItemsInfoGatherer; override;
function GetShowToolTip: Boolean; override;
property Node: TTreeNode read FNode write FNode;
procedure InitializeItem(Item: TcxShellItemInfo); override;
procedure CheckForSubitems(AItem: TcxShellItemInfo); override;
property TreeView: TcxCustomInnerShellTreeView read GetTreeView;
public
constructor Create(AOwner: TWinControl); override;
destructor Destroy; override;
procedure SetItemsCount(Count: Integer); override;
procedure NotifyUpdateItem(AItem: PcxRequestItem); override;
procedure NotifyRemoveItem(Index: Integer); override;
procedure NotifyAddItem(Index: Integer); override;
procedure ProcessItems(AIFolder: IShellFolder; APIDL: PItemIDList;
ANode: TTreeNode; cPreloadItems: Integer); reintroduce; overload;
function CheckUpdates: Boolean;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
end;
PcxShellTreeItemProducer = ^TcxShellTreeItemProducer;
{ TcxShellTreeViewOptions }
TcxShellTreeViewOptions = class(TcxShellOptions)
end;
TcxShellTreeViewStateData = record
CurrentPath: PItemIDList;
ExpandedNodeList: TList;
TopItemIndex: Integer;
end;
TcxCustomInnerShellTreeView = class(TTreeView, IUnknown, IcxDropTarget)
private
FComboBoxControl: TWinControl;
FContextPopupItemProducer: TcxShellTreeItemProducer;
FCurrentDropTarget: IcxDropTarget;
FDragDropSettings: TcxDragDropSettings;
FDraggedObject: IcxDataObject;
FInternalSmallImages:THandle;
FIsChangeNotificationCreationLocked: Boolean;
FIsUpdating: Boolean;
FItemProducersList: TThreadList;
FItemsInfoGatherer: TcxShellItemsInfoGatherer;
FListView: TcxCustomInnerShellListView;
FNavigation: Boolean;
FOptions: TcxShellTreeViewOptions;
FPrevTargetNode: TTreeNode;
FRoot: TcxShellTreeRoot;
FRootChanged: TcxRootChangedEvent;
FShellChangeNotificationCreation: Boolean;
FShellChangeNotifierData: TcxShellChangeNotifierData;
FShowInfoTips: Boolean;
FStateData: TcxShellTreeViewStateData;
FOnAddFolder: TcxShellAddFolderEvent;
FOnShellChange: TcxShellChangeEvent;
procedure SetPrevTargetNode(const Value: TTreeNode);
procedure ContextPopupItemProducerDestroyHandler(Sender: TObject);
function GetFolder(AIndex: Integer): TcxShellFolder;
function GetFolderCount: Integer;
function GetNodeFromItem(const Item: TTVItem): TTreeNode;
procedure RestoreTreeState;
procedure SaveTreeState;
procedure SetListView(Value: TcxCustomInnerShellListView);
procedure RootSettingsChanged(Sender: TObject);
procedure SetShowInfoTips(Value: Boolean);
procedure ShowToolTipChanged(Sender: TObject);
procedure DSMShellTreeChangeNotify(var Message: TMessage); message DSM_SHELLTREECHANGENOTIFY;
procedure DSMShellTreeRestoreCurrentPath(var Message: TMessage);
message DSM_SHELLTREERESTORECURRENTPATH;
procedure DSMSynchronizeRoot(var Message: TMessage); message DSM_SYNCHRONIZEROOT;
property CurrentDropTarget:IcxDropTarget read FCurrentDropTarget write FCurrentDropTarget;
property DraggedObject:IcxDataObject read FDraggedObject write FDraggedObject;
property ItemProducersList:TThreadList read FItemProducersList;
property Navigation:Boolean read FNavigation write FNavigation;
property PrevTargetNode:TTreeNode read FPrevTargetNode write SetPrevTargetNode;
protected
procedure AdjustControlParams;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure Change(Node: TTreeNode); override;
function CanEdit(Node: TTreeNode): Boolean; override;
procedure Edit(const Item: TTVItem); override;
function CanExpand(Node: TTreeNode): Boolean; override;
procedure Delete(Node: TTreeNode); override;
procedure CreateParams(var Params: TCreateParams); override;
function IsLoading: Boolean; virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
procedure CreateDropTarget;
procedure RemoveDropTarget;
procedure AddItemProducer(Producer:TcxShellTreeItemProducer);
procedure RemoveItemProducer(Producer:TcxShellTreeItemProducer);
procedure CreateChangeNotification(ANode: TTreeNode = nil);
function DoAddFolder(AFolder: TcxShellFolder): Boolean;
procedure DoBeginDrag;
procedure DoNavigateListView;
procedure DragDropSettingsChanged(Sender: TObject); virtual;
function GetNodeByPIDL(APIDL: PItemIDList): TTreeNode;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure RemoveChangeNotification;
function TryReleaseDropTarget:HResult;
procedure GetDropTarget(out New:Boolean;pt:TPoint);
procedure DsmSetCount(var Message:TMessage); message DSM_SETCOUNT;
procedure DsmNotifyUpdateItem(var Message:TMessage); message DSM_NOTIFYUPDATE;
procedure DsmNotifyRemoveItem(var Message:TMessage); message DSM_NOTIFYREMOVEITEM;
procedure DsmNotifyAddItem(var Message:TMessage); message DSM_NOTIFYADDITEM;
procedure DsmNotifyUpdateContents(var Message:TMessage); message DSM_NOTIFYUPDATECONTENTS;
procedure DsmShellChangeNotify(var Message:TMessage); message DSM_SHELLCHANGENOTIFY;
procedure DsmDoNavigate(var Message:TMessage); message DSM_DONAVIGATE;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
// IcxDropTarget methods
function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function IcxDropTarget.DragOver=IDropTargetDragOver;
function IDropTargetDragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult; stdcall;
function DragLeave: HResult; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult; stdcall;
property ComboBoxControl: TWinControl read FComboBoxControl write FComboBoxControl;
property ItemsInfoGatherer: TcxShellItemsInfoGatherer read FItemsInfoGatherer;
property OnAddFolder: TcxShellAddFolderEvent read FOnAddFolder
write FOnAddFolder;
property OnShellChange: TcxShellChangeEvent read FOnShellChange write FOnShellChange;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure UpdateContent;
procedure UpdateNode(ANode: TTreeNode; AFast: Boolean);
property DragDropSettings:TcxDragDropSettings read FDragDropSettings write FDragDropSettings;
property FolderCount: Integer read GetFolderCount;
property Folders[AIndex: Integer]: TcxShellFolder read GetFolder;
property ListView:TcxCustomInnerShellListView read FListView write SetListView;
property Options: TcxShellTreeViewOptions read FOptions write FOptions;
property Root:TcxShellTreeRoot read FRoot write FRoot;
property ShowInfoTips: Boolean read FShowInfoTips write SetShowInfoTips default False;
property OnRootChanged:TcxRootChangedEvent read FRootChanged write FRootChanged;
end;
implementation
uses
Forms, ImgList, Math;
type
TcxShellOptionsAccess = class(TcxShellOptions);
PPItemIDList = ^PItemIDList;
procedure DoShellChange(Sender: TObject; AEvent: TcxShellChangeEvent;
const Message: TMessage); forward;
function GetShellItemOverlayIndex(
AItemData: TcxShellItemInfo): Integer; forward;
procedure RegisterShellChangeNotifier(ANotifierPIDL: PItemIDList; AWnd: HWND;
ANotificationMsg: Cardinal; AWatchSubtree: Boolean;
var ANotifierData: TcxShellChangeNotifierData); forward;
procedure UnregisterShellChangeNotifier(
var ANotifierData: TcxShellChangeNotifierData); forward;
procedure DoShellChange(Sender: TObject; AEvent: TcxShellChangeEvent;
const Message: TMessage);
begin
if Assigned(AEvent) then
AEvent(Sender, Message.LParam, PPItemIDList(Message.WParam)^,
PPItemIDList(Message.WParam + SizeOf(Pointer))^);
end;
function GetShellItemOverlayIndex(AItemData: TcxShellItemInfo): Integer;
const
SHGFI_OVERLAYINDEX = $40;
var
AFileInfo: TShFileInfo;
AFlags: Cardinal;
begin
if GetComCtlVersion >= ComCtlVersionIE5 then
begin
AFlags := SHGFI_PIDL or SHGFI_ICON or SHGFI_OVERLAYINDEX;
ZeroMemory(@AFileInfo, SizeOf(AFileInfo));
SHGetFileInfo(PChar(AItemData.FullPIDL), 0, AFileInfo, SizeOf(AFileInfo), AFlags);
DestroyIcon(AFileInfo.hIcon);
Result := AFileInfo.iIcon;
Result := (Result shr ((SizeOf(Result) - 1) * 8)) and $FF - 1;
end
else
begin
if AItemData.IsLink then
Result := cxShellShortcutItemOverlayIndex
else
if AItemData.IsShare then
Result := cxShellSharedItemOverlayIndex
else
Result := cxShellNormalItemOverlayIndex;
end;
end;
procedure RegisterShellChangeNotifier(ANotifierPIDL: PItemIDList; AWnd: HWND;
ANotificationMsg: Cardinal; AWatchSubtree: Boolean;
var ANotifierData: TcxShellChangeNotifierData);
var
AItems: PSHChangeNotifyEntry;
begin
if EqualPIDLs(ANotifierData.PIDL, ANotifierPIDL) then
Exit;
UnregisterShellChangeNotifier(ANotifierData);
ANotifierData.PIDL := GetPidlCopy(ANotifierPIDL);
New(AItems);
try
AItems.pidlPath := ANotifierPIDL;
AItems.bWatchSubtree := AWatchSubtree;
ANotifierData.Handle := SHChangeNotifyRegister(AWnd,
SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
SHCNE_RENAMEITEM or SHCNE_CREATE or SHCNE_DELETE or SHCNE_MKDIR or
SHCNE_RMDIR or SHCNE_ATTRIBUTES or SHCNE_UPDATEDIR or SHCNE_UPDATEITEM or
SHCNE_UPDATEIMAGE or SHCNE_RENAMEFOLDER, ANotificationMsg, 1, AItems);
finally
Dispose(AItems);
end;
end;
procedure UnregisterShellChangeNotifier(
var ANotifierData: TcxShellChangeNotifierData);
begin
if ANotifierData.Handle <> 0 then
begin
SHChangeNotifyUnregister(ANotifierData.Handle);
ANotifierData.Handle := 0;
DisposePidl(ANotifierData.PIDL);
ANotifierData.PIDL := nil;
end;
end;
{ TcxShellListViewOptions }
constructor TcxShellListViewOptions.Create(AOwner: TWinControl);
begin
inherited Create(AOwner);
FAutoNavigate := True;
FAutoExecute := True;
end;
procedure TcxShellListViewOptions.Assign(Source: TPersistent);
begin
if Source is TcxShellListViewOptions then
begin
AutoExecute := TcxShellListViewOptions(Source).AutoExecute;
AutoNavigate := TcxShellListViewOptions(Source).AutoNavigate;
end;
inherited Assign(Source);
end;
{ TcxCustomInnerShellListView }
constructor TcxCustomInnerShellListView.Create(AOwner: TComponent);
var
AFileInfo: TShFileInfo;
begin
inherited Create(AOwner);
FDragDropSettings := TcxDragDropSettings.Create;
FDropTargetItemIndex := -1;
FFirstUpdateItem := -1;
FInternalLargeImages := SHGetFileInfo('C:\', 0, AFileInfo, SizeOf(AFileInfo),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
FInternalSmallImages := SHGetFileInfo('C:\', 0, AFileInfo, SizeOf(AFileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
FItemProducer := TcxShellListViewProducer.Create(Self);
FItemsInfoGatherer := TcxShellItemsInfoGatherer.Create(Self);
FLastUpdateItem := -1;
FOptions := TcxShellListViewOptions.Create(Self);
FRoot := TcxShellListRoot.Create(Self, 0);
FRoot.OnSettingsChanged := RootSettingsChanged;
DoubleBuffered := True;
DragMode := dmManual;
HideSelection := False;
OwnerData := True;
end;
destructor TcxCustomInnerShellListView.Destroy;
begin
RemoveChangeNotification;
FreeAndNil(FDragDropSettings);
FreeAndNil(FItemProducer);
FreeAndNil(FItemsInfoGatherer);
FreeAndNil(FOptions);
FreeAndNil(FRoot);
inherited Destroy;
end;
procedure TcxCustomInnerShellListView.BrowseParent;
var
APIDL: PItemIDList;
begin
APIDL := GetPidlParent(ItemProducer.FolderPidl);
try
Navigate(APIDL);
finally
DisposePidl(APIDL);
end;
end;
function TcxCustomInnerShellListView.CanEdit(Item: TListItem): Boolean;
begin
Result := True;
if Item = nil then
Exit;
if Item.Index > ItemProducer.Items.Count - 1 then
begin
Result := False;
Exit;
end;
Result := TcxShellItemInfo(ItemProducer.Items[Item.Index]).CanRename;
end;
procedure TcxCustomInnerShellListView.CheckUpdateItems;
begin
ItemProducer.ClearItems;
if IsWindow(WindowHandle) then
begin
if not Root.IsValid then
Items.Clear
else
if ItemProducer.Items.Count = 0 then
ItemProducer.ProcessItems(Root.ShellFolder, Root.Pidl,
PRELOAD_ITEMS_COUNT);
CreateChangeNotification;
Refresh;
end;
end;
procedure TcxCustomInnerShellListView.CNNotify(var Message: TWMNotify);
function GetOverlayIndex: Integer;
var
AItemData: TcxShellItemInfo;
begin
AItemData := ItemProducer.Items[PLVDispInfo(Message.NMHdr)^.item.iItem];
AItemData.CheckUpdate(ItemProducer.ShellFolder, ItemProducer.FolderPidl, False);
Result := GetShellItemOverlayIndex(AItemData);
end;
begin
if csDestroying in ComponentState then
Exit;
case Message.NMHdr^.code of
LVN_BEGINDRAG, LVN_BEGINRDRAG:
begin
if not DragDropSettings.AllowDragObjects then
begin
inherited;
Exit;
end;
if SelCount <= 0 then
Exit;
DoBeginDrag;
end;
LVN_GETINFOTIP:
ItemProducer.DoGetInfoTip(Handle, PNMLVGetInfoTip(Message.NMHdr)^.iItem,
PNMLVGetInfoTip(Message.NMHdr)^.pszText,
PNMLVGetInfoTip(Message.NMHdr)^.cchTextMax);
LVN_GETDISPINFO:
begin
inherited;
with PLVDispInfo(Message.NMHdr)^.item do
if (mask and LVIF_IMAGE <> 0) and (iSubItem = 0) then
if (iItem >= 0) and (iItem < ItemProducer.Items.Count) then
begin
state := IndexToOverlayMask(GetOverlayIndex + 1);
stateMask := ILD_OVERLAYMASK;
mask := mask or LVIF_STATE;
end;
end;
else
inherited;
end;
end;
procedure TcxCustomInnerShellListView.CreateChangeNotification;
begin
if not Options.TrackShellChanges then
RemoveChangeNotification
else
RegisterShellChangeNotifier(ItemProducer.FolderPidl, Handle,
DSM_SHELLCHANGENOTIFY, False, FShellChangeNotifierData);
end;
procedure TcxCustomInnerShellListView.CreateColumns;
var
i: Integer;
Column: TListColumn;
begin
if ListViewStyle <> lvsReport then
Exit;
Columns.BeginUpdate;
try
Columns.Clear;
for i := 0 to ItemProducer.Details.Count - 1 do
begin
Column := Columns.Add;
Column.Caption := ItemProducer.Details[i].Text;
Column.Alignment := ItemProducer.Details[i].Alignment;
Column.Width := ItemProducer.Details[i].Width;
end;
finally
Columns.EndUpdate;
end;
end;
procedure TcxCustomInnerShellListView.CreateDropTarget;
var
AIDropTarget: IcxDropTarget;
begin
GetInterface(IcxDropTarget, AIDropTarget);
RegisterDragDrop(Handle,IDropTarget(AIDropTarget));
end;
procedure TcxCustomInnerShellListView.CreateWnd;
begin
inherited CreateWnd;
if HandleAllocated then
begin
if FInternalSmallImages <> 0 then
SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_SMALL, LParam(FInternalSmallImages));
if FInternalLargeImages <> 0 then
SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, LParam(FInternalLargeImages));
CreateDropTarget;
if Root.Pidl = nil then
Root.CheckRoot
else
CheckUpdateItems;
end;
end;
procedure TcxCustomInnerShellListView.DblClick;
var
AItem: TcxShellItemInfo;
begin
if not Options.AutoNavigate or (Selected = nil) then
Exit;
ItemProducer.LockRead;
try
AItem := ItemProducer.Items[Selected.Index];
if AItem.IsFolder then
DoProcessNavigation(AItem)
else
if Options.AutoExecute then
DoProcessDefaultCommand(AItem);
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellListView.DestroyWnd;
begin
RemoveChangeNotification;
RemoveColumns;
RemoveDropTarget;
inherited DestroyWnd;
end;
function TcxCustomInnerShellListView.DoAddFolder(AFolder: TcxShellFolder): Boolean;
begin
Result := True;
if Assigned(FOnAddFolder) then
FOnAddFolder(Self, AFolder, Result);
end;
procedure TcxCustomInnerShellListView.DoAfterNavigation;
begin
if Assigned(AfterNavigation) then
AfterNavigation(Self, Root.Pidl, Root.CurrentPath);
end;
function TcxCustomInnerShellListView.DoCompare(AItem1, AItem2: TcxShellFolder;
out ACompare: Integer): Boolean;
begin
Result := Assigned(FOnCompare);
if Result then
FOnCompare(Self, AItem1, AItem2, ACompare);
end;
procedure TcxCustomInnerShellListView.DoBeforeNavigation(fqPidl: PItemIDList);
var
Desktop: IShellFolder;
tempPath: WideString;
StrName: TStrRet;
begin
if Failed(SHGetDesktopFolder(Desktop)) then
Exit;
if Succeeded(Desktop.GetDisplayNameOf(fqPidl, SHGDN_NORMAL or SHGDN_FORPARSING, StrName)) then
tempPath := GetTextFromStrRet(StrName, fqPidl)
else
tempPath := '';
if Assigned(BeforeNavigation) then
BeforeNavigation(Self, fqPidl, tempPath);
end;
procedure TcxCustomInnerShellListView.DoBeginDrag;
var
i: Integer;
tempList: TList;
pidlList: PItemIDList;
pDataObject: IDataObject;
pDropSource: IcxDropSource;
dwEffect: Integer;
Item: TListItem;
begin
tempList := TList.Create;
try
Item := Selected;
while Item <> nil do
begin
tempList.Add(GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[Item.Index]).pidl));
Item := GetNextItem(Item,sdAll,[isSelected]);
end;
pidlList := CreatePidlListFromList(tempList);
try
if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, SelCount, PItemIDList(pidlList^), IDataObject, nil, Pointer(pDataObject))) then
Exit;
pDropSource := TcxDropSource.Create(Self);
dwEffect := DragDropSettings.DropEffectAPI;
DoDragDrop(pDataObject, pDropSource, dwEffect, dwEffect);
finally
DisposePidl(pidlList);
end;
finally
try
for i := 0 to tempList.Count - 1 do
DisposePidl(tempList[i]);
finally
FreeAndNil(tempList);
end;
end;
end;
procedure TcxCustomInnerShellListView.DoContextPopup(MousePos: TPoint;
var Handled: Boolean);
begin
if Options.ContextMenus and (SelCount > 0) then
begin
Handled := True;
ItemProducer.LockRead;
try
DisplayContextMenu(ClientToScreen(MousePos));
finally
ItemProducer.UnlockRead;
end;
end
else
inherited DoContextPopup(MousePos, Handled);
end;
procedure TcxCustomInnerShellListView.DoProcessDefaultCommand(
Item: TcxShellItemInfo);
var
fqPidl: PItemIDList;
lpExecInfo: PShellExecuteInfo;
begin
fqPidl := ConcatenatePidls(ItemProducer.FolderPidl,Item.pidl);
try
New(lpExecInfo);
try
ZeroMemory(lpExecInfo, SizeOf(TShellExecuteInfo));
lpExecInfo.cbSize := SizeOf(TShellExecuteInfo);
lpExecInfo.fMask := SEE_MASK_INVOKEIDLIST;
lpExecInfo.Wnd := Handle;
lpExecInfo.lpIDList := fqPidl;
lpExecInfo.nShow := SW_SHOW;
ShellExecuteEx(lpExecInfo);
finally
Dispose(lpExecInfo);
end;
finally
DisposePidl(fqPidl);
end;
end;
procedure TcxCustomInnerShellListView.DoProcessNavigation(
Item: TcxShellItemInfo);
var
APIDL: PItemIDList;
begin
if not Item.IsFolder then
Exit;
APIDL := ConcatenatePidls(ItemProducer.FolderPidl, Item.pidl);
try
Navigate(APIDL);
finally
DisposePidl(APIDL);
end;
end;
function TcxCustomInnerShellListView.DragEnter(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
new: Boolean;
begin
DraggedObject := IcxDataObject(dataObj);
GetDropTarget(pt, new);
dwEffect := DragDropSettings.DefaultDropEffectAPI;
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
end;
function TcxCustomInnerShellListView.DragLeave: HResult;
begin
DraggedObject := nil;
Result := TryReleaseDropTarget;
end;
function TcxCustomInnerShellListView.IDropTargetDragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(pt, new);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(DraggedObject, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.DragOver(grfKeyState, pt, dwEffect);
end;
end;
function TcxCustomInnerShellListView.Drop(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(pt, new);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.Drop(dataObj, grfKeyState, pt, dwEffect);
end;
DraggedObject := nil;
TryReleaseDropTarget;
end;
procedure TcxCustomInnerShellListView.DsmNotifyUpdateContents(
var Message: TMessage);
begin
if not (csLoading in ComponentState) then
CheckUpdateItems;
end;
procedure TcxCustomInnerShellListView.DsmNotifyUpdateItem(
var Message: TMessage);
begin
UpdateItems(Message.WParam, Message.WParam);
end;
procedure TcxCustomInnerShellListView.DsmSetCount(var Message: TMessage);
begin
Items.Count := Message.WParam;
ItemFocused := nil;
Selected := nil;
end;
procedure TcxCustomInnerShellListView.DsmShellChangeNotify(
var Message: TMessage);
begin
if FNotificationLock then
Exit;
FNotificationLock := True;
try
CheckUpdateItems;
finally
FNotificationLock := False;
end;
DoShellChange(Self, OnShellChange, Message);
end;
procedure TcxCustomInnerShellListView.Edit(const Item: TLVItem);
var
tempItem: TcxShellItemInfo;
NewName: WideString;
pidlOut: PItemIDList;
begin
inherited;
if (ItemProducer.Items.Count - 1) < Item.iItem then
Exit;
tempItem := ItemProducer.Items[Item.iItem];
NewName := StrPas(Item.pszText);
ItemProducer.ShellFolder.SetNameOf(Handle, tempItem.pidl, PWideChar(NewName),
SHGDN_INFOLDER or SHGDN_FORPARSING, pidlOut);
try
tempItem.SetNewPidl(ItemProducer.ShellFolder, ItemProducer.FolderPidl, pidlOut);
finally
DisposePidl(pidlOut);
end;
end;
procedure TcxCustomInnerShellListView.KeyDown(var Key: Word;
Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if not IsEditing then
case Key of
VK_RETURN:
DblClick;
VK_BACK:
if Options.AutoNavigate then
BrowseParent;
VK_F5:
UpdateContent;
end;
end;
procedure TcxCustomInnerShellListView.DisplayContextMenu(const APos: TPoint);
function GetItemPIDLList: TList;
var
AItem: TListItem;
AItemPIDL: PItemIDList;
begin
Result := TList.Create;
AItem := Selected;
while AItem <> nil do
begin
AItemPIDL := TcxShellItemInfo(ItemProducer.Items[AItem.Index]).pidl;
if AItemPIDL <> nil then
Result.Add(GetPidlCopy(AItemPIDL));
AItem := GetNextItem(AItem, sdAll, [isSelected]);
end;
end;
var
AItemPIDLList: TList;
I: Integer;
begin
if SelCount = 0 then
Exit;
AItemPIDLList := GetItemPIDLList;
try
cxShellCommon.DisplayContextMenu(Handle, ItemProducer.ShellFolder,
AItemPIDLList, APos);
finally
for I := 0 to AItemPIDLList.Count - 1 do
DisposePidl(AItemPIDLList[I]);
AItemPIDLList.Free;
end;
end;
procedure TcxCustomInnerShellListView.Loaded;
begin
inherited Loaded;
if csDesigning in ComponentState then
Root.RootUpdated;
end;
procedure TcxCustomInnerShellListView.GetDropTarget(pt: TPoint;
out New: Boolean);
function GetDropTargetItemIndex: Integer;
var
AItem: TListItem;
P: TPoint;
begin
Result := -1;
P := ScreenToClient(pt);
AItem := GetItemAt(P.X, P.Y);
if AItem <> nil then
Result := AItem.Index;
end;
var
AItemIndex: Integer;
tempDropTarget: IcxDropTarget;
tempPidl: PItemIDList;
begin
AItemIndex := GetDropTargetItemIndex;
if AItemIndex = -1 then
begin // There are no items selected, so drop target is current opened folder
if (DropTargetItemIndex = -1) and (CurrentDropTarget <> nil) then
begin
New := False;
Exit;
end;
TryReleaseDropTarget;
New := True;
if Failed(ItemProducer.ShellFolder.CreateViewObject(Handle,IDropTarget, tempDropTarget)) then
Exit;
CurrentDropTarget := tempDropTarget;
end
else
begin // Use one of Items as Drop Target
if AItemIndex = DropTargetItemIndex then
begin
New := False;
Exit;
end;
TryReleaseDropTarget;
New := True;
tempPidl := GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[AItemIndex]).pidl);
try
if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDropTarget, nil, tempDropTarget)) then
Exit;
finally
DisposePidl(tempPidl);
end;
CurrentDropTarget := tempDropTarget;
DropTargetItemIndex := AItemIndex;
end;
end;
procedure TcxCustomInnerShellListView.Navigate(APIDL: PItemIDList);
begin
if EqualPIDLs(APIDL, ItemProducer.FolderPidl) then
Exit;
Items.BeginUpdate;
try
DoBeforeNavigation(APIDL);
Root.Pidl := APIDL;
DoNavigateTreeView;
DoAfterNavigation;
finally
Items.EndUpdate;
end;
end;
function TcxCustomInnerShellListView.OwnerDataFetch(Item: TListItem;
Request: TItemRequest): Boolean;
var
ShellItem: TcxShellItemInfo;
i: Integer;
begin
Result := True;
ItemProducer.LockRead;
try
if Item.Index >= ItemProducer.Items.Count then
Exit;
ShellItem := ItemProducer.Items[Item.Index];
ShellItem.CheckUpdate(ItemProducer.ShellFolder, ItemProducer.FolderPidl, False);
Item.Caption := ShellItem.Name;
Item.ImageIndex := ShellItem.IconIndex;
if ListViewStyle = lvsReport then
begin
if ShellItem.Details.Count = 0 then
ShellItem.FetchDetails(Handle, ItemProducer.ShellFolder, ItemProducer.Details);
for i := 0 to ShellItem.Details.Count - 1 do
Item.SubItems.Add(ShellItem.Details[i]);
end;
Item.Cut := ShellItem.IsGhosted;
if not ShellItem.Updated then
ItemProducer.FetchRequest(Item.Index, True);
finally
ItemProducer.UnlockRead;
end;
Result := inherited OwnerDataFetch(Item, Request);
end;
procedure TcxCustomInnerShellListView.RemoveChangeNotification;
begin
UnregisterShellChangeNotifier(FShellChangeNotifierData);
end;
procedure TcxCustomInnerShellListView.RemoveColumns;
begin
Columns.Clear;
end;
procedure TcxCustomInnerShellListView.RemoveDropTarget;
begin
RevokeDragDrop(Handle);
end;
procedure TcxCustomInnerShellListView.SetDropTargetItemIndex(Value: Integer);
begin
if FDropTargetItemIndex <> -1 then
Items[FDropTargetItemIndex].DropTarget := False;
FDropTargetItemIndex := Value;
if FDropTargetItemIndex <> -1 then
Items[FDropTargetItemIndex].DropTarget := True;
end;
procedure TcxCustomInnerShellListView.DSMSynchronizeRoot(var Message: TMessage);
begin
if not((Parent <> nil) and (csLoading in Parent.ComponentState)) then
Root.Update(TcxCustomShellRoot(Message.WParam));
end;
function TcxCustomInnerShellListView.GetFolder(AIndex: Integer): TcxShellFolder;
begin
Result := TcxShellItemInfo(ItemProducer.Items[AIndex]).Folder;
end;
function TcxCustomInnerShellListView.GetFolderCount: Integer;
begin
Result := Items.Count;
end;
procedure TcxCustomInnerShellListView.RootSettingsChanged(Sender: TObject);
begin
if (Parent <> nil) and (csLoading in Parent.ComponentState) then
Exit;
if (FTreeViewControl <> nil) and FTreeViewControl.HandleAllocated then
SendMessage(FTreeViewControl.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
if (FComboBoxControl <> nil) and FComboBoxControl.HandleAllocated then
SendMessage(FComboBoxControl.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
end;
procedure TcxCustomInnerShellListView.SetListViewStyle(
const Value: TcxListViewStyle);
begin
if FListViewStyle <> Value then
begin
FListViewStyle := Value;
case FListViewStyle of
lvsIcon: ViewStyle:=vsIcon;
lvsSmallIcon: ViewStyle:=vsSmallIcon;
lvsList: ViewStyle:=vsList;
lvsReport: ViewStyle:=vsReport;
end;
CheckUpdateItems;
end;
end;
function TcxCustomInnerShellListView.TryReleaseDropTarget:HResult;
begin
Result := S_OK;
if CurrentDropTarget <> nil then
Result := CurrentDropTarget.DragLeave;
CurrentDropTarget := nil;
DropTargetItemIndex := -1;
end;
procedure TcxCustomInnerShellListView.SetTreeView(ATreeView: TWinControl);
begin
TreeViewControl := ATreeView;
end;
var
NavigationLock: Boolean;
procedure TcxCustomInnerShellListView.DoNavigateTreeView;
var
tempPidl: PItemIDList;
begin
if NavigationLock or (not Assigned(TreeViewControl) and not Assigned(ComboBoxControl)) then
Exit;
tempPidl:=GetPidlCopy(Root.Pidl);
try
if Assigned(TreeViewControl) and (TreeViewControl.Parent <> nil) then
begin
TreeViewControl.HandleNeeded;
SendMessage(TreeViewControl.Handle,DSM_DONAVIGATE,WPARAM(tempPidl),0);
end;
if Assigned(ComboBoxControl) and (ComboBoxControl.Parent <> nil) then
begin
ComboBoxControl.HandleNeeded;
SendMessage(ComboBoxControl.Handle,DSM_DONAVIGATE,WPARAM(tempPidl),0);
end;
finally
DisposePidl(tempPidl);
end;
end;
procedure TcxCustomInnerShellListView.ProcessTreeViewNavigate(
APIDL: PItemIDList);
function IsFolder(APIDL: PItemIDList): Boolean;
const
SHGFI_ATTR_SPECIFIED = $20000;
var
ASHFileInfo: TSHFileInfo;
begin
ASHFileInfo.dwAttributes := SFGAO_FOLDER;
SHGetFileInfo(Pointer(APIDL), 0, ASHFileInfo, SizeOf(ASHFileInfo),
SHGFI_PIDL or SHGFI_ATTR_SPECIFIED or SHGFI_ATTRIBUTES);
Result := ASHFileInfo.dwAttributes and SFGAO_FOLDER <> 0;
end;
begin
NavigationLock := True;
try
if IsFolder(APIDL) and not EqualPIDLs(APIDL, Root.Pidl) then
Root.Pidl := APIDL;
finally
NavigationLock := False;
end;
end;
procedure TcxCustomInnerShellListView.Sort;
begin
ItemProducer.Sort;
end;
procedure TcxCustomInnerShellListView.UpdateContent;
var
AItemIndex: Integer;
ASelectedItemPID: PItemIDList;
begin
ASelectedItemPID := nil;
try
if not MultiSelect and (Selected <> nil) then
ASelectedItemPID := GetPidlCopy(
TcxShellItemInfo(ItemProducer.Items[Selected.Index]).pidl);
CheckUpdateItems;
if ASelectedItemPID <> nil then
begin
AItemIndex := ItemProducer.GetItemIndexByPidl(ASelectedItemPID);
if (AItemIndex >= 0) and (AItemIndex < Items.Count) then
Items[AItemIndex].Selected := True;
end;
finally
DisposePidl(ASelectedItemPID);
end;
end;
{ TcxShellListRoot }
procedure TcxShellListRoot.RootUpdated;
begin
inherited RootUpdated;
(Owner as TcxCustomInnerShellListView).CheckUpdateItems;
if Assigned(TcxCustomInnerShellListView(Owner).OnRootChanged) then
TcxCustomInnerShellListView(Owner).OnRootChanged(Owner, Self);
end;
{ TcxShellListViewProducer }
function TcxShellListViewProducer.AllowBackgroundProcessing: Boolean;
begin
Result := True;
end;
function TcxShellListViewProducer.CanAddFolder(AFolder: TcxShellFolder): Boolean;
begin
Result := ListView.DoAddFolder(AFolder);
end;
function TcxShellListViewProducer.DoCompareItems(AItem1, AItem2: TcxShellFolder;
out ACompare: Integer): Boolean;
begin
Result := ListView.DoCompare(AItem1, AItem2, ACompare);
end;
function TcxShellListViewProducer.GetEnumFlags: Cardinal;
begin
Result := ListView.Options.GetEnumFlags;
end;
function TcxShellListViewProducer.GetItemsInfoGatherer: TcxShellItemsInfoGatherer;
begin
Result := ListView.ItemsInfoGatherer;
end;
function TcxShellListViewProducer.GetShowToolTip: Boolean;
begin
Result := ListView.Options.ShowToolTip;
end;
function TcxShellListViewProducer.GetListView: TcxCustomInnerShellListView;
begin
Result := TcxCustomInnerShellListView(Owner);
end;
procedure TcxShellListViewProducer.NotifyUpdateItem(AItem: PcxRequestItem);
begin
if AItem.Priority and Owner.HandleAllocated and (AItem.ItemIndex >= 0) and
(AItem.ItemIndex < Items.Count) then
PostMessage(Owner.Handle, DSM_NOTIFYUPDATE, AItem.ItemIndex, 0);
end;
procedure TcxShellListViewProducer.ProcessDetails(ShellFolder: IShellFolder;
CharWidth: Integer);
begin
inherited ProcessDetails(ShellFolder, ListView.StringWidth('X'));
ListView.CreateColumns;
end;
{ TcxShellTreeRoot }
procedure TcxShellTreeRoot.RootUpdated;
begin
inherited RootUpdated;
// TcxCustomInnerShellTreeView(Owner).ItemsInfoGatherer.ClearFetchQueue(nil);
TcxCustomInnerShellTreeView(Owner).Items.Clear;
TcxCustomInnerShellTreeView(Owner).UpdateNode(nil, False);
if Assigned(TcxCustomInnerShellTreeView(Owner).OnRootChanged) then
TcxCustomInnerShellTreeView(Owner).OnRootChanged(Owner, Self);
end;
{ TcxCustomInnerShellTreeView }
procedure TcxCustomInnerShellTreeView.AddItemProducer(
Producer: TcxShellTreeItemProducer);
var
tempList: TList;
begin
tempList := ItemProducersList.LockList;
try
tempList.Add(Producer);
finally
ItemProducersList.UnlockList;
end;
end;
function TcxCustomInnerShellTreeView.CanEdit(Node: TTreeNode): Boolean;
var
ItemProducer:TcxShellTreeItemProducer;
begin
Result := False;
if Node.Parent = nil then
Exit;
ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
ItemProducer.LockRead;
try
if (ItemProducer.Items.Count - 1) < Node.Index then
Exit;
Result := TcxShellItemInfo(ItemProducer.Items[Node.Index]).CanRename;
Result := Result and inherited CanEdit(Node);
finally
ItemProducer.UnlockRead;
end;
end;
function TcxCustomInnerShellTreeView.CanExpand(Node: TTreeNode): Boolean;
var
ItemProducer: TcxShellTreeItemProducer;
processingPidl: PItemIDList;
processingFolder: IShellFolder;
begin
Result := True;
if Node.GetFirstChild = nil then
begin
if Node.Parent <> nil then
begin
ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
Result := TcxShellItemInfo(ItemProducer.Items[Node.Index]).IsFolder;
Node.HasChildren := Result;
if not Result then
Exit;
if (ItemProducer.Items.Count-1) < Node.Index then
begin
Result := False;
Exit;
end;
if Failed(ItemProducer.ShellFolder.BindToObject(TcxShellItemInfo(ItemProducer.
Items[Node.Index]).pidl, nil, IID_IShellFolder, processingFolder)) then
begin
Result := False;
Exit;
end;
processingPidl := ConcatenatePidls(ItemProducer.FolderPidl,
TcxShellItemInfo(ItemProducer.Items[Node.Index]).pidl);
end
else
begin
processingFolder := Root.ShellFolder;
processingPidl := GetPidlCopy(Root.Pidl);
end;
try
ItemProducer := TcxShellTreeItemProducer(Node.Data);
ItemProducer.ProcessItems(processingFolder, processingPidl, Node, 0);
finally
DisposePidl(processingPidl);
end;
end;
Result := Result and inherited CanExpand(Node);
end;
procedure TcxCustomInnerShellTreeView.CNNotify(var Message: TWMNotify);
var
tempNode: TTreeNode;
ItemProducer: TcxShellTreeItemProducer;
begin
if (Message.NMHdr^.code = TVN_BEGINDRAG) or
(Message.NMHdr^.code = TVN_BEGINRDRAG) then
begin
with PNMTreeView(Message.NMHdr)^ do
Selected := GetNodeFromItem(ItemNew);
DoBeginDrag;
end
else
if Message.NMHdr^.code = TVN_GETINFOTIP then
begin
tempNode := Items.GetNode(PNMTVGetInfoTip(Message.NMHdr)^.hItem);
if (tempNode <> nil) and (tempNode.Parent <> nil) then
begin
ItemProducer := TcxShellTreeItemProducer(tempNode.Parent.Data);
ItemProducer.DoGetInfoTip(Handle,tempNode.Index,
PNMTVGetInfoTip(Message.NMHdr)^.pszText,
PNMTVGetInfoTip(Message.NMHdr)^.cchTextMax);
end;
end
else
inherited;
end;
constructor TcxCustomInnerShellTreeView.Create(AOwner: TComponent);
var
FileInfo: TShFileInfo;
begin
inherited;
FItemsInfoGatherer := TcxShellItemsInfoGatherer.Create(Self);
FRoot:=TcxShellTreeRoot.Create(Self, 0);
FRoot.OnSettingsChanged := RootSettingsChanged;
FDragDropSettings := TcxDragDropSettings.Create;
FDragDropSettings.OnChange := DragDropSettingsChanged;
FOptions := TcxShellTreeViewOptions.Create(Self);
TcxShellOptionsAccess(FOptions).OnShowToolTipChanged := ShowToolTipChanged;
FItemProducersList := TThreadList.Create;
FInternalSmallImages := SHGetFileInfo('C:\', 0, FileInfo, SizeOf(FileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
CurrentDropTarget := nil;
PrevTargetNode := nil;
DraggedObject := nil;
DoubleBuffered := True;
DragMode := dmAutomatic;
RightClickSelect := True;
end;
procedure TcxCustomInnerShellTreeView.CreateDropTarget;
var
AIDropTarget: IcxDropTarget;
begin
GetInterface(IcxDropTarget, AIDropTarget);
RegisterDragDrop(Handle,IDropTarget(AIDropTarget));
end;
procedure TcxCustomInnerShellTreeView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if ShowInfoTips then
Params.Style := (Params.Style or TVS_INFOTIP) and not TVS_NOTOOLTIPS;
end;
function TcxCustomInnerShellTreeView.IsLoading: Boolean;
begin
Result := csLoading in ComponentState;
end;
procedure TcxCustomInnerShellTreeView.AdjustControlParams;
var
AStyle: Longint;
begin
if HandleAllocated then
begin
AStyle := GetWindowLong(Handle, GWL_STYLE) and not(TVS_INFOTIP) or TVS_NOTOOLTIPS;
if ShowInfoTips or Options.ShowToolTip then
AStyle := AStyle and not TVS_NOTOOLTIPS;
if ShowInfoTips then
AStyle := AStyle or TVS_INFOTIP;
SetWindowLong(Handle, GWL_STYLE, AStyle);
end;
end;
procedure TcxCustomInnerShellTreeView.CreateWnd;
begin
inherited;
if HandleAllocated then
begin
if FInternalSmallImages <> 0 then
SendMessage(Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, LParam(FInternalSmallImages));
if not IsLoading and (Root.Pidl = nil) then
Root.CheckRoot;
UpdateNode(nil, False);
CreateDropTarget;
end;
end;
procedure TcxCustomInnerShellTreeView.Delete(Node: TTreeNode);
var
ItemProducer: TcxShellTreeItemProducer;
begin
ItemProducer := TcxShellTreeItemProducer(Node.Data);
if ItemProducer <> nil then
begin
ItemProducer.Free;
Node.Data := nil;
end;
inherited;
end;
destructor TcxCustomInnerShellTreeView.Destroy;
var
AList: TList;
I: Integer;
begin
if FListView <> nil then
FListView.SetTreeView(nil);
RemoveChangeNotification;
AList := FItemProducersList.LockList;
try
for I := 0 to AList.Count - 1 do
TcxShellTreeItemProducer(AList[I]).ClearFetchQueue;
finally
FItemProducersList.UnlockList;
end;
Items.Clear;
FreeAndNil(FItemProducersList);
FreeAndNil(FOptions);
FreeAndNil(FDragDropSettings);
FreeAndNil(FRoot);
FreeAndNil(FItemsInfoGatherer);
inherited Destroy;
end;
procedure TcxCustomInnerShellTreeView.UpdateContent;
begin
if HandleAllocated then
begin
if Root.ShellFolder = nil then
Root.CheckRoot;
SendMessage(Handle, DSM_SHELLTREECHANGENOTIFY, WPARAM(Root.Pidl), 0);
end;
end;
procedure TcxCustomInnerShellTreeView.DestroyWnd;
begin
RemoveChangeNotification;
RemoveDropTarget;
CreateWndRestores := False;
inherited;
end;
procedure TcxCustomInnerShellTreeView.DoBeginDrag;
var
ItemProducer: TcxShellTreeItemProducer;
tempPidl: PItemIDList;
pDataObject: IDataObject;
pDropSource: IcxDropSource;
dwEffect: Integer;
begin
if Selected.Parent = nil then
Exit;
ItemProducer := TcxShellTreeItemProducer(Selected.Parent.Data);
ItemProducer.LockRead;
try
if (ItemProducer.Items.Count-1) < Selected.Index then
Exit;
tempPidl:=GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[Selected.Index]).pidl);
try
if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDataObject, nil, pDataObject)) then
Exit;
pDropSource := TcxDropSource.Create(Self);
dwEffect := DragDropSettings.DropEffectAPI;
DoDragDrop(pDataObject, pDropSource, dwEffect, dwEffect);
if not TcxShellTreeItemProducer(Selected.Parent.Data).CheckUpdates then
UpdateNode(Selected.Parent, False);
finally
DisposePidl(tempPidl);
end;
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DoContextPopup(MousePos: TPoint;
var Handled: Boolean);
var
AItem: TcxShellItemInfo;
AItemPIDLList: TList;
ANode: TTreeNode;
begin
try
ANode := GetNodeAt(MousePos.X, MousePos.Y);
if not Options.ContextMenus or (ANode = nil) then
begin
inherited DoContextPopup(MousePos, Handled);
Exit;
end;
Handled := True;
if ANode.Parent = nil then
Exit;
FContextPopupItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
FContextPopupItemProducer.OnDestroy := ContextPopupItemProducerDestroyHandler;
FContextPopupItemProducer.LockRead;
try
CreateChangeNotification(ANode);
AItem := FContextPopupItemProducer.Items[ANode.Index];
FIsChangeNotificationCreationLocked := True;
if AItem.pidl <> nil then
begin
AItemPIDLList := TList.Create;
try
AItemPIDLList.Add(GetPidlCopy(AItem.pidl));
cxShellCommon.DisplayContextMenu(Handle, FContextPopupItemProducer.ShellFolder,
AItemPIDLList, ClientToScreen(MousePos));
finally
DisposePidl(AItemPIDLList[0]);
AItemPIDLList.Free;
end;
end;
finally
if FContextPopupItemProducer <> nil then
FContextPopupItemProducer.UnlockRead;
end;
finally
FIsChangeNotificationCreationLocked := False;
if FContextPopupItemProducer <> nil then
begin
FContextPopupItemProducer.OnDestroy := nil;
FContextPopupItemProducer := nil;
end;
end;
end;
function TcxCustomInnerShellTreeView.DragEnter(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
New: Boolean;
begin
DraggedObject := IcxDataObject(dataObj);
GetDropTarget(new, pt);
dwEffect := DragDropSettings.DefaultDropEffectAPI;
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
end;
function TcxCustomInnerShellTreeView.DragLeave: HResult;
begin
DraggedObject := nil;
Result := TryReleaseDropTarget;
end;
function TcxCustomInnerShellTreeView.IDropTargetDragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(new, pt);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(DraggedObject, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.DragOver(grfKeyState, pt, dwEffect);
end;
end;
function TcxCustomInnerShellTreeView.Drop(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(new, pt);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.Drop(dataObj, grfKeyState, pt, dwEffect);
end;
PostMessage(Handle, DSM_SHELLCHANGENOTIFY, WPARAM(PrevTargetNode.Data), 0);
TryReleaseDropTarget;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyAddItem(var Message: TMessage);
var
Node, NewNode: TTreeNode;
ItemProducer: TcxShellTreeItemProducer;
tempShellItem: TcxShellItemInfo;
begin
Node := TTreeNode(Message.LParam);
ItemProducer := TcxShellTreeItemProducer(Node.Data);
ItemProducer.LockRead;
try
tempShellItem := ItemProducer.Items[Message.WParam];
NewNode := Items.AddChild(Node, tempShellItem.Name);
NewNode.Data := TcxShellTreeItemProducer.Create(Self);
NewNode.ImageIndex := tempShellItem.IconIndex;
NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
NewNode.HasChildren := tempShellItem.HasSubfolder;
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyRemoveItem(
var Message: TMessage);
var
Node: TTreeNode;
begin
Node := TTreeNode(Message.LParam);
if Message.WParam < Node.Count then
Node.Item[Message.WParam].Delete;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateContents(
var Message: TMessage);
begin
if not (csLoading in ComponentState) then
UpdateNode(nil, False);
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateItem(
var Message: TMessage);
function GetChildNode(ANode: TTreeNode; AIndex: Integer): TTreeNode;
begin
Result := ANode.getFirstChild;
while (Result <> nil) and (AIndex > 0) do
begin
Result := ANode.GetNextChild(Result);
Dec(AIndex);
end;
end;
var
AItem: TcxShellItemInfo;
AItemProducer: TcxShellTreeItemProducer;
ANode, ATempNode: TTreeNode;
begin
ANode := TTreeNode(Message.LParam);
if ANode.getFirstChild = nil then
Exit;
ATempNode := GetChildNode(ANode, Message.WParam);
if ATempNode = nil then
Exit;
AItemProducer := TcxShellTreeItemProducer(ANode.Data);
AItemProducer.LockRead;
try
AItem := AItemProducer.Items[Message.WParam];
ATempNode.ImageIndex := AItem.IconIndex;
ATempNode.SelectedIndex := AItem.OpenIconIndex;
ATempNode.Text := AItem.Name;
ATempNode.HasChildren := AItem.HasSubfolder;
ATempNode.Cut := AItem.IsGhosted;
ATempNode.OverlayIndex := GetShellItemOverlayIndex(AItem);
finally
AItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmSetCount(var Message: TMessage);
var
Node: TTreeNode;
ItemProducer: TcxShellTreeItemProducer;
i: Integer;
NewNode: TTreeNode;
tempShellItem: TcxShellItemInfo;
begin
Node := TTreeNode(Message.LParam);
if Message.WParam = 0 then
begin
Node.DeleteChildren;
Node.HasChildren := False;
Exit;
end;
ItemProducer := TcxShellTreeItemProducer(Node.Data);
ItemProducer.LockRead;
try
Items.BeginUpdate;
try
for i := 0 to ItemProducer.Items.Count-1 do
begin
tempShellItem := ItemProducer.Items[i];
if not tempShellItem.Updated then
ItemProducer.FetchRequest(i, False);
NewNode := Items.AddChild(Node, tempShellItem.Name);
NewNode.Data := TcxShellTreeItemProducer.Create(Self);
NewNode.ImageIndex := tempShellItem.IconIndex;
NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
NewNode.HasChildren := tempShellItem.HasSubfolder;
NewNode.Cut := tempShellItem.IsGhosted;
NewNode.OverlayIndex := GetShellItemOverlayIndex(tempShellItem);
end;
finally
Items.EndUpdate;
end;
if Node.GetFirstChild = nil then
Node.HasChildren := False;
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmShellChangeNotify(
var Message: TMessage);
begin
Sleep(100);
if not TcxShellTreeItemProducer(Message.WParam).CheckUpdates then
UpdateNode(PrevTargetNode, False);
end;
procedure TcxCustomInnerShellTreeView.Edit(const Item: TTVItem);
var
AItemInfo: TcxShellItemInfo;
AItemProducer: TcxShellTreeItemProducer;
ANode: TTreeNode;
APIDL: PItemIDList;
APrevNodeText: string;
begin
ANode := GetNodeFromItem(Item);
APrevNodeText := '';
if ANode <> nil then
APrevNodeText := ANode.Text;
inherited Edit(Item);
if (Item.pszText = nil) or (ANode = nil) or (ANode.Parent = nil) then
Exit;
AItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
AItemInfo := AItemProducer.Items[ANode.Index];
RemoveChangeNotification;
if AItemProducer.ShellFolder.SetNameOf(Handle, AItemInfo.pidl, PWideChar(WideString(ANode.Text)),
SHGDN_INFOLDER or SHGDN_FORPARSING, APIDL) = S_OK then
try
AItemInfo.SetNewPidl(AItemProducer.ShellFolder, AItemProducer.FolderPidl, APIDL);
UpdateNode(ANode, True);
finally
DisposePidl(APIDL);
end
else
ANode.Text := APrevNodeText;
end;
procedure TcxCustomInnerShellTreeView.GetDropTarget(out New: Boolean; pt: TPoint);
var
Node: TTreeNode;
cpt: TPoint;
ItemProducer: TcxShellTreeItemProducer;
tempDropTarget: IcxDropTarget;
tempShellItem: TcxShellItemInfo;
tempPidl: PItemIDList;
Res: HRESULT;
tempShellFolder: IShellFolder;
begin
cpt := ScreenToClient(pt);
Node := GetNodeAt(cpt.X, cpt.Y);
if Node = nil then
begin
TryReleaseDropTarget;
Exit;
end;
if (Node = PrevTargetNode) and (CurrentDropTarget <> nil) then
begin
New := False;
Exit;
end;
TryReleaseDropTarget;
New := True;
if Node.Parent = nil then
begin // Root object selected
ItemProducer := TcxShellTreeItemProducer(Node.Data);
if ItemProducer.ShellFolder = nil then
Exit;
Res:=ItemProducer.ShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget);
if Failed(Res) then
Exit;
end
else
begin // Non-root object selected
ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
tempShellItem := ItemProducer.Items[Node.Index];
tempPidl := GetPidlCopy(tempShellItem.pidl);
try
if tempShellItem.IsFolder then
begin
if Failed(ItemProducer.ShellFolder.BindToObject(tempPidl, nil, IID_IShellFolder, tempShellFolder)) then
Exit;
if Failed(tempShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget)) then
Exit;
end
else
begin
Res := ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDropTarget, nil, tempDropTarget);
if Failed(Res) then
Exit;
end;
finally
DisposePidl(tempPidl);
end;
end;
PrevTargetNode := Node;
CurrentDropTarget := tempDropTarget;
end;
procedure TcxCustomInnerShellTreeView.ContextPopupItemProducerDestroyHandler(
Sender: TObject);
begin
FContextPopupItemProducer.UnlockRead;
FContextPopupItemProducer.OnDestroy := nil;
FContextPopupItemProducer := nil;
end;
function TcxCustomInnerShellTreeView.GetFolder(AIndex: Integer): TcxShellFolder;
var
ANode: TTreeNode;
begin
ANode := Items[AIndex];
if ANode.Parent = nil then
Result := Root.Folder
else
Result := TcxShellItemInfo(TcxShellTreeItemProducer(ANode.Parent.Data).Items[ANode.Index]).Folder;
end;
function TcxCustomInnerShellTreeView.GetFolderCount: Integer;
begin
Result := Items.Count;
end;
function TcxCustomInnerShellTreeView.GetNodeFromItem(
const Item: TTVItem): TTreeNode;
begin
Result := nil;
if Items <> nil then
with Item do
if (state and TVIF_PARAM) <> 0 then
Result := Pointer(lParam)
else
Result := Items.GetNode(hItem);
end;
procedure TcxCustomInnerShellTreeView.RestoreTreeState;
procedure RestoreExpandedNodes;
procedure ExpandNode(APIDL: PItemIDList);
var
ANode: TTreeNode;
begin
if Root.ShellFolder = nil then
Root.CheckRoot;
if APIDL = nil then
APIDL := Root.Pidl;
ANode := GetNodeByPIDL(APIDL);
if ANode <> nil then
ANode.Expand(False);
end;
procedure DestroyExpandedNodeList;
var
I: Integer;
begin
if FStateData.ExpandedNodeList = nil then
Exit;
for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
DisposePidl(PItemIDList(FStateData.ExpandedNodeList[I]));
FreeAndNil(FStateData.ExpandedNodeList);
end;
var
I: Integer;
begin
try
for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
ExpandNode(PItemIDList(FStateData.ExpandedNodeList[I]));
finally
DestroyExpandedNodeList;
end;
end;
procedure RestoreTopItemIndex;
begin
if (FStateData.TopItemIndex >= 0) and (FStateData.TopItemIndex < Items.Count) then
TopItem := Items[FStateData.TopItemIndex];
end;
procedure RestoreCurrentPath;
var
ACurrentPath, ATempPIDL: PItemIDList;
begin
if FStateData.CurrentPath = nil then
Exit;
ACurrentPath := GetPidlCopy(FStateData.CurrentPath);
try
repeat
if GetNodeByPIDL(ACurrentPath) <> nil then
begin
PostMessage(Handle, DSM_SHELLTREERESTORECURRENTPATH,
WPARAM(GetPidlCopy(ACurrentPath)), 0);
Break;
end;
ATempPIDL := ACurrentPath;
ACurrentPath := GetPidlParent(ACurrentPath);
DisposePidl(ATempPIDL);
until False;
finally
DisposePidl(ACurrentPath);
end;
end;
begin
try
RestoreExpandedNodes;
RestoreTopItemIndex;
RestoreCurrentPath;
finally
DisposePidl(FStateData.CurrentPath);
FStateData.CurrentPath := nil;
end;
end;
procedure TcxCustomInnerShellTreeView.SaveTreeState;
procedure SaveTopItemIndex;
begin
if TopItem <> nil then
FStateData.TopItemIndex := TopItem.AbsoluteIndex
else
FStateData.TopItemIndex := -1;
end;
procedure SaveExpandedNodes;
procedure SaveExpandedNode(ANode: TTreeNode);
var
AParentItemProducer: TcxShellTreeItemProducer;
begin
if ANode.Parent = nil then
FStateData.ExpandedNodeList.Add(nil)
else
begin
AParentItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
FStateData.ExpandedNodeList.Add(GetPidlCopy(
TcxShellItemInfo(AParentItemProducer.Items[ANode.Index]).FullPIDL));
end;
end;
var
ANode: TTreeNode;
begin
FStateData.ExpandedNodeList := TList.Create;
ANode := Items.GetFirstNode;
while ANode <> nil do
begin
if ANode.Expanded then
SaveExpandedNode(ANode);
ANode := ANode.GetNext;
end;
end;
procedure SaveCurrentPath;
begin
if Selected <> nil then
begin
if Selected.Parent = nil then
FStateData.CurrentPath := Root.Pidl
else
FStateData.CurrentPath := TcxShellItemInfo(TcxShellTreeItemProducer(
Selected.Parent.Data).Items[Selected.Index]).FullPIDL;
FStateData.CurrentPath := GetPidlCopy(FStateData.CurrentPath);
end
else
FStateData.CurrentPath := nil;
end;
begin
SaveTopItemIndex;
SaveExpandedNodes;
SaveCurrentPath;
end;
procedure TcxCustomInnerShellTreeView.Loaded;
begin
if Root.Pidl = nil then
Root.CheckRoot;
UpdateNode(nil, False);
end;
procedure TcxCustomInnerShellTreeView.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = FListView then
FListView := nil
end;
procedure TcxCustomInnerShellTreeView.RemoveDropTarget;
begin
RevokeDragDrop(Handle);
end;
procedure TcxCustomInnerShellTreeView.RemoveItemProducer(
Producer: TcxShellTreeItemProducer);
var
tempList: TList;
begin
tempList := ItemProducersList.LockList;
try
tempList.Remove(Producer);
finally
ItemProducersList.UnlockList;
end;
end;
procedure TcxCustomInnerShellTreeView.CreateChangeNotification(
ANode: TTreeNode = nil);
function GetShellChangeNotifierPIDL: PItemIDList;
begin
if Root.ShellFolder = nil then
Root.CheckRoot;
if ANode = nil then
if Selected = nil then
ANode := Items[0]
else
ANode := Selected;
if ANode.Parent = nil then
Result := Root.Pidl
else
Result := TcxShellItemInfo(TcxShellTreeItemProducer(
ANode.Parent.Data).Items[ANode.Index]).FullPIDL;
end;
begin
if FIsChangeNotificationCreationLocked then
Exit;
FShellChangeNotificationCreation := True;
try
if not Options.TrackShellChanges or (Items.Count = 0) then
RemoveChangeNotification
else
RegisterShellChangeNotifier(GetShellChangeNotifierPIDL, Handle,
DSM_SHELLTREECHANGENOTIFY, True, FShellChangeNotifierData);
finally
FShellChangeNotificationCreation := False;
end;
end;
function TcxCustomInnerShellTreeView.DoAddFolder(AFolder: TcxShellFolder): Boolean;
begin
Result := True;
if Assigned(FOnAddFolder) then
FOnAddFolder(Self, AFolder, Result);
end;
procedure TcxCustomInnerShellTreeView.SetPrevTargetNode(const Value: TTreeNode);
begin
if FPrevTargetNode <> nil then
FPrevTargetNode.DropTarget := False;
FPrevTargetNode := Value;
if FPrevTargetNode <> nil then
FPrevTargetNode.DropTarget := True;
end;
function TcxCustomInnerShellTreeView.TryReleaseDropTarget: HResult;
begin
Result := S_OK;
if CurrentDropTarget <> nil then
Result := CurrentDropTarget.DragLeave;
CurrentDropTarget := nil;
PrevTargetNode := nil;
end;
(*procedure TcxCustomInnerShellTreeView.UpdateNode(ANode: TTreeNode);
var
uNode:TTreeNode;
begin
if csLoading in ComponentState then
Exit;
uNode:=nil;
if IsWindow(Handle) and Root.IsValid then
begin
if ANode=nil then
begin
if (Items.Count > 0) and (Items[0].Data <> nil) then
Items.Clear;
if Items.Count=0 then
uNode:=Items.AddFirst(nil,'')
else
uNode:=Items[0];
uNode.Data:=TcxShellTreeItemProducer.Create(Self);
end
else
uNode:=ANode;
uNode.HasChildren:=True;
end;
if uNode<>nil then
CanExpand(uNode);
end;*)
procedure TcxCustomInnerShellTreeView.UpdateNode(ANode: TTreeNode;
AFast: Boolean);
var
AFullPIDL: PITemIDList;
AParentItemProducer: TcxShellTreeItemProducer;
ATempNode: TTreeNode;
begin
if csLoading in ComponentState then
Exit;
if IsWindow(WindowHandle) and Root.IsValid then
begin
if ANode = nil then
begin
if (Items.Count > 0) and (Items[0].Data <> nil) then
Items.Clear;
if Items.Count = 0 then
ATempNode := Items.AddFirst(nil, '')
else
ATempNode := Items[0];
ATempNode.Data := TcxShellTreeItemProducer.Create(Self);
end
else
ATempNode := ANode;
if not AFast or (ATempNode.Parent = nil) then
ATempNode.HasChildren := True
else
begin
AParentItemProducer := TcxShellTreeItemProducer(ATempNode.Parent.Data);
AFullPIDL := ConcatenatePidls(AParentItemProducer.FolderPidl,
TcxShellItemInfo(AParentItemProducer.Items[ATempNode.Index]).pidl);
TcxShellTreeItemProducer(ATempNode.Data).FolderPidl := AFullPIDL;
ATempNode.HasChildren := HasSubItems(AParentItemProducer.ShellFolder,
AFullPIDL, AParentItemProducer.GetEnumFlags);
end;
if not AFast or (ATempNode.Parent = nil) then
CanExpand(ATempNode);
CreateChangeNotification;
end;
end;
procedure TcxCustomInnerShellTreeView.SetListView(
Value: TcxCustomInnerShellListView);
begin
if FListView = Value then
Exit;
if FListView <> nil then
begin
FListView.SetTreeView(nil);
FListView.RemoveFreeNotification(Self);
end;
FListView := Value;
if FListView <> nil then
begin
FListView.FreeNotification(Self);
FListView.SetTreeView(Self);
end;
DoNavigateListView;
end;
procedure TcxCustomInnerShellTreeView.RootSettingsChanged(Sender: TObject);
begin
if (Parent <> nil) and (csLoading in Parent.ComponentState) then
Exit;
if (FListView <> nil) and FListView.HandleAllocated then
SendMessage(FListView.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
if (FComboBoxControl <> nil) and FComboBoxControl.HandleAllocated then
SendMessage(FComboBoxControl.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
end;
procedure TcxCustomInnerShellTreeView.SetShowInfoTips(Value: Boolean);
begin
if Value <> FShowInfoTips then
begin
FShowInfoTips := Value;
AdjustControlParams;
end;
end;
procedure TcxCustomInnerShellTreeView.ShowToolTipChanged(Sender: TObject);
begin
ToolTips := Options.ShowToolTip;
AdjustControlParams;
end;
procedure TcxCustomInnerShellTreeView.DSMShellTreeChangeNotify(var Message: TMessage);
function NeedProcessMessage: Boolean; // TODO more detailed selection
begin
Result := (Message.LParam <> SHCNE_UPDATEITEM) or
(GetNodeByPIDL(PPItemIDList(Message.WParam)^) <> nil);
end;
begin
if FShellChangeNotificationCreation or FIsUpdating or not NeedProcessMessage then
Exit;
try
if DraggedObject <> nil then
Exit;
Items.BeginUpdate;
FIsUpdating := True;
try
SendMessage(Parent.Handle, WM_SETREDRAW, 0, 0);
try
SaveTreeState;
try
Items.Clear;
UpdateNode(nil, False);
finally
RestoreTreeState;
end;
finally
SendMessage(Parent.Handle, WM_SETREDRAW, 1, 0);
Parent.Update;
end;
finally
FIsUpdating := False;
Items.EndUpdate;
end;
finally
DoShellChange(Self, OnShellChange, Message);
end;
end;
procedure TcxCustomInnerShellTreeView.DSMShellTreeRestoreCurrentPath(var Message: TMessage);
var
APrevAutoExpand: Boolean;
begin
if FIsChangeNotificationCreationLocked then
PostMessage(Handle, DSM_SHELLTREERESTORECURRENTPATH, Message.WPARAM, 0)
else
try
APrevAutoExpand := AutoExpand;
AutoExpand := False;
try
SendMessage(Handle, DSM_DONAVIGATE, Message.WPARAM, 0);
DoNavigateListView;
finally
AutoExpand := APrevAutoExpand;
end;
finally
DisposePidl(PItemIDList(Message.WPARAM));
end;
end;
procedure TcxCustomInnerShellTreeView.DSMSynchronizeRoot(var Message: TMessage);
begin
if not((Parent <> nil) and (csLoading in Parent.ComponentState)) then
Root.Update(TcxCustomShellRoot(Message.WParam));
end;
procedure TcxCustomInnerShellTreeView.DoNavigateListView;
var
ATempPIDL: PItemIDList;
begin
if (Items.Count = 0) or (not Assigned(ListView) and not Assigned(ComboBoxControl)) then
Exit;
if Selected <> nil then
ATempPIDL := TcxShellTreeItemProducer(Selected.Data).FolderPidl
else
ATempPIDL := TcxShellTreeItemProducer(Items[0].Data).FolderPidl;
if Assigned(ListView) then
ListView.ProcessTreeViewNavigate(ATempPIDL);
if Assigned(ComboBoxControl) and (ComboBoxControl.Parent <> nil) then
begin
ComboBoxControl.HandleNeeded;
SendMessage(ComboBoxControl.Handle, DSM_DONAVIGATE, Integer(ATempPIDL), 0);
end;
end;
procedure TcxCustomInnerShellTreeView.DragDropSettingsChanged(Sender: TObject);
begin
if DragDropSettings.AllowDragObjects then
DragMode := dmAutomatic
else
DragMode := dmManual;
end;
function TcxCustomInnerShellTreeView.GetNodeByPIDL(APIDL: PItemIDList): TTreeNode;
var
AItemIndex, I: Integer;
APID: PItemIDList;
begin
Result := nil;
if APIDL = nil then
Exit;
if Root.ShellFolder = nil then
Root.CheckRoot;
if EqualPIDLs(Root.Pidl, APIDL) then
begin
Result := Items[0];
Exit;
end;
if not IsSubPath(Root.Pidl, APIDL) then
Exit;
for I := 0 to GetPidlItemsCount(Root.Pidl) - 1 do
APIDL := GetNextItemID(APIDL);
Result := Items[0];
for I := 0 to GetPidlItemsCount(APIDL) - 1 do
begin
APID := ExtractParticularPidl(APIDL);
if APID = nil then
Break;
try
AItemIndex := TcxShellTreeItemProducer(Result.Data).GetItemIndexByPidl(APID);
if (AItemIndex = -1) or (AItemIndex >= Result.Count) then
begin
Result := nil;
Break;
end;
Result := Result.Item[AItemIndex];
APIDL := GetNextItemID(APIDL);
finally
DisposePidl(APID);
end;
end;
end;
procedure TcxCustomInnerShellTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key = VK_F5 then
UpdateContent;
end;
procedure TcxCustomInnerShellTreeView.RemoveChangeNotification;
begin
UnregisterShellChangeNotifier(FShellChangeNotifierData);
end;
procedure TcxCustomInnerShellTreeView.Change(Node: TTreeNode);
begin
inherited Change(Node);
UpdateNode(Selected, not Navigation);
if not Navigation then
DoNavigateListView;
end;
procedure TcxCustomInnerShellTreeView.DsmDoNavigate(var Message: TMessage);
var
srcPidl: PItemIDList;
destPidl: PItemIDList;
pFolder: IShellFolder;
partDstPidl: PItemIDList;
i: Integer;
tempProducer: TcxShellTreeItemProducer;
tempIndex: Integer;
begin
Navigation := True;
Items.BeginUpdate;
try
if Failed(SHGetDesktopFolder(pFolder)) then
Exit;
srcPidl := Root.Pidl;
destPidl := PItemIDList(Message.WParam);
if GetPidlItemsCount(srcPidl) > GetPidlItemsCount(destPidl) then
begin
Root.Pidl := destPidl;
Items[0].Selected := True;
Exit;
end;
for i := 0 to GetPidlItemsCount(srcPidl) - 1 do
DestPidl := GetNextItemID(DestPidl);
Selected := Items[0];
for i := 0 to GetPidlItemsCount(destPidl) - 1 do
begin
tempProducer := Selected.Data;
partDstPidl := ExtractParticularPidl(destPidl);
destPidl := GetNextItemID(destPidl);
if partDstPidl = nil then
Break;
try
tempIndex := tempProducer.GetItemIndexByPidl(partDstPidl);
if tempIndex = -1 then
Break;
Selected := Selected.Item[tempIndex];
finally
DisposePidl(partDstPidl);
end;
end;
finally
Items.EndUpdate;
Navigation := False;
end;
if Selected <> nil then
SendMessage(Handle, TVM_ENSUREVISIBLE, 0, LPARAM(Selected.ItemId));
end;
{ TcxShellTreeItemProducer }
function TcxShellTreeItemProducer.GetItemsInfoGatherer: TcxShellItemsInfoGatherer;
begin
Result := TreeView.ItemsInfoGatherer;
end;
procedure TcxShellTreeItemProducer.CheckForSubitems(
AItem: TcxShellItemInfo);
begin
inherited CheckForSubitems(AItem);
if (AItem <> nil) and (not AItem.IsRemovable) then
AItem.CheckSubitems(ShellFolder, GetEnumFlags);
end;
function TcxShellTreeItemProducer.CheckUpdates:Boolean;
const
R: array[Boolean] of Byte = (0, 1);
var
pEnum: IEnumIDList;
currentCelt: Cardinal;
rPidl: PItemIDList;
Item: TcxShellItemInfo;
Res: HRESULT;
SaveCursor: TCursor;
tempList: TList;
function ShellSortFunction(Item1, Item2: Pointer): Integer;
var
AItemInfo1, AItemInfo2: TcxShellItemInfo;
begin
Result := 0;
if (Item1 = nil) or (Item2 = nil) then
Exit;
AItemInfo1 := TcxShellItemInfo(Item1);
AItemInfo2 := TcxShellItemInfo(Item2);
Result := R[AItemInfo2.IsFolder] - R[AItemInfo1.IsFolder];
if Result = 0 then
Result := Smallint(TcxShellTreeItemProducer(
AItemInfo1.ItemProducer).ShellFolder.CompareIDs(0, AItemInfo1.pidl, AItemInfo2.pidl));
end;
procedure MergeItems(Existent,New:TList);
var
i, j: Integer;
exstItem: TcxShellItemInfo;
newItem: TcxShellItemInfo;
found: Boolean;
begin
i := 0;
while (i < Existent.Count) do
begin
exstItem := Existent[i];
found := False;
for j := 0 to New.Count-1 do
begin
newItem := New[j];
if Smallint(ShellFolder.CompareIDs(0, exstItem.pidl, newItem.pidl)) = 0 then
begin
exstItem.Free;
Existent[i] := newItem;
New.Remove(newItem);
found := True;
Break;
end;
end;
if not found then
begin
NotifyRemoveItem(i);
Existent.Remove(exstItem);
exstItem.Free;
end
else
Inc(i);
end;
for i := 0 to New.Count - 1 do
if CanAddFolder(TcxShellItemInfo(New[i]).Folder) then
begin
Existent.Add(New[i]);
exstItem := Existent[Existent.Count - 1];
exstItem.CheckUpdate(ShellFolder, FolderPidl, False);
NotifyAddItem(Existent.Count - 1);
end
else
TcxShellItemInfo(New[i]).Free;
end;
begin
Result := False;
if ShellFolder = nil then
Exit;
if Failed(ShellFolder.EnumObjects(Owner.ParentWindow, GetEnumFlags, pEnum)) or
not Assigned(pEnum) then
Exit;
currentCelt := 1;
tempList := TList.Create;
SaveCursor := Owner.Cursor;
try
Owner.Cursor := crHourGlass;
repeat
Res := pEnum.Next(currentCelt, rPidl, currentCelt);
try
if Res = E_INVALIDARG then
begin
currentCelt := 1;
Res := pEnum.Next(currentCelt, rPidl, currentCelt);
end;
if Failed(Res) or (Res = S_FALSE) then
Break;
if currentCelt = 0 then
Break;
Item := TcxShellItemInfo.Create(Self, ShellFolder, FolderPidl, rPidl, False);
if Item.Name = '' then
begin
Item.Free;
Continue;
end;
tempList.Add(Item);
finally
DisposePidl(rPidl);
end;
until(Res = S_FALSE);
tempList.Sort(@ShellSortFunction);
LockWrite;
try
MergeItems(Items, tempList);
finally
UnlockWrite;
end;
finally
Owner.Cursor := SaveCursor;
FreeAndNil(tempList);
end;
Result := True;
end;
constructor TcxShellTreeItemProducer.Create(AOwner: TWinControl);
begin
inherited Create(AOwner);
TreeView.AddItemProducer(Self);
end;
destructor TcxShellTreeItemProducer.Destroy;
begin
if Assigned(FOnDestroy) then
FOnDestroy(Self);
TreeView.RemoveItemProducer(Self);
inherited Destroy;
end;
function TcxShellTreeItemProducer.AllowBackgroundProcessing: Boolean;
begin
Result:= not TreeView.Navigation;
end;
function TcxShellTreeItemProducer.CanAddFolder(AFolder: TcxShellFolder): Boolean;
begin
Result := TreeView.DoAddFolder(AFolder);
end;
function TcxShellTreeItemProducer.GetEnumFlags: Cardinal;
begin
Result := TreeView.Options.GetEnumFlags;
end;
function TcxShellTreeItemProducer.GetShowToolTip: Boolean;
begin
Result := TreeView.ShowInfoTips;
end;
procedure TcxShellTreeItemProducer.InitializeItem(Item: TcxShellItemInfo);
begin
inherited;
Item.CheckUpdate(ShellFolder, FolderPidl, False);
CheckForSubitems(Item);
end;
procedure TcxShellTreeItemProducer.NotifyAddItem(Index: Integer);
begin
if (Owner.HandleAllocated) and (Node <> nil) then
SendMessage(Owner.Handle, DSM_NOTIFYADDITEM, Index, Integer(Node));
end;
procedure TcxShellTreeItemProducer.NotifyRemoveItem(Index: Integer);
begin
if (Owner.HandleAllocated) and (Node <> nil) then
SendMessage(Owner.Handle, DSM_NOTIFYREMOVEITEM, Index, Integer(Node));
end;
procedure TcxShellTreeItemProducer.NotifyUpdateItem(AItem: PcxRequestItem);
begin
if (Owner.HandleAllocated) and (Node <> nil) then
PostMessage(Owner.Handle, DSM_NOTIFYUPDATE, AItem.ItemIndex, Integer(Node));
end;
procedure TcxShellTreeItemProducer.ProcessItems(AIFolder: IShellFolder;
APIDL: PItemIDList; ANode: TTreeNode; cPreloadItems: Integer);
function SetNodeText: Boolean;
var
ATempPIDL: PItemIDList;
begin
Result := ANode.Parent <> nil;
if not Result then
Exit;
ATempPIDL := GetLastPidlItem(APIDL);
Node.Text := GetShellItemDisplayName(
TcxShellTreeItemProducer(Node.Parent.Data).ShellFolder, ATempPIDL, True);
end;
var
AFileInfo: TShFileInfo;
begin
Node := ANode;
SHGetFileInfo(PChar(APIDL), 0, AFileInfo, SizeOf(AFileInfo),
SHGFI_PIDL or SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX);
if not SetNodeText then
Node.Text := StrPas(AFileInfo.szDisplayName);
ANode.ImageIndex := AFileInfo.iIcon;
SHGetFileInfo(PChar(APIDL), 0, AFileInfo, SizeOf(AFileInfo),
SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_OPENICON);
Node.SelectedIndex := AFileInfo.iIcon;
ProcessItems(AIFolder, APIDL, cPreloadItems);
end;
procedure TcxShellTreeItemProducer.SetItemsCount(Count: Integer);
begin
if (Owner.HandleAllocated) and (Node <> nil) then
SendMessage(Owner.Handle, DSM_SETCOUNT, Count, Integer(Node));
end;
function TcxShellTreeItemProducer.GetTreeView: TcxCustomInnerShellTreeView;
begin
Result := TcxCustomInnerShellTreeView(Owner);
end;
initialization
NavigationLock := False;
end.
Reference in New Issue View Git Blame Copy Permalink