browsedr.~pas

browsedr,一个自己编写的小控件,适合DELPHI5下用

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{-----------------------------------------------------------------------------}
{ TBrowseDirectoryDlg v2.54                                                   }
{-----------------------------------------------------------------------------}
{ A component to encapsulate the Win95 style directory selection dialog       }
{ SHBrowseForFolder().                                                        }
{ Copyright 1996, Brad Stowers.  All Rights Reserved.                         }
{ This component can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way and there is   }
{ no charge for it other than nomial handling fees.  Contact me directly for  }
{ modifications to this agreement.                                            }
{-----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions  }
{ at [e-mail].                                                      }
{ The lateset version will always be available on the web at:                 }
{   http://www.pobox.com/~bstowers/delphi/                                    }
{ See BrowseDr.txt for notes, known issues, and revision history.             }
{-----------------------------------------------------------------------------}
{ Date last modified:  October 29, 1998                                       }
{-----------------------------------------------------------------------------}


{: This unit provides a component that displays a standard Windows 95/NT 4...
   dialog containing the user's system in a heirarchial manner and allows a...
   selection to be made.  It is a wrapper for the SHBrowseForFolder() API,...
   which is quite messy to use directly.  Also provided is an editor which...
   allows you to display the dialog at design time with the selected options.

   Note:
   This component Requires Delphi 3 or Delphi v2.01's ShlObj unit.  If you...
   have Delphi 2.00, you can get the equivalent using Pat Ritchey's ShellObj...
   unit.  It is freely available on his web site at...
   http://ourworld.compuserve.com/homepages/PRitchey/.  Both Borland's ShlObj...
   unit and Pat's ShellObj unit contain errors that should be fixed.  I have...
   included instructions on how to do this.  They are in the included...
   ShellFix.txt file.  Delphi 3's ShlObj unit does not have any errors that I...
   am currently aware of.
}


unit BrowseDr;

{$IFNDEF DFS_WIN32}
  ERROR!  Only available for Win32!
{$ENDIF}

interface

uses
  Windows, Dialogs, ActiveX, ShlObj,
  DFSAbout, Controls, Classes;

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TBrowseDirectoryDlg v2.54';

  {: This is a newly documented folder identifier that is not in the Delphi...
     units yet.  You can use it with any of the Win32 Shell API functions...
      that wants a CSIDL_* identifier such as SHGetSpecialFolderLocation. }

  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM CSIDL_INTERNET}
  {$ENDIF}
  CSIDL_INTERNET         = $0001;
{$IFNDEF DFS_COMPILER_3}
  { IDs that exist in Delphi/C++B 3 ShlObj.pas unit, but not Delphi 2. }
  CSIDL_COMMON_STARTMENU              = $0016;
  CSIDL_COMMON_PROGRAMS               = $0017;
  CSIDL_COMMON_STARTUP                = $0018;
  CSIDL_COMMON_DESKTOPDIRECTORY       = $0019;
  CSIDL_APPDATA                       = $001a;
  CSIDL_PRINTHOOD                     = $001b;
{$ENDIF}

  {: This folder identifer is undocumented, but should work for a long time...
     since the highest ID is currently around 30 or so.  It is used to open...
     the tree already expanded with the desktop as the root item. }
  CSIDL_DESKTOPEXPANDED  = $FEFE;
{$IFNDEF DFS_COMPILER_3_UP}
  {: This constant was missing from the Delphi 2 units, but was added to...
     Delphi 3.  It causes files to be included in the tree as well as folders. }
  BIF_BROWSEINCLUDEFILES = $4000;
{$ENDIF}

{$IFNDEF DFS_COMPILER_4_UP}
  {: These constants are new to v4.71 of COMCTL32.DLL.  Delphi 4 defines them...
     but the are missing in all previous versions. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM BIF_EDITBOX}
  {$ENDIF}
  BIF_EDITBOX            = $0010;
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM BIF_VALIDATE}
  {$ENDIF}
  BIF_VALIDATE           = $0020;  { insist on valid result (or CANCEL) }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM BFFM_VALIDATEFAILED}
  {$ENDIF}
  BFFM_VALIDATEFAILED    = 3;      { lParam:szPath ret:1(cont),0(EndDialog) }
{$ENDIF}

type
  {: This enumerated type is the equivalent of the CSIDL_* constants in the...
     Win32 API. They are used to specify the root of the heirarchy tree.

    idDesktop: Windows desktop -- virtual folder at the root of the name space.
    idInternet: Internet Explorer -- virtual folder of the Internet Explorer.
    idPrograms: File system directory that contains the user's program groups...
       (which are also file system directories).
    idControlPanel: Control Panel -- virtual folder containing icons for the...
       control panel applications.
    idPrinters: Printers folder -- virtual folder containing installed printers.
    idPersonal: File system directory that serves as a common respository for...
       documents.
    idFavorites: Favorites folder -- virtual folder containing the user's...'
       Internet Explorer bookmark items and subfolders.
    idStartup: File system directory that corresponds to the user's Startup...
       program group.
    idRecent: File system directory that contains the user's most recently...
       used documents.
    idSendTo: File system directory that contains Send To menu items.
    idRecycleBin: Recycle bin -- file system directory containing file...
       objects in the user's recycle bin. The location of this directory is...
       not in the registry; it is marked with the hidden and system...
       attributes to prevent the user from moving or deleting it.
    idStartMenu: File system directory containing Start menu items.
    idDesktopDirectory: File system directory used to physically store file...
       objects on the desktop (not to be confused with the desktop folder itself).
    idDrives: My Computer -- virtual folder containing everything on the...
       local computer: storage devices, printers, and Control Panel. The...
       folder may also contain mapped network drives.
    idNetwork: Network Neighborhood -- virtual folder representing the top...
       level of the network hierarchy.
    idNetHood: File system directory containing objects that appear in the...
       network neighborhood.
    idFonts: Virtual folder containing fonts.
    idTemplates: File system directory that serves as a common repository for...
       document templates.
    idCommonStartMenu: File system directory that contains the programs and...
       folders that appear on the Start menu for all users on Windows NT.
    idCommonPrograms: File system directory that contains the directories for...
       the common program groups that appear on the Start menu for all users...
       on Windows NT.
    idCommonStartup: File system directory that contains the programs that...
       appear in the Startup folder for all users. The system starts these...
       programs whenever any user logs on to Windows NT.
    idCommonDesktopDirectory: File system directory that contains files and...
       folders that appear on the desktop for all users on Windows NT.
    idAppData: File system directory that contains data common to all...
       applications.
    idPrintHood: File system directory containing object that appear in the...
       printers folder.
    idDesktopExpanded: Same as idDesktop except that the root item is already...
       expanded when the dialog is initally displayed.

    NOTE: idCommonStartMenu, idCommonPrograms, idCommonStartup, and...
       idCommonDesktopDirectory only have effect when the dialog is being...
       displayed on an NT system.  On Windows 95, these values will be...
       mapped to thier "non-common" equivalents, i.e. idCommonPrograms will...
       become idPrograms.
  }

  TRootID = (
    idDesktop, idInternet, idPrograms, idControlPanel, idPrinters, idPersonal,
    idFavorites, idStartup, idRecent, idSendTo, idRecycleBin, idStartMenu,
    idDesktopDirectory, idDrives, idNetwork, idNetHood, idFonts, idTemplates,
    idCommonStartMenu, idCommonPrograms, idCommonStartup,
    idCommonDesktopDirectory, idAppData, idPrintHood, idDesktopExpanded
   );

  {: These are equivalent to the BIF_* constants in the Win32 API.  They are...
     used to specify what items can be expanded, and what items can be...
     selected by combining them in a set in the Options property.

     bfDirectoriesOnly: Only returns file system directories. If the user...
        selects folders that are not part of the file system, the OK button...
        is grayed.
     bfDomainOnly: Does not include network folders below the domain level...
        in the dialog.
     bfAncestors: Only returns file system ancestors (items which contain...
        files, like drives).  If the user selects anything other than a file...
        system ancestor, the OK button is grayed.
     bfComputers: Shows other computers.  If anything other than a computer...
        is selected, the OK button is disabled.
     bfPrinters:	Shows all printers.  If anything other than a printers is...
        selected, the OK button is disabled.
     bfIncludeFiles: Show non-folder items that exist in the folders.
     bfEditBox:   Includes an edit control in which the user can type the ...
        of an item.  Requires v4.71 of COMCTL32.DLL.
  }
  TBrowseFlag = (
    bfDirectoriesOnly, bfDomainOnly, bfAncestors, bfComputers, bfPrinters,
    bfIncludeFiles, bfEditBox
   );

  {: A set of TBrowseFlag items. }
  TBrowseFlags = set of TBrowseFlag;

  { TBDSelChangedEvent is used for events associated with...
    TBrowseDirectoryDlg's OnSelChanged event.

    The Sender parameter is the TBrowseDirectoryDlg object whose event handler...
    is called.  The NewSel parameter is the text representation of the new...
    selection.  The NewSelPIDL is the new PItemIDList representation of the...
    new selection. }
  TBDSelChangedEvent = procedure(Sender: TObject; NewSel: string;
     NewSelPIDL: PItemIDList) of object;

  TBDValidateFailedEvent = procedure(Sender: TObject; Path: string;
     var Cancel: boolean) of object;
     
type
  {: TBrowseDirectoryDlg provides a component that displays a standard...
     Windows 95/NT 4 dialog containing the user's system in a heirarchial...
     manner and allows a selection to be made.  It is a wrapper for the...
     SHBrowseForFolder() API, which is quite messy to use directly. }
  TBrowseDirectoryDlg = class(TComponent)
  private
    { Internal variables }
    FDlgWnd: HWND;
    { Property variables }
    FCaption: string;
    FParent: TWinControl;
    FShowSelectionInStatus: boolean;
    FFitStatusText: boolean;
    FTitle: string;
    FRoot: TRootID;
    FOptions: TBrowseFlags;
    FSelection: string;
    FCenter: boolean;
    FStatusText: string;
    FEnableOKButton: boolean;
    FImageIndex: integer;
    FSelChanged: TBDSelChangedEvent;
    FOnCreate: TNotifyEvent;
		FSelectionPIDL: PItemIDList;
    FShellMalloc: IMalloc;
    FDisplayName: string;
    FOnValidateFailed: TBDValidateFailedEvent;

		function GetDisplayName: string;
  protected
    // internal methods
    function FittedStatusText: string;
    procedure SendSelectionMessage;
    // internal event methods.
    procedure DoInitialized(Wnd: HWND); virtual;
    procedure DoSelChanged(Wnd: HWND; Item: PItemIDList); virtual;
    procedure DoValidateFailed(Path: string; var Cancel: boolean); virtual;
    // property methods
    procedure SetFitStatusText(Val: boolean);
    procedure SetStatusText(const Val: string);
    procedure SetSelection(const Val: string);
		procedure SetSelectionPIDL(Value: PItemIDList);
    procedure SetEnableOKButton(Val: boolean);
    function GetCaption: string;
    procedure SetCaption(const Val: string);
    procedure SetParent(AParent: TWinControl);
    function GetVersion: TDFSVersion;
    procedure SetVersion(const Val: TDFSVersion);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {: Displays the browser folders dialog.  It returns TRUE if user selected...
       an item and pressed OK, otherwise it returns FALSE. }
    function Execute: boolean; virtual;

    {: The window component that is the browse dialog's parent window.  By...
       assigning a value to this property, you can control the parent window...
       independant of the form that the component exists on.

       You do not normally need to assign any value to this property as it...
       will use the form that contains the component by default. }
    property Parent: TWinControl
       read FParent
       write SetParent;
    {: An alternative to the Selection property.  Use this property if the...
       item you are interested in does not have a path (Control Panels, for...
       example).  The most common way to retrieve a value for this property...
       is to use the SHGetSpecialFolderLocation Windows API function. Once...
       you have assigned a value to this property, it is "owned" by the...
       component.  That is, the component will take care of freeing it when...
       it is no longer needed.

       When setting this property before calling the Execute method, it will...
       only be used if the Selection property is blank.  If Selection is not...
       blank, it will be used instead.

       Upon return from the Execute method, this property will contain the...
       PItemIDList of the item the user selected.  In some cases, this will...
       the only way to get the user's choice since items such as Control...
       Panel do not have a string that can be placed in the Selection property.}
		property SelectionPIDL: PItemIDList
       read FSelectionPIDL
       write SetSelectionPIDL;
    {: DisplayName is run-time, read-only property that returns the display...
       name of the selection.  It only has meaning after the dialog has been...
       executed and the user has made a selection.  It returns the "human...
       readable" form of the selection.  This generally is the same as the...
       Selection property when it is a file path, but in the case of items...
       such as the Control Panel which do not have a path, Selection is blank.
       In this case, the only way to access the users' selection is to use...
       the SelectionPIDL property.  That doesn't provide an easy way of...
       presenting a textual representation of what they chose, but this...
       property will do that for you.