cxshellcontrols.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,033 行 · 第 1/5 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       Copyright (c) 1998-2008 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
    FAutoNavigate: Boolean;
  public
    constructor Create(AOwner: TWinControl); override;
    procedure Assign(Source: TPersistent); override;
  published
    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