acshellctrls.pas

Alpha Controls 界面控件包

unit acShellCtrls;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, CommCtrl, ShlObj, ActiveX, StdCtrls, ImgList, sComboBoxes, sTreeView,
  sConst, sListView{$IFNDEF DELPHI6UP}, acD5ShlObj{$ENDIF};

type
  TacRootFolder = (rfDesktop, rfMyComputer, rfNetwork, rfRecycleBin, rfAppData, rfCommonDesktopDirectory, rfCommonPrograms,
                   rfCommonStartMenu, rfCommonStartup, rfControlPanel, rfDesktopDirectory, rfFavorites, rfFonts, rfInternet,
                   rfPersonal, rfPrinters, rfPrintHood, rfPrograms, rfRecent, rfSendTo, rfStartMenu, rfStartup, rfTemplates);

{$IFNDEF NOTFORHELP}
  TacShellFolderCapability = (fcCanCopy, fcCanDelete, fcCanLink, fcCanMove, fcCanRename, fcDropTarget, fcHasPropSheet);
  TacShellFolderCapabilities = set of TacShellFolderCapability;

  TacShellFolderProperty = (fpCut, fpIsLink, fpReadOnly, fpShared, fpFileSystem, fpFileSystemAncestor, fpRemovable, fpValidate);
  TacShellFolderProperties = set of TacShellFolderProperty;

  TacShellObjectType = (otFolders, otNonFolders, otHidden);
  TacShellObjectTypes = set of TacShellObjectType;

  //Lexa
  TacShowExtension = (seSystem, seShow, seHide);

  IacShellCommandVerb = interface
    ['{7D2A7245-2376-4D33-8008-A130935A2E8B}']
    procedure ExecuteCommand(Verb: string; var Handled: boolean);
    procedure CommandCompleted(Verb: string; Succeeded: boolean);
  end;

  IShellDetails = interface(IUnknown)
    [SID_IShellDetails]
    function GetDetailsOf(pidl: PItemIDList; iColumn: UINT; var pDetails: TShellDetails): HResult; stdcall;
    function ColumnClick(iColumn: UINT): HResult; stdcall;
  end;

  IDetInterface = interface
    ['{00000000-0000-0000-C000-000000000046}']
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  TacShellFolder = class
  private
    FPIDL, FFullPIDL: PItemIDList;
    FParent: TacShellFolder;
    FIShellFolder: IShellFolder;

    FIShellFolder2: IShellFolder2;
    FIShellDetails: IShellDetails;
    FDetailInterface: IDetInterface;

    FLevel: Integer;
    FViewHandle: THandle;
    FDetails: TStrings;
    function GetDetailInterface: IDetInterface;
    function GetShellDetails: IShellDetails;
    function GeTacShellFolder2: IShellFolder2;
    function GetDetails(Index: integer): string;
    procedure SetDetails(Index: integer; const Value: string);
    procedure LoadColumnDetails(RootFolder: TacShellFolder; Handle: THandle; ColumnCount: integer);
  public
    constructor Create(AParent: TacShellFolder; ID: PItemIDList; SF: IShellFolder); virtual;
    destructor Destroy; override;
    function Capabilities: TacShellFolderCapabilities;
    function DisplayName(ShowExt: TacShowExtension): string;
    function ExecuteDefault: Integer;
    function ImageIndex(LargeIcon: Boolean): Integer;
    function IsFolder(Name : string = ''; OpenZipFiles : Boolean = True): Boolean;
    function IsFileFolder: Boolean;
    function IsFile(Name : string = ''; OpenZipFiles : Boolean = True): Boolean;
    function IsReadOnly: Boolean;
    function ParenTacShellFolder: IShellFolder;
    function PathName: string;
    function Properties: TacShellFolderProperties;
    function Rename(const NewName: WideString): boolean;
    function SubFolders: Boolean;
    property AbsoluteID: PItemIDLIst read FFullPIDL;
    property Details[Index: integer] : string read GetDetails write SetDetails;
    property Level: Integer read FLevel;
    property Parent: TacShellFolder read FParent;
    property RelativeID: PItemIDList read FPIDL;
    property ShellFolder: IShellFolder read FIShellFolder;
    property ShellFolder2: IShellFolder2 read GeTacShellFolder2;
    property ShellDetails: IShellDetails read GetShellDetails;
    property ViewHandle: THandle read FViewHandle write FViewHandle;
  end;

  TacNotifyFilter = (nfFileNameChange, nfDirNameChange, nfAttributeChange, nfSizeChange, nfWriteChange, nfSecurityChange);
  TacNotifyFilters = set of TacNotifyFilter;

  TacShellChangeThread = class(TThread)
  private
    FMutex,
    FWaitHandle: Integer;
    FChangeEvent: TThreadMethod;
    FDirectory: string;
    FWatchSubTree: Boolean;
    FWaitChanged : Boolean;
    FNotifyOptionFlags: DWORD;
  protected
    procedure Execute; override;
  public
    constructor Create(ChangeEvent: TThreadMethod); virtual;
    destructor Destroy; override;
    procedure SetDirectoryOptions( Directory : String; WatchSubTree : Boolean; NotifyOptionFlags : DWORD);
    property ChangeEvent : TThreadMethod read FChangeEvent write FChangeEvent;
  end;

  TacCustomShellChangeNotifier = class(TComponent)
  private
    FFilters: TacNotifyFilters;
    FWatchSubTree: Boolean;
    FRoot : TacRoot;
    FThread: TacShellChangeThread;
    FOnChange: TThreadMethod;
    procedure SetRoot(const Value: TacRoot);
    procedure SetWatchSubTree(const Value: Boolean);
    procedure SetFilters(const Value: TacNotifyFilters);
    procedure SetOnChange(const Value: TThreadMethod);
  protected
    procedure Change;
    procedure Start;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    property NotifyFilters: TacNotifyFilters read FFilters write SetFilters;
    property Root: TacRoot read FRoot write SetRoot;
    property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
    property OnChange: TThreadMethod read FOnChange write SetOnChange;
  end;

  TacShellChangeNotifier = class(TacCustomShellChangeNotifier)
  published
    property NotifyFilters;
    property Root;
    property WatchSubTree;
    property OnChange;
  end;

  TacCustomShellComboBox = class;
  TacCustomShellListView = class;
{$ENDIF} // NOTFORHELP

  TacAddFolderEvent = procedure (Sender: TObject; AFolder: TacShellFolder; var CanAdd: Boolean) of object;
  TacGetImageIndexEvent = procedure (Sender: TObject; Index: Integer; var ImageIndex: Integer) of object;

{ TacCustomShellTreeView }

{$IFNDEF NOTFORHELP}
  TacCustomShellTreeView = class(TsTreeView, IacShellCommandVerb)
  private
    FRoot, FOldRoot : TacRoot;
    FRootFolder: TacShellFolder;
    FObjectTypes: TacShellObjectTypes;
    FImage: Integer;
    FLoadingRoot, FAutoContext, FUpdating: Boolean;
    FComboBox: TacCustomShellComboBox;
    FListView: TacCustomShellListView;
    FAutoRefresh, FImageListChanging, FUseShellImages: Boolean;
    FNotifier: TacShellChangeNotifier;
    FOnAddFolder: TacAddFolderEvent;
    FSavePath: string;
    FNodeToMonitor: TTreeNode;
    FShowExtension: TacShowExtension;
    function FolderExists(FindID: PItemIDList; InNode: TTreeNode): TTreeNode;
    function GetFolder(Index: Integer): TacShellFolder;
    function GetPath: string;
    procedure SetComboBox(Value: TacCustomShellComboBox);
    procedure SetListView(const Value: TacCustomShellListView);
    procedure SetPath(const Value: string);
    procedure SetPathFromID(ID: PItemIDList);
    procedure SetRoot(const Value: TacRoot);
    procedure SetUseShellImages(const Value: Boolean);
    procedure SetAutoRefresh(const Value: boolean);
    function GetUpdating: boolean;
  protected
    function CanChange(Node: TTreeNode): Boolean; override;
    function CanExpand(Node: TTreeNode): Boolean; override;
    procedure CreateRoot;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
    procedure Edit(const Item: TTVItem); override;
    procedure GetImageIndex(Node: TTreeNode); override;
    procedure GetSelectedIndex(Node: TTreeNode); override;
    procedure InitNode(NewNode: TTreeNode; ID: PItemIDList; ParentNode: TTreeNode);
    procedure Loaded; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Delete(Node: TTreeNode); override;
    //! procedure NodeDeleted(Sender: TObject; Node: TTreeNode);
    function NodeFromAbsoluteID(StartNode: TTreeNode; ID: PItemIDList): TTreeNode;
    function NodeFromRelativeID(ParentNode: TTreeNode; ID: PItemIDList): TTreeNode;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PopulateNode(Node: TTreeNode);
    procedure RootChanged;
    procedure SetObjectTypes(Value: TacShellObjectTypes); virtual;
    procedure WMDestroy(var Message: TWMDestroy); virtual;
    procedure WndProc(var Message: TMessage); override;
    procedure ClearItems;
    procedure RefreshEvent;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Refresh(Node: TTreeNode);
    function SelectedFolder: TacShellFolder;
    property AutoRefresh: boolean read FAutoRefresh write SetAutoRefresh;
    property Folders[Index: Integer]: TacShellFolder read GetFolder; default;
    property Items;
    property Path: TsDirectory read GetPath write SetPath;
    property AutoContextMenus: Boolean read FAutoContext write FAutoContext default True;
    property ObjectTypes: TacShellObjectTypes read FObjectTypes write SetObjectTypes;
    property Root: TacRoot read FRoot write SetRoot;
    property ShellComboBox: TacCustomShellComboBox read FComboBox write SetComboBox;
    property ShellListView: TacCustomShellListView read FListView write SetListView;
    property UseShellImages: Boolean read FUseShellImages write SetUseShellImages;
    property Updating : boolean read GetUpdating; 
    //Lexa
    property ShowExt: TacShowExtension read FShowExtension write FShowExtension;
    property OnAddFolder: TacAddFolderEvent read FOnAddFolder write FOnAddFolder;
    procedure CommandCompleted(Verb: String; Succeeded: Boolean);
    procedure ExecuteCommand(Verb: String; var Handled: Boolean);
  end;
{$ENDIF} // NOTFORHELP

{ TsShellTreeView }

  TsShellTreeView = class(TacCustomShellTreeView)
  published
{$IFNDEF NOTFORHELP}
    {:@event}
    property OnAddFolder;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnChanging;
    property OnChange;
    property OnExpanding;
    property OnCollapsing;
    property OnCollapsed;
    property OnExpanded;
    property OnEditing;
    property OnEdited;

    property Align;
    property Anchors;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Cursor;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property Images;
    property Indent;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RightClickSelect default True;
    property ShowButtons;
    property ShowHint;
    property ShowLines;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property ChangeDelay;
    property ShowRoot;
    property StateImages;
{$ENDIF} // NOTFORHELP
    property AutoContextMenus;
    property ObjectTypes;
    property Root;
    property ShellComboBox;
    property ShellListView;
    property UseShellImages;
    property AutoRefresh;
    property ShowExt;
  end;

{ TacCustomShellComboBox }

{$IFNDEF NOTFORHELP}
  TacCustomShellComboBox = class(TsComboBoxEx)
  private
    FImagesHandle, FImageHeight, FImageWidth: Integer;
    FImageList: TCustomImageList;
    FOldRoot : TacRoot;
    FRoot: TacRoot;
    FRootFolder: TacShellFolder;
    FTreeView: TacCustomShellTreeView;
    FListView: TacCustomShellListView;
    FObjectTypes: TacShellObjectTypes;
    FUseShellImages, FUpdating: Boolean;
    FOnGetImageIndex: TacGetImageIndexEvent;
    procedure ClearItems;
    function GetFolder(Index: Integer): TacShellFolder;
    function GetPath: string;
    procedure SetPath(const Value: string);
    procedure SetPathFromID(ID: PItemIDList);
    procedure SetRoot(const Value: TacRoot);
    procedure SetTreeView(Value: TacCustomShellTreeView);
    procedure SetListView(Value: TacCustomShellListView);
    procedure SetUseShellImages(const Value: Boolean);
    function GetShellImageIndex(AFolder: TacShellFolder): integer;
    function GetUpdating: boolean;
  protected
    procedure AddItems(Index: Integer; ParentFolder: TacShellFolder);
    procedure Click; override;
    procedure CreateRoot;
    procedure DestroyWnd; override;
    procedure Init; virtual;
    function InitItem(ParentFolder: TacShellFolder; ID: PItemIDList): TacShellFolder;
    procedure RootChanged;
    procedure TreeUpdate(NewPath: PItemIDList);
    procedure SetObjectTypes(Value: TacShellObjectTypes); virtual;
  public
    ExtUpdating : boolean;
    constructor Create(AOwner: TComponent); override;
    procedure Change; override;
    procedure CreateWnd; override;
    function IndexFromID(AbsoluteID: PItemIDList): Integer;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure WndProc(var Message: TMessage); override;
    property Items;
    property Path: string read GetPath write SetPath;
    property Folders[Index: Integer]: TacShellFolder read GetFolder;
    property Root: TacRoot read FRoot write SetRoot;
    property ObjectTypes: TacShellObjectTypes read FObjectTypes write SetObjectTypes;
    property ShellTreeView: TacCustomShellTreeView read FTreeView write SetTreeView;
    property ShellListView: TacCustomShellListView read FListView write SetListView;
    property Updating : boolean read GetUpdating;
    property UseShellImages: Boolean read FUseShellImages write SetUseShellImages default True;
    property OnGetImageIndex: TacGetImageIndexEvent read FOnGetImageIndex write FOnGetImageIndex;
  end;
{$ENDIF} // NOTFORHELP

{ TsShellComboBox }

  TsShellComboBox = class(TacCustomShellComboBox)
  public
    property Path;
  published
{$IFNDEF NOTFORHELP}
    {:@event}
    property OnGetImageIndex;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDock;
    property OnStartDrag;

    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;