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

{------------------------------------------------------------------------------}
{ TdfsBrowseDirectoryDlg v2.62                                                 }
{------------------------------------------------------------------------------}
{ A component to encapsulate the Win32 style directory selection dialog        }
{ SHBrowseForFolder().                                                         }
{                                                                              }
{ Copyright 1999-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TdfsColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive and address all problems that are reported to me, you must           }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See BrowseDr.txt for notes, known issues, and revision history.              }
{------------------------------------------------------------------------------}
{ Date last modified:  June 27, 2001                                           }
{------------------------------------------------------------------------------}


{: 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,
  {$IFDEF DFS_COMPILER_3_UP}
  ActiveX,
  {$ELSE}
  OLE2,
  {$ENDIF}
  {$IFDEF DFS_USEDEFSHLOBJ}
  ShlObj, { Delphi 3 fixes all of 2.01's bugs! }
  {$ELSE}
  // If you get a compiler error here, read the included SHELLFIX.TXT file for
  // instructions on creating MyShlObj.pas.
  MyShlObj,
{$ENDIF}
  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 = 'TdfsBrowseDirectoryDlg v2.62';

  {: 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;
  {$IFDEF DFS_COMPILER_2}
  { 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;
  {$IFDEF DFS_COMPILER_2}
  {: 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 SHELL32.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}
  {$IFNDEF DFS_COMPILER_7_UP}
  {$IFDEF DFS_CPPB_3_UP} {EXTERNALSYM BIF_BROWSEINCLUDEURLS} {$ENDIF}
  BIF_BROWSEINCLUDEURLS  = $0080;
  {$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_NEWDIALOGSTYLE} {$ENDIF}
  BIF_NEWDIALOGSTYLE = $0040;
  {$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_SHAREABLE} {$ENDIF}
  BIF_SHAREABLE = $8000;
  {$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_USENEWUI} {$ENDIF}
  BIF_USENEWUI = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
  {$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 SHELL32.DLL.
     bfIncludeURLs: The browse dialog box can display URLs. The bfUseNewUI and
        bfIncludeFiles flags must also be set. If these three flags are not set,
        the browser dialog box will reject URLs. Even when these flags are set,
        the browse dialog box will only display URLs if the folder that contains
        the selected item supports them. When the folder's
        IShellFolder::GetAttributesOf method is called to request the selected
        item's attributes, the folder must set the SFGAO_FOLDER attribute flag.
        Otherwise, the browse dialog box will not display the URL. Requires
        v5.0 of SHELL32.DLL
     bfNewDialogStyle: Use the new user-interface. Setting this flag provides
        the user with a larger dialog box that can be resized. It has several
        new capabilities including: drag and drop capability within the dialog
        box, reordering, context menus, new folders, delete, and other context
        menu commands. Requires v5.0 of SHELL32.DLL
     bfShareable: The browse dialog box can display shareable resources on
        remote systems. It is intended for applications that want to expose
        remote shares on a local system. The bfUseNewUI flag must also be set.
        Requires v5.0 of SHELL32.DLL
     bfUseNewUI: Use the new user-interface including an edit box. This flag is
        equivalent to bfEditBox and bfNewDialogStyle. Requires v5.0 of
        SHELL32.DLL
  }
  TBrowseFlag = (
    bfDirectoriesOnly, bfDomainOnly, bfAncestors, bfComputers, bfPrinters,
    bfIncludeFiles, bfEditBox, bfIncludeURLs, bfNewDialogStyle, bfShareable,
    bfUseNewUI
   );

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

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

    The Sender parameter is the TdfsBrowseDirectoryDlg 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
  {: TdfsBrowseDirectoryDlg 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. }
  TdfsBrowseDirectoryDlg = class(TComponent)
  private
    { Property variables }
    FDlgWnd: HWND;
    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;
    procedure ShowStatusTextLabel;
  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 SetOptions(const Val: TBrowseFlags);
    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: string;
    procedure SetVersion(const Val: string);
  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.

       If, for example, the user chose the Control Panel folder, the Selection...
       property would be blank, but DisplayName would be "Control Panel".  You...
       could not actually use this value to get to the Control Panel, for that...
       you need to use the SelectionPIDL property and various Shell Namespace...
       API functions. }
		property DisplayName: string
       read GetDisplayName;
    {: Handle is a run-time, read-only property that returns the window handle...
       of the browse dialog window.  It is valid only while the dialog is...
       displayed.  That is, it's not valid until the OnCreate event fires, and
       is no longer valid after the Execute method returns. }
    property Handle: HWND
       read FDlgWnd;
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;

    {: The selected item in the browse folder dialog.

       Setting this before calling the Execute method will cause the assigned...
       value to be initially selected when the dialog is initially displayed...
       if the item exists.  If it does not exist, the root item will be selected.

       If this value is blank, the SelectionPIDL item will be used instead.

       After the Execute method returns, you can read this value to determine...
       what item the user selected, unless that item does not have a string...
       representation (Control Panel, for example). }
    property Selection: string
       read FSelection
       write SetSelection;
    {: Specifies the text to appear at the top of the dialog above the tree...
       control.  There is enough room for two lines of text, and it will be...
       word-wrapped for you automatically.

       Generally, this is used to provide user instructions or as a title for
       the StatusText property.

       Example:

       // Title property set to "The current selection is:"
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection
         BrowseDirectoryDlg.StatusText := NewSel;
       end;
    }
    property Title: string
       read FTitle
       write FTitle;
    {: Specifies the item that is to be treated as the root of the tree...
       display.

    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.
    }
    property Root: TRootID
       read FRoot
       write FRoot
       default idDesktop;
    {: Options is a set of TBrowseFlag items that controls what is allowed to...
       be selected and expanded in the tree.  It can be a combination of any...
       (or none) of the following:

     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.  If the user enters an invalid path, the OnValidateFailed...
        event will fire.  Requires v4.71 of SHELL32.DLL.
     bfIncludeURLs: The browse dialog box can display URLs. The bfUseNewUI and
        bfIncludeFiles flags must also be set. If these three flags are not set,
        the browser dialog box will reject URLs. Even when these flags are set,
        the browse dialog box will only display URLs if the folder that contains
        the selected item supports them. When the folder's
        IShellFolder::GetAttributesOf method is called to request the selected
        item's attributes, the folder must set the SFGAO_FOLDER attribute flag.
        Otherwise, the browse dialog box will not display the URL. Requires
        v5.0 of SHELL32.DLL
     bfNewDialogStyle: Use the new user-interface. Setting this flag provides
        the user with a larger dialog box that can be resized. It has several
        new capabilities including: drag and drop capability within the dialog
        box, reordering, context menus, new folders, delete, and other context
        menu commands. Requires v5.0 of SHELL32.DLL
     bfShareable: The browse dialog box can display shareable resources on
        remote systems. It is intended for applications that want to expose
        remote shares on a local system. The bfUseNewUI flag must also be set.
        Requires v5.0 of SHELL32.DLL
     bfUseNewUI: Use the new user-interface including an edit box. This flag is
        equivalent to bfEditBox and bfNewDialogStyle. Requires v5.0 of
        SHELL32.DLL
    }
    property Options: TBrowseFlags
       read FOptions
       write SetOptions
       default [];
    {: Indicates whether the dialog should be centered on the screen or shown...
      in a default, system-determined location. }
    property Center: boolean
       read FCenter
       write FCenter
       default TRUE;
    {: A string that is displayed directly above the tree view control and...
       just under the Title text in the dialog box. This string can be used...
       for any purpose such as to specify instructions to the user, or show...
       the full path of the currently selected item.  You can modify this...
       value while the dialog is displayed from the the OnSelChanged event.

       If StatusText is blank when the Execute method is called, the dialog...
       will not have a status text area and assigning to the StatusText...
       property will have no effect.

       Example:

       // Title property set to "The current selection is:"
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection
         BrowseDirectoryDlg.StatusText := NewSel;
       end;
       }
    property StatusText: string
       read FStatusText
       write SetStatusText;
    {: Indicates whether the StatusText string should be shortened to make it...
       fit in available status text area.  The status text area is only large...
       enough to hold one line of text, and if the text is too long for the...
       available space, it will simply be chopped off.  However, if this...
       property is set to TRUE, the text will be shortened using an ellipsis...
       ("...").

       For example, if the status text property were...
       "C:\Windows\Start Menu\Programs\Applications\Microsoft Reference", it
       could be shortened to...
       "C:\...\Start Menu\Programs\Applications\Microsoft Reference" depending
       on the screen resolution and dialog font size.
    }
    property FitStatusText: boolean
       read FFitStatusText
       write SetFitStatusText
       default TRUE;
    {: This property enables or disables the OK button on the browse folders...
       dialog.  This allows control over whether a selection can be made or...
       not. You can modify this value while the dialog is displayed from the...
       the OnSelChanged event.  This allows you to control whether the user...
       can select an item based on what the current selection is.

       Example:
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection.  Only allow items greater than 10 characters to be selected.
         BrowseDirectoryDlg.EnableOKButton := Length(NewSel > 10);
       end;
    }
    property EnableOKButton: boolean
       read FEnableOKButton
       write SetEnableOKButton
       default TRUE;
    {: After a selection has been made in the dialog, this property will...
       contain the index into the system image list of the selected node. See...
       the demo application for an example how this can be used. }
    property ImageIndex: integer
       read FImageIndex;
    {: Specifies the text in the dialog's caption bar. Use Caption to specify...
       the text that appears in the browse folder dialog's title bar. If no...
       value is assigned to Title, the dialog has a title based on the...
       Options property.

       For example, if bfPrinters was set, the title would be "Browse for...
       Printer". }
    property Caption: string
       read GetCaption
       write SetCaption;
    {: Automatically shows the current selection in the status text area of...
       the dialog.  }
    property ShowSelectionInStatus: boolean
       read FShowSelectionInStatus
       write FShowSelectionInStatus;
    {: The OnSelChange event is fired every time a new item is selected in...
       the tree.

      The Sender parameter is the TdfsBrowseDirectoryDlg 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.

      NOTE:  You will need to add ShlObj to your uses clause if you define...
      a handler for this event. }
    property OnSelChanged: TBDSelChangedEvent
       read FSelChanged
       write FSelChanged;
    { The OnCreate event is fired when dialog has been created, but just...
       before it is displayed to the user. }
    property OnCreate: TNotifyEvent
       read FOnCreate
       write FOnCreate;
    { If the bfEditBox flag is set in the Options property, the user can type...
      a path into the dialog.  If the path entered is invalid, this event...
      will be fired.  This event is not used if bfEditBox is not specified in...
      Options.  Requires v4.71 of SHELL32.DLL. }
    property OnValidateFailed: TBDValidateFailedEvent
       read FOnValidateFailed
       write FOnValidateFailed;
  end;

{ Utility function you may find useful }
function DirExists(const Dir: string): boolean;

implementation

uses
  Forms, SysUtils, Messages, ShellAPI;

// Utility functions used to convert from Delphi set types to API constants.
function ConvertRoot(Root: TRootID): integer;
const
  WinNT_RootValues: array[TRootID] of integer = (
    CSIDL_DESKTOP, CSIDL_INTERNET, CSIDL_PROGRAMS, CSIDL_CONTROLS,
    CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP,
    CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU,
    CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES, CSIDL_NETWORK, CSIDL_NETHOOD,
    CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS,
    CSIDL_COMMON_STARTUP, CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_APPDATA,
    CSIDL_PRINTHOOD, CSIDL_DESKTOPEXPANDED
  );
  Win95_RootValues: array[TRootID] of integer = (
    CSIDL_DESKTOP, CSIDL_INTERNET, CSIDL_PROGRAMS, CSIDL_CONTROLS,
    CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP,
    CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU,
    CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES, CSIDL_NETWORK, CSIDL_NETHOOD,
    CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_STARTMENU, CSIDL_PROGRAMS,
    CSIDL_STARTUP, CSIDL_DESKTOPDIRECTORY, CSIDL_APPDATA, CSIDL_PRINTHOOD,
    CSIDL_DESKTOPEXPANDED
  );
var
  VerInfo: TOSVersionInfo;
begin
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(VerInfo);
  if VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
    Result := WinNT_RootValues[Root]
  else
    Result := Win95_RootValues[Root];
end;

function ConvertFlags(Flags: TBrowseFlags): UINT;
const
  FlagValues: array[TBrowseFlag] of UINT = (
    BIF_RETURNONLYFSDIRS, BIF_DONTGOBELOWDOMAIN, BIF_RETURNFSANCESTORS,
    BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER, BIF_BROWSEINCLUDEFILES,
    BIF_EDITBOX, BIF_BROWSEINCLUDEURLS, BIF_NEWDIALOGSTYLE, BIF_SHAREABLE,
    BIF_USENEWUI
   );
var
  Opt: TBrowseFlag;
begin
  Result := 0;
  { Loop through all possible values }
  for Opt := Low(TBrowseFlag) to High(TBrowseFlag) do
    if Opt in Flags then
      Result := Result OR FlagValues[Opt];
end;

function GetTextWidth(DC: HDC; const Text: String): Integer;
var
  Extent: TSize;
begin
  if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then
    Result := Extent.cX
  else
    Result := 0;
end;

function MinimizeName(Wnd: HWND; const Filename: string): string;

  procedure CutFirstDirectory(var S: string);
  var
    Root: Boolean;
    P: Integer;
  begin
    if S = '\' then
      S := ''
    else begin
      if S[1] = '\' then begin
        Root := True;
        Delete(S, 1, 1);
      end else
        Root := False;
      if S[1] = '.' then
        Delete(S, 1, 4);
      P := Pos('\',S);
      if P <> 0 then begin
        Delete(S, 1, P);
        S := '...\' + S;
      end else
        S := '';
      if Root then
        S := '\' + S;
    end;
  end;

var
  Drive: string;
  Dir: string;
  Name: string;
  R: TRect;
  DC: HDC;
  MaxLen: integer;
  OldFont, Font: HFONT;
begin
  Result := FileName;
  if Wnd = 0 then exit;
  DC := GetDC(Wnd);
  if DC = 0 then exit;
  Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
  OldFont := SelectObject(DC, Font);
  try
    GetWindowRect(Wnd, R);
    MaxLen := R.Right - R.Left;

    Dir := ExtractFilePath(Result);
    Name := ExtractFileName(Result);

    if (Length(Dir) >= 2) and (Dir[2] = ':') then begin
      Drive := Copy(Dir, 1, 2);
      Delete(Dir, 1, 2);
    end else
      Drive := '';
    while ((Dir <> '') or (Drive <> '')) and (GetTextWidth(DC, Result) > MaxLen) do begin
      if Dir = '\...\' then begin
        Drive := '';
        Dir := '...\';
      end else if Dir = '' then
        Drive := ''
      else
        CutFirstDirectory(Dir);
      Result := Drive + Dir + Name;
    end;
  finally
    SelectObject(DC, OldFont);
    ReleaseDC(Wnd, DC);
  end;
end;

function MinimizeString(Wnd: HWND; const Text: string): string;
var
  R: TRect;
  DC: HDC;
  MaxLen: integer;
  OldFont, Font: HFONT;
  TempStr: string;
begin
  Result := Text;
  TempStr := Text;
  if Wnd = 0 then exit;
  DC := GetDC(Wnd);
  if DC = 0 then exit;
  Font := HFONT(SendMessage(Wnd, WM_GETFONT, 0, 0));
  OldFont := SelectObject(DC, Font);
  try
    GetWindowRect(Wnd, R);
    MaxLen := R.Right - R.Left;
    while (TempStr <> '') and (GetTextWidth(DC, Result) > MaxLen) do begin
      SetLength(TempStr, Length(TempStr)-1);
      Result := TempStr + '...';
    end;
  finally
    SelectObject(DC, OldFont);
    ReleaseDC(Wnd, DC);
  end;
end;


function DirExists(const Dir: string): boolean;
  function StripTrailingBackslash(const Dir: string): string;
  begin
    Result := Dir;
    // Make sure we have a string, and if so, see if the last char is a \
    if (Result <> '') and (Result[Length(Result)] = '\') then
      SetLength(Result, Length(Result)-1); // Shorten the length by one to remove
  end;
var
  Tmp: string;
  DriveBits: set of 0..25;
  SR: TSearchRec;
  Found: boolean;
  OldMode: Word;
begin
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if (Length(Dir) = 3) and (Dir[2] = ':') and (Dir[3] = '\') then begin
      Integer(DriveBits) := GetLogicalDrives;
      Tmp := UpperCase(Dir[1]);
      Result := (ord(Tmp[1]) - ord('A')) in DriveBits;
    end else begin
      Found := FindFirst(StripTrailingBackslash(Dir), faDirectory, SR) = 0;
      Result := Found and (Dir <> '');
      if Result then
        Result := (SR.Attr and faDirectory) = faDirectory;
      if Found then
        // only call FinClose if FindFirst succeeds.  Can lock NT up if it didn't
        FindClose(SR);
    end;
  finally
    SetErrorMode(OldMode);
  end;
end; // DirExists

function BrowseCallbackProc(Wnd: HWnd; Msg: UINT; lParam: LPARAM; lData: LPARAM): integer; stdcall;
var
  Cancel: boolean;
begin
  Result := 0;
  if lData <> 0 then
  begin
    case Msg of
      BFFM_INITIALIZED:
        TdfsBrowseDirectoryDlg(lData).DoInitialized(Wnd);
      BFFM_SELCHANGED:
        TdfsBrowseDirectoryDlg(lData).DoSelChanged(Wnd, PItemIDList(lParam));
      BFFM_VALIDATEFAILED:
        begin
          Cancel := FALSE;
          TdfsBrowseDirectoryDlg(lData).DoValidateFailed(string(PChar(lParam)),
             Cancel);
          if Cancel then
            Result := 0
          else
            Result := 1;
        end;
    end;
  end;
end;


(*
function CopyPIDL(ShellMalloc: IMalloc; AnID: PItemIDList): PItemIDList;
var
  Size: integer;
begin
  Size := 0;
  if AnID <> NIL then
  begin
    while AnID.mkid.cb > 0 do
    begin
      Inc(Size, AnID.mkid.cb  + SizeOf(AnID.mkid.cb));
      AnID := PItemIDList(Longint(AnID) + AnID.mkid.cb);
    end;
  end;

  if Size > 0 then
  begin
    Result := ShellMalloc.Alloc(Size); // Create the memory
    FillChar(Result^, Size, #0); // Initialize the memory to zero
    Move(AnID^, Result^, Size); // Copy the current ID
  end else
    Result := NIL;
end;
*)

function GetImageIndex(const AFile: string): integer;
var
  SFI: TSHFileInfo;
begin
  SHGetFileInfo(PChar(AFile), 0, SFI, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX);
  Result := SFI.iIcon;
end;


function BrowseDirectory(const ShellMalloc: IMalloc; var Dest: string;
   var DestPIDL: PItemIDList; var ImgIdx: integer; var DisplayName: string;
   const AParent: TWinControl; const Title: string; Root: TRootID;
   Flags: TBrowseFlags; WantStatusText: boolean; Callback: TFNBFFCallBack;
   Data: Longint): boolean;
var
  shBuff: PChar;
  BrowseInfo: TBrowseInfo;
  idRoot, idBrowse: PItemIDList;
  WndHandle: HWND;
  OldErrorMode: word;
begin
  Result := FALSE; // Assume the worst.
  Dest := ''; // Clear it out.
  SetLength(Dest, MAX_PATH);  // Make sure their will be enough room in dest.
  if assigned(AParent) then
    WndHandle := AParent.Handle
  else
    WndHandle := 0;
  shBuff := PChar(ShellMalloc.Alloc(MAX_PATH)); // Shell allocate buffer.
  if assigned(shBuff) then begin
    CoInitialize(NIL);
    try
      // Get id for desired root item.
      SHGetSpecialFolderLocation(WndHandle, ConvertRoot(Root), idRoot);
      try
        with BrowseInfo do begin  // Fill info structure
          hwndOwner := WndHandle;
          pidlRoot := idRoot;
          pszDisplayName := shBuff;
          lpszTitle := PChar(Title);
          ulFlags := ConvertFlags(Flags);
          { See if we need to handle the validate event }
          if bfEditBox in Flags then
            ulFlags := ulFlags or BIF_VALIDATE;
          if WantStatusText then
            ulFlags := ulFlags or BIF_STATUSTEXT;
          lpfn := Callback;
          lParam := Data;
        end;
        OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        try
          idBrowse := SHBrowseForFolder(BrowseInfo);
        finally
          SetErrorMode(OldErrorMode);
        end;
        DestPIDL := idBrowse;
        if assigned(idBrowse) then begin
          // Try to turn it into a real path.
          if (bfComputers in Flags) then
          begin
            { Make a copy because SHGetPathFromIDList will whack it }
            Dest:= '\\' + string(shBuff);
            Result := SHGetPathFromIDList(idBrowse, shBuff);
            { Is it a valid path? }
            if Result then
              Dest := shBuff // Put it in user's variable.
            else
              { do nothing, the copy we made above is set to go };
            Result:= True;
          end else begin
            Result := SHGetPathFromIDList(idBrowse, shBuff);
            Dest := shBuff; // Put it in user's variable.
          end;
          // Stupid thing won't return the index if the user typed it in.
          if Result and (BrowseInfo.iImage = -1) then
            ImgIdx := GetImageIndex(Dest)
          else
            ImgIdx := BrowseInfo.iImage; // Update the image index.
        end;
        if not Result then
          Result := DestPIDL <> NIL;
        if Result then
          DisplayName := BrowseInfo.pszDisplayName;
      finally
        ShellMalloc.Free(idRoot); // Clean-up.
      end;
    finally
      ShellMalloc.Free(shBuff); // Clean-up.
      CoUninitialize;
    end;
  end;
end;

constructor TdfsBrowseDirectoryDlg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDisplayName := '';
  FDlgWnd := 0;
  FFitStatusText := TRUE;
  FEnableOKButton := TRUE;
  FTitle := '';
  FRoot := idDesktop;
  FOptions := [];
  FSelection := '';
  FSelectionPIDL := NIL;
  FCenter := TRUE;
  FSelChanged := NIL;
  FStatusText := '';
  FImageIndex := -1;
  FCaption := '';
  SHGetMalloc(FShellMalloc);

  if assigned(AOwner) then
    if AOwner is TWinControl then
      FParent := TWinControl(Owner)
    else if assigned(Application) and assigned(Application.MainForm) then
      FParent := Application.MainForm;
end;

destructor TdfsBrowseDirectoryDlg.Destroy;
begin
  if assigned(FSelectionPIDL) then
    FShellMalloc.Free(FSelectionPIDL);
  // D3 cleans it up for you, D2 does not.
  {$IFNDEF DFS_NO_COM_CLEANUP} FShellMalloc.Release; {$ENDIF}

  inherited Destroy;
end;

function TdfsBrowseDirectoryDlg.Execute: boolean;
var
  S: string;
  AParent: TWinControl;
  TempPIDL: PItemIDList;
begin
  FDisplayName := '';
  { Assume the worst }
  AParent := NIL;
  if not (csDesigning in ComponentState) then
    { Determine who the parent is. }
    if assigned(FParent) then
      AParent := FParent
    else begin
      if assigned(Owner) then
        if Owner is TWinControl then
          AParent := TWinControl(Owner)
        else
          if assigned(Application) and assigned(Application.MainForm) then
            AParent := Application.MainForm;
    end;

  { Call the function }
  Result := BrowseDirectory(FShellMalloc, S, TempPIDL, FImageIndex,
     FDisplayName, AParent, FTitle, FRoot, FOptions,
     (FStatusText <> '') or FShowSelectionInStatus, BrowseCallbackProc,
     LongInt(Self));

  FDlgWnd := 0; { Not valid any more. }

  { If selection made, update property }
  if Result then
  begin
    FSelection := S;
    SelectionPIDL := TempPIDL;
  end else begin
    FSelection := '';
    SelectionPIDL := NIL;
  end;
end;

function FormatSelection(const APath: string): string;
begin
  Result := APath;
  if Result <> '' then begin
    if (Length(Result) < 4) and (Result[2] = ':') then begin
      if Length(Result) = 2 then
        Result := Result + '\'
    end else
      if (Result[Length(Result)] = '\') and (Result <> '\') then
        SetLength(Result, Length(Result)-1);
  end;
end;

procedure TdfsBrowseDirectoryDlg.SendSelectionMessage;
var
  TempSelectionPIDL: PItemIDList;
  ShellFolder: IShellFolder;
  OLEStr: array[0..MAX_PATH] of TOLEChar;
  Eaten: ULONG;
  Attr: ULONG;
  shBuff: PChar;
begin
  if (FSelection = '') and assigned(FSelectionPIDL) then
  begin
    shBuff := PChar(FShellMalloc.Alloc(MAX_PATH)); // Shell allocate buffer.
    try
      if SHGetPathFromIDList(FSelectionPIDL, shBuff) then
        FSelection := shBuff
      else
        FSelection := '';
    finally
      FShellMalloc.Free(shBuff); // Clean-up.
    end;
    SendMessage(FDlgWnd, BFFM_SETSELECTION, 0, LPARAM(FSelectionPIDL));
  end else begin
    if Copy(FSelection, 1, 2) = '\\' then // UNC name!
    begin
      if SHGetDesktopFolder(ShellFolder) = NO_ERROR then
      begin
        try
          if ShellFolder.ParseDisplayName(FDlgWnd, NIL,
             StringToWideChar(FSelection, OLEStr, MAX_PATH), Eaten,
             TempSelectionPIDL, Attr) = NO_ERROR then
          begin
            SelectionPIDL := TempSelectionPIDL;
            SendMessage(FDlgWnd, BFFM_SETSELECTION, 0, LPARAM(FSelectionPIDL));
          end;
        finally
          {$IFNDEF DFS_NO_COM_CLEANUP} ShellFolder.Release; {$ENDIF}
        end;
      end;
    end else begin { normal path }
      if SHGetDesktopFolder(ShellFolder) = NO_ERROR then
      begin
        try
          if ShellFolder.ParseDisplayName(FDlgWnd, NIL,
             StringToWideChar(FSelection, OLEStr, MAX_PATH), Eaten,
             TempSelectionPIDL, Attr) = NO_ERROR then
            SelectionPIDL := TempSelectionPIDL;
        finally
          {$IFNDEF DFS_NO_COM_CLEANUP} ShellFolder.Release; {$ENDIF}
        end;
        SendMessage(FDlgWnd, BFFM_SETSELECTION, 1,
           LPARAM(FormatSelection(FSelection)));
      end;
    end;
  end;
end;

procedure TdfsBrowseDirectoryDlg.DoInitialized(Wnd: HWND);
var
  Rect: TRect;
begin
  FDlgWnd := Wnd;
  if FCenter then begin
    GetWindowRect(Wnd, Rect);
    SetWindowPos(Wnd, 0,
      (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
      (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 2,
      0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  end;

if [bfNewDialogStyle, bfUseNewUI] * Options <> [] then
  ShowStatusTextLabel;

  // Documentation for BFFM_ENABLEOK is incorrect.  Value sent in LPARAM, not WPARAM.
  SendMessage(FDlgWnd, BFFM_ENABLEOK, 0, LPARAM(FEnableOKButton));
  if FStatusText <> '' then
    SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, LPARAM(PChar(FittedStatusText)));
  if (FSelection <> '') or (FSelectionPIDL <> NIL) then
    SendSelectionMessage;
  if FCaption <> '' then
    SendMessage(FDlgWnd, WM_SETTEXT, 0, LPARAM(FCaption));
  if assigned(FOnCreate) then
    FOnCreate(Self);
end;

procedure TdfsBrowseDirectoryDlg.DoSelChanged(Wnd: HWND; Item: PItemIDList);
var
  Name: string;
begin
  if FShowSelectionInStatus or assigned(FSelChanged) then
  begin
    Name := '';
    SetLength(Name, MAX_PATH);
    SHGetPathFromIDList(Item, PChar(Name));
    SetLength(Name, StrLen(PChar(Name)));
    if FShowSelectionInStatus then
      StatusText := Name;
    if assigned(FSelChanged) then
      FSelChanged(Self, Name, Item);
  end;
end;

procedure TdfsBrowseDirectoryDlg.DoValidateFailed(Path: string;
   var Cancel: boolean);
begin
  if assigned(FOnValidateFailed) then
    FOnValidateFailed(Self, Path, Cancel);
end;

procedure TdfsBrowseDirectoryDlg.SetFitStatusText(Val: boolean);
begin
  if FFitStatusText = Val then exit;
  FFitStatusText := Val;
  // Reset the status text area if needed.
  if FDlgWnd <> 0 then
    SendMessage(FDlgWnd, BFFM_SETSTATUSTEXT, 0, LPARAM(PChar(FittedStatusText)));
end;

procedure TdfsBrowseDirectoryDlg.SetStatusText(const Val: string);
begin
  if FStatusText = Val then exit;
  FStatusText := Val;
  if FDlgWnd <> 0 then
    SendMessage(FDlgWnd, BFFM_SETSTATUSTEXT, 0, LPARAM(PChar(FittedStatusText)));
end;

procedure TdfsBrowseDirectoryDlg.SetSelection(const Val: string);
begin
  if FSelection = Val then exit;
  FSelection := Val;
  // Add trailing backslash so it looks better in the IDE.
  if (FSelection <> '') and (FSelection[Length(FSelection)] <> '\') and
     DirExists(FSelection) then
    FSelection := FSelection + '\'
  else if (FSelection = '') and assigned(FSelectionPIDL) then
  begin
    FShellMalloc.Free(FSelectionPIDL);
    FSelectionPIDL := NIL;
  end;
  if FShowSelectionInStatus then
    StatusText := FSelection;
  if FDlgWnd <> 0 then
    SendSelectionMessage;
end;

procedure TdfsBrowseDirectoryDlg.SetSelectionPIDL(Value: PItemIDList);
begin
	if (FSelectionPIDL <> Value) then
  begin
    if assigned(FSelectionPIDL) then
      FShellMalloc.Free(FSelectionPIDL);
		FSelectionPIDL := Value;
	end;
end;



procedure TdfsBrowseDirectoryDlg.SetEnableOKButton(Val: boolean);
begin
  FEnableOKButton := Val;
  if FDlgWnd <> 0 then
    // Documentation for BFFM_ENABLEOK is incorrect.  Value sent in LPARAM, not WPARAM.
    SendMessage(FDlgWnd, BFFM_ENABLEOK, 0, LPARAM(FEnableOKButton));
end;

function TdfsBrowseDirectoryDlg.GetCaption: string;
var
  Temp: array[0..255] of char;
begin
  if FDlgWnd <> 0 then
  begin
    SendMessage(FDlgWnd, WM_GETTEXT, SizeOf(Temp), LPARAM(@Temp));
    Result := string(Temp);
  end else
    Result := FCaption;
end;

procedure TdfsBrowseDirectoryDlg.SetCaption(const Val: string);
begin
  FCaption := Val;
  if FDlgWnd <> 0 then
    SendMessage(FDlgWnd, WM_SETTEXT, 0, LPARAM(FCaption));
end;

procedure TdfsBrowseDirectoryDlg.SetParent(AParent: TWinControl);
begin
  FParent := AParent;
end;

// Note that BOOL <> boolean type.  Important!
function FindStatusTextWndProc(Child: HWND; Data: LParam): BOOL; stdcall;
const
  STATUS_TEXT_WINDOW_ID = 14147;
type
  PHWND = ^HWND;
begin
//  if GetWindowLong(Child, GWL_ID) = STATUS_TEXT_WINDOW_ID then begin
  if not IsWindowVisible(Child) then
  begin
ShowWindow(Child, SW_SHOW);
EnableWindow(Child, true);
SendMessage(Child, WM_SETTEXT, 0, LPARAM(PCHAR('foo'))); 
    PHWND(Data)^ := Child;
    Result := TRUE;
  end else
    Result := TRUE;
end;

procedure TdfsBrowseDirectoryDlg.ShowStatusTextLabel;
var
  ChildWnd: HWND;
begin
  if FDlgWnd <> 0 then
  begin
    ChildWnd := 0;
    if FDlgWnd <> 0 then
      // Enumerate all child windows of the dialog to find the status text window.
      EnumChildWindows(FDlgWnd, @FindStatusTextWndProc, LPARAM(@ChildWnd));

    if (ChildWnd <> 0) then
      ShowWindow(ChildWnd, SW_SHOW);
  end;
end;

// Note that BOOL <> boolean type.  Important!
function EnumChildWndProc(Child: HWND; Data: LParam): BOOL; stdcall;
const
  STATUS_TEXT_WINDOW_ID = 14147;
type
  PHWND = ^HWND;
begin
  if GetWindowLong(Child, GWL_ID) = STATUS_TEXT_WINDOW_ID then begin
    PHWND(Data)^ := Child;
    Result := FALSE;
  end else
    Result := TRUE;
end;

function TdfsBrowseDirectoryDlg.FittedStatusText: string;
var
  ChildWnd: HWND;
begin
  Result := FStatusText;
  if FFitStatusText then begin
    ChildWnd := 0;
    if FDlgWnd <> 0 then
      // Enumerate all child windows of the dialog to find the status text window.
      EnumChildWindows(FDlgWnd, @EnumChildWndProc, LPARAM(@ChildWnd));
    if (ChildWnd <> 0) and (FStatusText <> '') then
      if DirExists(FStatusText) then
        Result := MinimizeName(ChildWnd, FStatusText)
      else
        Result := MinimizeString(ChildWnd, FStatusText);
  end;
end;

function TdfsBrowseDirectoryDlg.GetDisplayName: string;
var
  ShellFolder: IShellFolder;
  Str : TStrRet;
begin
  Result := '';
  if FSelectionPIDL <> NIL then
  begin
    if SHGetDesktopFolder(ShellFolder) = NO_ERROR then
    begin
      try
        if ShellFolder.GetDisplayNameOf(FSelectionPIDL, SHGDN_FORPARSING,
           Str) = NOERROR then
        begin
          case Str.uType of
            STRRET_WSTR:   Result := WideCharToString(Str.pOleStr);
            {$IFDEF DFS_COMPILER_4_UP}
            STRRET_OFFSET: Result := PChar(LongWord(FSelectionPIDL) + Str.uOffset);
            {$ELSE}
            STRRET_OFFSET: Result := PChar(Longint(FSelectionPIDL) + Str.uOffset);
            {$ENDIF}
            STRRET_CSTR:   Result := Str.cStr;
          end;
        end;
      finally
        {$IFNDEF DFS_NO_COM_CLEANUP} ShellFolder.Release; {$ENDIF}
      end;
    end;
  end;
  if Result = '' then
    Result := FDisplayName;
  if Result = '' then
    Result := FSelection;
end;

function TdfsBrowseDirectoryDlg.GetVersion: string;
begin
  Result := DFS_COMPONENT_VERSION;
end;

procedure TdfsBrowseDirectoryDlg.SetVersion(const Val: string);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;

procedure TdfsBrowseDirectoryDlg.SetOptions(const Val: TBrowseFlags);
begin
  if FOptions <> Val then
  begin
    FOptions := Val;
    if bfIncludeURLs in FOptions then
      FOptions := FOptions + [bfIncludeFiles, bfUseNewUI];
    if bfShareable in FOptions then
      FOptions := FOptions + [bfUseNewUI];
    if bfUseNewUI in FOptions then
      FOptions := FOptions + [bfNewDialogStyle, bfEditBox];
  end;
end;

end.
