cxshellcommon.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,198 行 · 第 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 cxShellCommon;

{$I cxVer.inc}

interface

uses
{$IFNDEF DELPHI6}
  Mask,
{$ELSE}
  MaskUtils,
{$ENDIF}
  Windows, ActiveX, Classes, ComObj, Controls, Dialogs, Forms, Math, Messages,
  ShellApi, ShlObj, SyncObjs, SysUtils;

resourcestring
  SShellDefaultNameStr = 'Name';
  SShellDefaultSizeStr = 'Size';
  SShellDefaultTypeStr = 'Type';
  SShellDefaultModifiedStr = 'Modified';

const
  cxShellObjectInternalAbsoluteVirtualPathPrefix = '::{9C211B58-E6F1-456A-9F22-7B3B418A7BB1}';
  cxShellObjectInternalRelativeVirtualPathPrefix = '::{63BE9ADB-E4B5-4623-96AA-57440B4EF5A8}';
  cxShellObjectInternalVirtualPathPrefixLength = 40;

  cxSFGAO_GHOSTED = $00008000; // Error in ShlObj.pas 

  {$IFNDEF DELPHI6}
  SID_IShellFolder2  = '{93F2F68C-1D1B-11D3-A30E-00C04F79ABD1}';
  SID_IEnumExtraSearch   = '{0E700BE1-9DB6-11D1-A1CE-00C04FD75D13}';
  SID_IShellDetails      = '{000214EC-0000-0000-C000-000000000046}';

  {IShellFolder2.GetDefaultColumnState Values}
  SHCOLSTATE_TYPE_STR     = $00000001;
  SHCOLSTATE_TYPE_INT     = $00000002;
  SHCOLSTATE_TYPE_DATE    = $00000003;
  SHCOLSTATE_TYPEMASK     = $0000000F;
  SHCOLSTATE_ONBYDEFAULT  = $00000010;   // should on by default in details view
  SHCOLSTATE_SLOW         = $00000020;   // will be slow to compute; do on a background thread
  SHCOLSTATE_EXTENDED     = $00000040;   // provided by a handler; not the folder
  SHCOLSTATE_SECONDARYUI  = $00000080;   // not displayed in context menu; but listed in the "More..." dialog
  SHCOLSTATE_HIDDEN       = $00000100;   // not displayed in the UI

  {$EXTERNALSYM IID_IShellDetails}
  IID_IShellDetails: TGUID = (
    D1:$000214EC; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  {$ENDIF}

// Interface declarations, that missed in D4 and D5 versions

{$IFDEF BCB}
(*$HPPEMIT '#include <OleIdl.h>'*)
  {$IFNDEF DELPHI6}
(*$HPPEMIT '#if !defined(NO_WIN32_LEAN_AND_MEAN)'*)
(*$HPPEMIT 'typedef struct _STRRET'*)
(*$HPPEMIT '{'*)
(*$HPPEMIT '  UINT uType;'*)
(*$HPPEMIT '  union'*)
(*$HPPEMIT '  {'*)
(*$HPPEMIT '    LPWSTR pOleStr;'*)
(*$HPPEMIT '    LPSTR pStr;'*)
(*$HPPEMIT '    UINT uOffset;'*)
(*$HPPEMIT '    char cStr[MAX_PATH];'*)
(*$HPPEMIT '  } DUMMYUNIONNAME;'*)
(*$HPPEMIT '} STRRET, *LPSTRRET;'*)
(*$HPPEMIT '#endif'*)
  {$ENDIF}
{$ENDIF}

{$IFNDEF DELPHI6}
type
  {$EXTERNALSYM PExtraSearch}
  PExtraSearch = ^TExtraSearch;
  {$EXTERNALSYM tagExtraSearch}
  tagExtraSearch = record
    guidSearch: TGUID;
    wszFriendlyName,
    wszMenuText: array[0..79] of WideChar;
    wszHelpText: array[0..MAX_PATH] of WideChar;
    wszUrl: array[0..2047] of WideChar;
    wszIcon,
    wszGreyIcon,
    wszClrIcon: array[0..MAX_PATH+10] of WideChar;
  end;
  {$EXTERNALSYM TExtraSearch}
  TExtraSearch = tagExtraSearch;

  {$EXTERNALSYM IEnumExtraSearch}
  IEnumExtraSearch = interface
    [SID_IEnumExtraSearch]
    function Next(celt: ULONG; out rgelt: PExtraSearch;
      out pceltFetched: ULONG): HResult; stdcall;
    function Skip(celt: ULONG): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppEnum: IEnumExtraSearch): HResult; stdcall;
  end;

  {$EXTERNALSYM PShColumnID}
  PShColumnID = ^TShColumnID;
  {$EXTERNALSYM SHCOLUMNID}
  SHCOLUMNID = record
    fmtid: TGUID;
    pid: DWORD;
  end;
  {$EXTERNALSYM TShColumnID}
  TShColumnID = SHCOLUMNID;

 { IShellDetails is supported on Win9x and NT4; for >= NT5 use IShellFolder2 }
  _SHELLDETAILS = record
    fmt,
    cxChar: Integer;
    str: STRRET;
  end;
  {$EXTERNALSYM SHELLDETAILS}
  SHELLDETAILS = _SHELLDETAILS;
  TShellDetails = _SHELLDETAILS;
  PShellDetails = ^TShellDetails;

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

  {$EXTERNALSYM IShellFolder2}
  IShellFolder2 = interface(IShellFolder)
    [SID_IShellFolder2]
    function GetDefaultSearchGUID(out pguid: TGUID): HResult; stdcall;
    function EnumSearches(out ppEnum: IEnumExtraSearch): HResult; stdcall;
    function GetDefaultColumn(dwRes: DWORD; var pSort: ULONG;
      var pDisplay: ULONG): HResult; stdcall;
    function GetDefaultColumnState(iColumn: UINT; var pcsFlags: DWORD): HResult; stdcall;
    function GetDetailsEx(pidl: PItemIDList; const pscid: SHCOLUMNID;
      pv: POleVariant): HResult; stdcall;
    function GetDetailsOf(pidl: PItemIDList; iColumn: UINT;
      var psd: TShellDetails): HResult; stdcall;
    function MapNameToSCID(pwszName: LPCWSTR; var pscid: TShColumnID): HResult; stdcall;
  end;
{$ENDIF}

// cxShell common classes
type
  ITEMIDLISTARRAY=array [0..MaxInt div SizeOf(PItemIDList) - 1] of PItemIDList;
  PITEMIDLISTARRAY=^ITEMIDLISTARRAY;

  TcxBrowseFolder=(bfCustomPath, bfAltStartup, bfBitBucket,
           bfCommonDesktopDirectory, bfCommonDocuments,
           bfCommonFavorites, bfCommonPrograms,
           bfCommonStartMenu, bfCommonStartup, bfCommonTemplates, bfControls,
           bfDesktop, bfDesktopDirectory, bfDrives, bfPrinters,
           bfFavorites, bfFonts, bfHistory, bfMyMusic,
           bfMyPictures, bfNetHood, bfProfile, bfProgramFiles, bfPrograms,
           bfRecent, bfStartMenu, bfStartUp, bfTemplates);

  TcxDropEffect=(deCopy, deMove, deLink);
  TcxDropEffectSet=set of TcxDropEffect;

  TcxCustomItemProducer=class;

  IcxDropSource = interface(IDropSource)
  ['{FCCB8EC5-ABB4-4256-B34C-25E3805EA046}']
  end;

  TcxDropSource=class(TInterfacedObject, IcxDropSource)
  private
    FOwner: TWinControl;
  protected
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  public
    constructor Create(AOwner:TWinControl);virtual;
    property Owner:TWinControl read FOwner;
  end;

  { TcxShellOptions }

  TcxShellOptions=class(TPersistent)
  private
    FContextMenus: Boolean;
    FOwner: TWinControl;
    FShowFolders: Boolean;
    FShowToolTip: Boolean;
    FShowNonFolders: Boolean;
    FShowHidden: Boolean;
    FTrackShellChanges: Boolean;
    FOnShowToolTipChanged: TNotifyEvent;
    procedure SetShowFolders(Value: Boolean);
    procedure SetShowHidden(Value: Boolean);
    procedure SetShowNonFolders(Value: Boolean);
    procedure SetShowToolTip(Value: Boolean);
    procedure NotifyUpdateContents;
  protected
    property OnShowToolTipChanged: TNotifyEvent read FOnShowToolTipChanged
      write FOnShowToolTipChanged;
  public
    constructor Create(AOwner: TWinControl); virtual;
    procedure Assign(Source: TPersistent); override;
    function GetEnumFlags:Cardinal;
    property Owner:TWinControl read FOwner;
  published
    property ShowFolders:Boolean read FShowFolders write SetShowFolders default True;
    property ShowNonFolders:Boolean read FShowNonFolders write SetShowNonFolders default True;
    property ShowHidden:Boolean read FShowHidden write SetShowHidden default False;
    property ContextMenus:Boolean read FContextMenus write FContextMenus default True;
    property TrackShellChanges:Boolean read FTrackShellChanges write FTrackShellChanges default True;
    property ShowToolTip: Boolean read FShowToolTip write SetShowToolTip default True;
  end;

  TcxDetailItem=record
    Text:String;
    Width:Integer;
    Alignment:TAlignment;
    ID:Integer;
  end;

  TcxRequestItem = record
    ItemIndex: Integer;
    ItemProducer: TcxCustomItemProducer;
    Priority: Boolean;
  end;

  PcxRequestItem=^TcxRequestItem;

  PcxDetailItem=^TcxDetailItem;

  TcxShellDetails=class
  private
    FItems: TList;
    function GetItems(Index: Integer): PcxDetailItem;
    function GetCount: Integer;
  protected
    property Items:TList read FItems;
  public
    constructor Create;
    destructor Destroy;override;
    procedure ProcessDetails(ACharWidth: Integer; AShellFolder: IShellFolder;
      AFileSystem: Boolean);
    procedure Clear;
    function Add:PcxDetailItem;
    procedure Remove(Item:PcxDetailItem);
    property Item[Index:Integer]:PcxDetailItem read GetItems;default;
    property Count:Integer read GetCount;
  end;

  { TcxShellFolder }

  TcxShellFolderAttribute = (sfaGhosted, sfaHidden, sfaIsSlow, sfaLink,
    sfaReadOnly, sfaShare);
  TcxShellFolderAttributes = set of TcxShellFolderAttribute;

  TcxShellFolderCapability = (sfcCanCopy, sfcCanDelete, sfcCanLink, sfcCanMove,
    sfcCanRename, sfcDropTarget, sfcHasPropSheet);
  TcxShellFolderCapabilities = set of TcxShellFolderCapability;

  TcxShellFolderProperty = (sfpBrowsable, sfpCompressed, sfpEncrypted,
    sfpNewContent, sfpNonEnumerated, sfpRemovable);
  TcxShellFolderProperties = set of TcxShellFolderProperty;

  TcxShellFolderStorageCapability = (sfscFileSysAncestor, sfscFileSystem,
    sfscFolder, sfscLink, sfscReadOnly, sfscStorage, sfscStorageAncestor,
    sfscStream);
  TcxShellFolderStorageCapabilities = set of TcxShellFolderStorageCapability;

  TcxShellFolder = class
  private
    FAbsolutePIDL: PItemIDList;
    FParentShellFolder: IShellFolder;
    FRelativePIDL: PItemIDList;
    function GetAttributes: TcxShellFolderAttributes;
    function GetCapabilities: TcxShellFolderCapabilities;
    function GetDisplayName: string;
    function GetIsFolder: Boolean;
    function GetPathName: string;
    function GetProperties: TcxShellFolderProperties;
    function GetShellAttributes(ARequestedAttributes: LongWord): LongWord;
    function GetShellFolder: IShellFolder;
    function GetStorageCapabilities: TcxShellFolderStorageCapabilities;
    function GetSubFolders: Boolean;
    function HasShellAttribute(AAttribute: LongWord): Boolean; overload;
    function HasShellAttribute(AAttributes, AAttribute: LongWord): Boolean; overload;
    function InternalGetDisplayName(AFolder: IShellFolder; APIDL: PItemIDList;
      ANameType: DWORD): string;
  public
    constructor Create(AAbsolutePIDL: PItemIDList);
    destructor Destroy; override;

    property Attributes: TcxShellFolderAttributes read GetAttributes;
    property Capabilities: TcxShellFolderCapabilities read GetCapabilities;
    property IsFolder: Boolean read GetIsFolder;
    property Properties: TcxShellFolderProperties read GetProperties;
    property StorageCapabilities: TcxShellFolderStorageCapabilities
      read GetStorageCapabilities;
    property SubFolders: Boolean read GetSubFolders;

    property AbsolutePIDL: PItemIDList read FAbsolutePIDL;
    property DisplayName: string read GetDisplayName;
    property ParentShellFolder: IShellFolder read FParentShellFolder;
    property PathName: string read GetPathName;
    property RelativePIDL: PItemIDList read FRelativePIDL;
    property ShellFolder: IShellFolder read GetShellFolder;
  end;

  TcxCustomShellRoot=class(TPersistent)
  private
    FAttributes: Cardinal;
    FBrowseFolder: TcxBrowseFolder;
    FCustomPath: WideString;
    FFolder: TcxShellFolder;
    FIsRootChecking: Boolean;
    FOwner: TPersistent;
    FParentWindow: HWND;
    FPidl: PItemIDList;
    FRootChangingCount: Integer;
    FShellFolder: IShellFolder;
    FUpdating: Boolean;
    FValid: Boolean;
    FOnSettingsChanged: TNotifyEvent;
    procedure SetBrowseFolder(Value: TcxBrowseFolder);
    procedure SetCustomPath(const Value: WideString);
    procedure SetPidl(const Value: PItemIDList);
    function GetCurrentPath: WideString;
    procedure UpdateFolder;
  protected
    procedure CheckRoot; virtual;
    procedure DoSettingsChanged;
    procedure RootUpdated; virtual;
    property Owner: TPersistent read FOwner;
    property ParentWindow: HWND read FParentWindow;
  public
    constructor Create(AOwner: TPersistent; AParentWindow: HWND); virtual;
    destructor Destroy;override;
    procedure Assign(Source: TPersistent); override;
    procedure Update(ARoot: TcxCustomShellRoot);
    property Attributes:Cardinal read FAttributes;
    property CurrentPath:WideString read GetCurrentPath;
    property Folder: TcxShellFolder read FFolder;
    property IsValid:Boolean read FValid;
    property Pidl:PItemIDList read FPidl write SetPidl;
    property ShellFolder:IShellFolder read FShellFolder;
    property OnSettingsChanged: TNotifyEvent read FOnSettingsChanged
      write FOnSettingsChanged;
  published
    property BrowseFolder:TcxBrowseFolder read FBrowseFolder
      write SetBrowseFolder default bfDesktop;
    property CustomPath:WideString read FCustomPath write SetCustomPath;
  end;

  TcxRootChangedEvent=procedure (Sender:TObject; Root:TcxCustomShellRoot) of object;

  TcxShellItemInfo=class
  private
    FCanRename: Boolean;
    FDetails: TStrings;
    FFolder: TcxShellFolder;
    FFullPIDL: PItemIDList;
    FHasSubfolder: Boolean;
    FIconIndex: Integer;
    FInfoTip: WideString;
    FInitialized: Boolean;
    FIsDropTarget: Boolean;
    FIsFilesystem: Boolean;
    FIsFolder: Boolean;
    FIsGhosted: Boolean;
    FIsLink: Boolean;
    FIsRemovable: Boolean;
    FIsShare: Boolean;
    FItemProducer: TcxCustomItemProducer;
    FName: WideString;
    FOpenIconIndex: Integer;
    Fpidl: PItemIDList;
    FUpdated: Boolean;
    FUpdating: Boolean;
  protected
    property Updating:Boolean read FUpdating write FUpdating;
  public
    constructor Create(AItemProducer: TcxCustomItemProducer;
      AParentIFolder: IShellFolder; AParentPIDL, APIDL: PItemIDList;
      AFast: Boolean); virtual;
    destructor Destroy;override;
    procedure CheckUpdate(ShellFolder:IShellFolder;FolderPidl:PItemIDList;Fast:Boolean);
    procedure CheckInitialize(AIFolder: IShellFolder; APIDL: PItemIDList);
    procedure FetchDetails(wnd:HWND;ShellFolder:IShellFolder;DetailsMap:TcxShellDetails);
    procedure CheckSubitems(AParentIFolder: IShellFolder;
      AEnumSettings: Cardinal);
    procedure SetNewPidl(pFolder:IShellFolder;FolderPidl,apidl:PItemIDList);
    property CanRename:Boolean read FCanRename;
    property Details:TStrings read FDetails;
    property Folder: TcxShellFolder read FFolder;
    property FullPIDL: PItemIDList read FFullPIDL;
    property HasSubfolder:Boolean read FHasSubfolder;
    property IconIndex:Integer read FIconIndex;
    property InfoTip:WideString read FInfoTip;
    property Initialized:Boolean read FInitialized;
    property IsDropTarget:Boolean read FIsDropTarget;
    property IsFilesystem:Boolean read FIsFilesystem;
    property IsFolder:Boolean read FIsFolder;
    property IsGhosted:Boolean read FIsGhosted;
    property IsLink:Boolean read FIsLink;
    property IsRemovable:Boolean read FIsRemovable;
    property IsShare:Boolean read FIsShare;
    property ItemProducer: TcxCustomItemProducer read FItemProducer;
    property Name:WideString read FName;