{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvBrowseFolder.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s):
  Michael Beck [mbeck att bigfoot dott com]
  Roman Kovbasiouk [roko att users dott sourceforge dott net]
  Remko Bonte [remkobonte att myrealbox dott com]

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvBrowseFolder.pas 10612 2006-05-19 19:04:09Z jfudickar $

unit JvBrowseFolder;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

{$IFDEF BCB6}
// BCB6 needs the shtypes.h file to be included
{$HPPEMIT '#include <shtypes.h>'}
{$ENDIF BCB6}

{$IFDEF BCB5}
// BCB5 doesn't have the shtypes.h file, so we have to cope with it
(*$HPPEMIT 'namespace shlobj_h'*)
(*$HPPEMIT '{'*)
(*$HPPEMIT '#include <shlobj.h>'*)
(*$HPPEMIT '}'*)
(*$HPPEMIT 'using namespace shlobj_h;'*)
(*$HPPEMIT '#define _ITEMIDLIST shlobj_h::_ITEMIDLIST'*)
{$ENDIF BCB5}

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF CLR}
  System.Text, System.Runtime.InteropServices, System.Security,
  {$ENDIF CLR}
  {$IFDEF VisualCLX}
  Qt, QWindows,
  {$ENDIF VisualCLX}
  Windows, Messages, ShlObj, Classes,
  JvBaseDlg;

{$IFDEF CLR}
type
  IUnknown = IInterface;
{$ENDIF CLR}

const
  { Interfaces from ShObjIdl.h }
  IID_IFolderFilterSite: TGUID = '{C0A651F5-B48B-11d2-B5ED-006097C686F6}';
  SID_IFolderFilterSite = '{C0A651F5-B48B-11d2-B5ED-006097C686F6}';

type
  IFolderFilterSite = interface(IUnknown)
    [SID_IFolderFilterSite]
    function SetFilter(punk: IUnknown): HResult; stdcall;
  end;

const
  IID_IFolderFilter: TGUID = '{9CC22886-DC8E-11d2-B1D0-00C04F8EEB3E}';
  SID_IFolderFilter = '{9CC22886-DC8E-11d2-B1D0-00C04F8EEB3E}';

type
  IFolderFilter = interface(IUnknown)
    [SID_IFolderFilter]
    function ShouldShow(psf: IShellFolder; pidlFolder, pidlItem: PItemIDList): HResult; stdcall;
    function GetEnumFlags(psf: IShellFolder; pidlFolder: PItemIDList; const phWnd: THandle;
      var pgrfFlags: DWORD): HResult; stdcall;
  end;

type
  { (rb) Stupid name, feel free to change :) }
  TJvBrowsableObjectClass = (
    ocFolders,          //SHCONTF_FOLDERS,
    ocNonFolders,       //SHCONTF_NONFOLDERS,
    ocIncludeHidden,    //SHCONTF_INCLUDEHIDDEN,
    ocInitOnFirstNext,  //SHCONTF_INIT_ON_FIRST_NEXT,
    ocNetPrinterSrch,   //SHCONTF_NETPRINTERSRCH,
    ocSharable,         //SHCONTF_SHAREABLE,
    ocStorage           //SHCONTF_STORAGE
  );
  TJvBrowsableObjectClasses = set of TJvBrowsableObjectClass;

  TJvBrowseAcceptChange = procedure(Sender: TObject; const NewFolder: string;
    var Accept: Boolean) of object;
  TJvShouldShowEvent = procedure(Sender: TObject; const Item: string;
    var DoShow: Boolean) of object;
  TJvGetEnumFlagsEvent = procedure(Sender: TObject; const AFolder: string;
    var Flags: TJvBrowsableObjectClasses) of object;
  TJvDirChange = procedure(Sender: TObject; const Directory: string) of object;
  TJvValidateFailedEvent = procedure(Sender: TObject; const AEditText: string;
    var CanCloseDialog: Boolean) of object;

  TFromDirectory = (
    fdNoSpecialFolder, { 0 }
    fdRootFolder, { 0 }
    fdRecycleBin, { CSIDL_BITBUCKET }
    fdControlPanel, { CSIDL_CONTROLS }
    fdDesktop, { CSIDL_DESKTOP }
    fdDesktopDirectory, { CSIDL_DESKTOPDIRECTORY }
    fdMyComputer, { CSIDL_DRIVES }
    fdFonts, { CSIDL_FONTS }
    fdNetHood, { CSIDL_NETHOOD }
    fdNetwork, { CSIDL_NETWORK }
    fdPersonal, { CSIDL_PERSONAL }
    fdPrinters, { CSIDL_PRINTERS }
    fdPrograms, { CSIDL_PROGRAMS }
    fdRecent, { CSIDL_RECENT }
    fdSendTo, { CSIDL_SENDTO }
    fdStartMenu, { CSIDL_STARTMENU }
    fdStartup, { CSIDL_STARTUP }
    fdTemplates, { CSIDL_TEMPLATES }
    fdStartUpNonLocalized, { CSIDL_ALTSTARTUP }
    fdCommonStartUpNonLocalized, { CSIDL_COMMON_ALTSTARTUP }
    fdCommonDocuments, { CSIDL_COMMON_DOCUMENTS }
    fdCommonFavorites, { CSIDL_COMMON_FAVORITES }
    fdCommonPrograms, { CSIDL_COMMON_PROGRAMS }
    fdCommonStartUp, { CSIDL_COMMON_STARTUP }
    fdCommonTemplates, { CSIDL_COMMON_TEMPLATES }
    fdCookies, { CSIDL_COOKIES }
    fdFavorites, { CSIDL_FAVORITES }
    fdHistory, { CSIDL_HISTORY }
    fdInternet, { CSIDL_INTERNET }
    fdMyMusic, { CSIDL_MYMUSIC }
    fdPrinthood, { CSIDL_PRINTHOOD }
    fdConnections, { CSIDL_CONNECTIONS }

    { Version 4.71 }
    fdAppData, { CSIDL_APPDATA }

    { Version 4.72 }
    fdInternetCache, { CSIDL_INTERNET_CACHE }

    { Version 5.00 }
    fdAdminTools, { CSIDL_ADMINTOOLS }
    fdCommonAdminTools, { CSIDL_COMMON_ADMINTOOLS }
    fdCommonAppData, { CSIDL_COMMON_APPDATA }
    fdLocalAppData, { CSIDL_LOCAL_APPDATA }
    fdMyPictures, { CSIDL_MYPICTURES }
    fdProfile, { CSIDL_PROFILE }
    fdProgramFiles, { CSIDL_PROGRAM_FILES }
    fdProgramFilesCommon, { CSIDL_PROGRAM_FILES_COMMON }
    fdSystem, { CSIDL_SYSTEM }
    fdWindows, { CSIDL_WINDOWS }

    {  Version 6.00 }
    fdCDBurnArea, { CSIDL_CDBURN_AREA }
    fdCommonMusic, { CSIDL_COMMON_MUSIC }
    fdCommonPictures, { CSIDL_COMMON_PICTURES }
    fdCommonVideo, { CSIDL_COMMON_VIDEO }
    fdMyDocuments, { CSIDL_MYDOCUMENTS }
    fdMyVideo, { CSIDL_MYVIDEO }
    fdProfiles, { CSIDL_PROFILES }

    { Unknown version }
    fdResources, { CSIDL_RESOURCES }
    fdResourcesLocalized,
    fdCommonOEMLinks, { CSIDL_COMMON_OEM_LINKS }
    fdComputersNearMe { CSIDL_COMPUTERSNEARME }
    );

  TJvFolderPos = (fpDefault, fpScreenCenter, fpFormCenter, fpTopLeft,
    fpTopRight, fpBottomLeft, fpBottomRight);
  TOptionsDirectory = (odBrowseForComputer, odOnlyDirectory, odOnlyPrinters,
    odNoBelowDomain, odSystemAncestorsOnly, odFileSystemDirectoryOnly,
    odStatusAvailable, odIncludeFiles, odIncludeUrls, odEditBox,
    odNewDialogStyle, odShareable, odUsageHint, odNoNewButtonFolder, odValidate);
  // (p3) shouldn't TOptionsDir be changed to T(Jv)OptionsDirectories?
  TOptionsDir = set of TOptionsDirectory;

  {$IFDEF COMPILER6_UP}
  TJvBrowseForFolderDialog = class(TJvCommonDialogF, IFolderFilter)
  {$ELSE}
  TJvBrowseForFolderDialog = class(TJvCommonDialogF, IFolderFilter, IUnknown)
  {$ENDIF COMPILER6_UP}
  private
    { Handle to the owner form of the dialog, used if Position = fpFormCenter }
    FOwnerWindow: THandle;
    { Handle to the MS "Browse for folder" dialog }
    FDialogWindow: THandle;
    FHelpContext: THelpContext;
    FTitle: string;
    FOptions: TOptionsDir;
    FUsedOptions: TOptionsDir;
    FDisplayName: string;
    FRootDirectory: TFromDirectory;
    FRootDirectoryPath: string;
    FDirectory: string;
    FPosition: TJvFolderPos;
    FPidl: PItemIDList;
    FStatusText: string;

    FHelpButtonHandle: THandle;
    FHelpButtonHeightDelta: Integer;

    FOnInit: TNotifyEvent;
    FOnChange: TJvDirChange;
    FOnAcceptChange: TJvBrowseAcceptChange;
    FOnShouldShow: TJvShouldShowEvent;
    FOnGetEnumFlags: TJvGetEnumFlagsEvent;
    FOnValidateFailed: TJvValidateFailedEvent;

    { For hooking the control }
    FDefWndProc: {$IFDEF CLR}TFNBFFCallBack{$ELSE}Pointer{$ENDIF};
    FObjectInstance: {$IFDEF CLR}TFNWndProc{$ELSE}Pointer{$ENDIF};
    FPositionSet: Boolean;

    // (p3) updates the status text. NOTE: doesn't work if odNewDialogStyle is true (MS limitation)!!!
    procedure UpdateStatusText(AText: string);
    procedure WMShowWindow(var Msg: TMessage); message WM_SHOWWINDOW;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    function GetRootDirectoryPath: string;
    function IsRootDirectoryPathStored: Boolean;
    procedure SetRootDirectory(const Value: TFromDirectory);
    procedure SetRootDirectoryPath(const Value: string);
    procedure SetOptions(const Value: TOptionsDir);
  protected
    { Messages from the browser }
    procedure DoInitialized;
    procedure DoIUnknown(const Unknown: IUnknown);
    procedure DoSelChanged(IDList: PItemIDList);
    function DoValidateFailed(AEditText: string): Integer;
    function DoValidateFailedW(AEditText: WideString): Integer;
    function DoShouldShow(const AItem: string): Boolean;
    function DoGetEnumFlags(const AFolder: string; var Flags: TJvBrowsableObjectClasses): Boolean;

    function GetOwnerWindow: THandle;
    procedure MainWndProc(var Msg: TMessage);
    procedure HookDialog;

    { IFolderFilter }
    function ShouldShow(psf: IShellFolder; pidlFolder, pidlItem: PItemIDList): HResult; stdcall;
    function GetEnumFlags(psf: IShellFolder; pidlFolder: PItemIDList; const phWnd: THandle;
      var pgrfFlags: DWORD): HResult; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure DefaultHandler(var Msg); override;
    { Messages to the browser }
    procedure SetSelection(const APath: string); overload;
    procedure SetSelection(IDList: PItemIDList); overload;
    procedure SetStatusText(const AText: string);
    procedure SetStatusTextW(const AText: WideString);
    procedure SetOKEnabled(const Value: Boolean);
    procedure SetOKText(const AText: string);
    procedure SetOKTextW(const AText: WideString);
    procedure SetExpanded(const APath: string); overload;
    procedure SetExpandedW(const APath: WideString);
    procedure SetExpanded(IDList: PItemIDList); overload;

    property Pidl: PItemIDList read FPidl;
    property Handle: THandle read FDialogWindow;

    function Execute: Boolean; override;
  published
    property Directory: string read FDirectory write FDirectory;
    property DisplayName: string read FDisplayName write FDisplayName stored False;
    property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
    property Options: TOptionsDir read FOptions write SetOptions default
      [odStatusAvailable, odNewDialogStyle];
    property Position: TJvFolderPos read FPosition write FPosition default fpScreenCenter;
    property RootDirectory: TFromDirectory read FRootDirectory write SetRootDirectory default fdNoSpecialFolder;
    property RootDirectoryPath: string read GetRootDirectoryPath write SetRootDirectoryPath
      stored IsRootDirectoryPathStored;
    property Title: string read FTitle write FTitle;
    property StatusText: string read FStatusText write FStatusText;
    property OnAcceptChange: TJvBrowseAcceptChange read FOnAcceptChange write FOnAcceptChange;
    property OnChange: TJvDirChange read FOnChange write FOnChange;
    property OnGetEnumFlags: TJvGetEnumFlagsEvent read FOnGetEnumFlags write FOnGetEnumFlags;
    property OnInitialized: TNotifyEvent read FOnInit write FOnInit;
    property OnShouldShow: TJvShouldShowEvent read FOnShouldShow write FOnShouldShow;
    property OnValidateFailed: TJvValidateFailedEvent read FOnValidateFailed write FOnValidateFailed;
  end;

function BrowseForFolder(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext = 0): Boolean;
function BrowseForComputer(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext = 0): Boolean;
// (p3) moved from JvFileUtil, deprecated removed
function BrowseDirectory(var AFolderName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;
// (p3) moved from JvFileUtil, deprecated removed
function BrowseComputer(var AComputerName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvBrowseFolder.pas $';
    Revision: '$Revision: 10612 $';
    Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, ActiveX, Controls, Forms, Consts, Graphics,
  {$IFNDEF CLR}
  JclShell,
  {$ENDIF ~CLR}
  JvJCLUtils, JvJVCLUtils, JvConsts, JvResources, JvTypes;

{$IFDEF VisualCLX}
type
  TMessage = Messages.TMessage;
{$ENDIF VisualCLX}

{$IFDEF CLR}
// .NET loads the library on first access
[SuppressUnmanagedCodeSecurity, DllImport('SHFolder.dll', CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'SHGetFolderPathA')]
function SHGetFolderPathProc(hWnd: HWND; CSIDL: Integer; hToken: THandle;
    dwFlags: DWORD; pszPath: StringBuilder): HResult; external;

{$ELSE}
type
  TSHGetFolderPathProc = function(hWnd: HWND; CSIDL: Integer; hToken: THandle;
    dwFlags: DWORD; pszPath: PAnsiChar): HResult; stdcall;

var
  SHGetFolderPathProc: TSHGetFolderPathProc = nil;
{$ENDIF CLR}

const
  { Taken from ShlObj.h & ShObjIdl.h }
  BIF_RETURNFSANCESTORS      = $0008;
  BIF_EDITBOX                = $0010; // Add an editbox to the dialog
  BIF_VALIDATE               = $0020; // insist on valid result (or CANCEL)
  BIF_NEWDIALOGSTYLE         = $0040; // Use the new dialog layout with the ability to resize
                                      // Caller needs to call OleInitialize() before using this API
  BIF_BROWSEINCLUDEURLS      = $0080; // Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)
  BIF_UAHINT                 = $0100; // Add a UA hint to the dialog, in place of the edit box.
                                      // May not be combined with BIF_EDITBOX
  BIF_NONEWFOLDERBUTTON      = $0200; // Do not add the "New Folder" button to the dialog.
                                      // Only applicable with BIF_NEWDIALOGSTYLE.
  BIF_BROWSEINCLUDEFILES     = $4000; // Browsing for Everything
  BIF_SHAREABLE              = $8000; // sharable resources displayed (remote shares, requires BIF_USENEWUI)

  SHCONTF_INIT_ON_FIRST_NEXT = $0100; // allow EnumObject() to return before validating enum
  SHCONTF_NETPRINTERSRCH     = $0200; // hint that client is looking for printers
  SHCONTF_SHAREABLE          = $0400; // hint that client is looking sharable resources (remote shares)
  SHCONTF_STORAGE            = $0800; // include all items with accessible storage and their ancestors

  CSIDL_MYDOCUMENTS          = $000C; // logical "My Documents" desktop icon
  CSIDL_MYMUSIC              = $000D; // "My Music" folder
  CSIDL_MYVIDEO              = $000E; // "My Videos" folder
  CSIDL_LOCAL_APPDATA        = $001C; // <user name>\Local Settings\Applicaiton Data (non roaming)
  CSIDL_COMMON_APPDATA       = $0023; // All Users\Application Data
  CSIDL_WINDOWS              = $0024; // GetWindowsDirectory()
  CSIDL_SYSTEM               = $0025; // GetSystemDirectory()
  CSIDL_PROGRAM_FILES        = $0026; // C:\Program Files
  CSIDL_MYPICTURES           = $0027; // C:\Program Files\My Pictures
  CSIDL_PROFILE              = $0028; // USERPROFILE
  CSIDL_PROGRAM_FILES_COMMON = $002B; // C:\Program Files\Common
  CSIDL_COMMON_TEMPLATES     = $002D; // All Users\Templates
  CSIDL_COMMON_DOCUMENTS     = $002E; // All Users\Documents
  CSIDL_COMMON_ADMINTOOLS    = $002F; // All Users\Start Menu\Programs\Administrative Tools
  CSIDL_ADMINTOOLS           = $0030; // <user name>\Start Menu\Programs\Administrative Tools
  CSIDL_CONNECTIONS          = $0031; // Network and Dial-up Connections
  CSIDL_COMMON_MUSIC         = $0035; // All Users\My Music
  CSIDL_COMMON_PICTURES      = $0036; // All Users\My Pictures
  CSIDL_COMMON_VIDEO         = $0037; // All Users\My Video
  CSIDL_RESOURCES            = $0038; // Resource Direcotry
  CSIDL_RESOURCES_LOCALIZED  = $0039; // Localized Resource Direcotry
  CSIDL_COMMON_OEM_LINKS     = $003A; // Links to All Users OEM specific apps
  CSIDL_CDBURN_AREA          = $003B; // USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning
  CSIDL_COMPUTERSNEARME      = $003D; // Computers Near Me (computered from Workgroup membership)
  CSIDL_PROFILES             = $003E; // ??

  BFFM_SETOKTEXT             = WM_USER + 105; // Unicode only
  BFFM_SETEXPANDED           = WM_USER + 106; // Unicode only
  BFFM_IUNKNOWN              = 5;             // provides IUnknown to client. lParam: IUnknown*

  { TOptionsDirectory = (odBrowseForComputer, odOnlyDirectory, odOnlyPrinters,
      odNoBelowDomain, odSystemAncestorsOnly, odFileSystemDirectoryOnly,
      odStatusAvailable, odIncludeFiles, odIncludeUrls, odEditBox,
      odNewDialogStyle, odShareable, odUsageHint, odNoNewButtonFolder, odValidate);
  }

  { (rb) No idea why odOnlyDirectory is used? }

  COptionsDirectory: array [TOptionsDirectory] of Cardinal = (
    BIF_BROWSEFORCOMPUTER, 0, BIF_BROWSEFORPRINTER, BIF_DONTGOBELOWDOMAIN,
    BIF_RETURNFSANCESTORS, BIF_RETURNONLYFSDIRS, BIF_STATUSTEXT,
    BIF_BROWSEINCLUDEFILES, BIF_BROWSEINCLUDEURLS, BIF_EDITBOX,
    BIF_NEWDIALOGSTYLE, BIF_SHAREABLE, BIF_UAHINT, BIF_NONEWFOLDERBUTTON,
    BIF_VALIDATE);

  { TJvBrowseObjectClass = (ocFolders, ocNonFolders, ocIncludeHidden,
      ocInitOnFirstNext, ocNetPrinterSrch, ocSharable, ocStorage)
  }

  CBrowseObjectClasses: array [TJvBrowsableObjectClass] of Cardinal = (
    SHCONTF_FOLDERS, SHCONTF_NONFOLDERS, SHCONTF_INCLUDEHIDDEN,
    SHCONTF_INIT_ON_FIRST_NEXT, SHCONTF_NETPRINTERSRCH,
    SHCONTF_SHAREABLE, SHCONTF_STORAGE);

function BrowseForFolder(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext): Boolean;
begin
  with TJvBrowseForFolderDialog.Create(nil) do
  try
    Position := fpScreenCenter;
    Directory := ADirectory;
    Title := ATitle;
    HelpContext := AHelpContext;
    if AllowCreate then
      Options := Options + [odNewDialogStyle]
    else
      Options := Options - [odNewDialogStyle];
    Result := Execute;
    if Result then
      ADirectory := Directory;
  finally
    Free;
  end;
end;

function BrowseForComputer(const ATitle: string; AllowCreate: Boolean;
  var ADirectory: string; AHelpContext: THelpContext): Boolean;
begin
  with TJvBrowseForFolderDialog.Create(nil) do
  try
    Position := fpScreenCenter;
    Directory := ADirectory;
    Title := ATitle;
    HelpContext := AHelpContext;
    if AllowCreate then
      Options := Options + [odNewDialogStyle]
    else
      Options := Options - [odNewDialogStyle];
    Options := Options + [odBrowseForComputer];
    RootDirectory := fdNetwork;
    Result := Execute;
    if Result then
      ADirectory := Directory;
  finally
    Free;
  end;
end;

function BrowseDirectory(var AFolderName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;
begin
  Result := BrowseForFolder(DlgText, True, AFolderName, AHelpContext);
end;

function BrowseComputer(var AComputerName: string; const DlgText: string;
  AHelpContext: THelpContext): Boolean;
begin
  Result := BrowseForComputer(DlgText, True, AComputerName, AHelpContext);
end;

{ From QDialogs.pas }

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet): string;
{$IFDEF CLR}
begin
  case StrRet.uType of
    STRRET_CSTR:
      Result := Marshal.PtrToStringAnsi(StrRet.cStr);
    STRRET_OFFSET:
      Result := Marshal.PtrToStringAnsi(Marshal.ReadIntPtr(PIDL.mkid.abID, StrRet.uOffset - SizeOf(PIDL.mkid.cb)),
        PIDL.mkid.cb - StrRet.uOffset);
    STRRET_WSTR:
      Result := Marshal.PtrToStringBSTR(StrRet.pOleStr);
  end;
end;
{$ELSE}
var
  P: PChar;
begin
  case StrRet.uType of
    STRRET_CSTR:
      SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
    STRRET_OFFSET:
      begin
        P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
        SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
      end;
    STRRET_WSTR:
      Result := StrRet.pOleStr;
  end;
end;
{$ENDIF CLR}

type
  TFromDirectoryData = record
    CSIDL: Cardinal;
    MinVersion: Cardinal;
    OnlyNT: Boolean;
    CanSimulate: Boolean;
    Alternative: TFromDirectory;
  end;

const
  CSIDLLocations: array [TFromDirectory] of TFromDirectoryData = (
    { fdNoSpecialFolder }
    (CSIDL: 0; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRootFolder }
    (CSIDL: 0; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRecycleBin }
    (CSIDL: CSIDL_BITBUCKET; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdControlPanel }
    (CSIDL: CSIDL_CONTROLS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdDesktop }
    (CSIDL: CSIDL_DESKTOP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdDesktopDirectory }
    (CSIDL: CSIDL_DESKTOPDIRECTORY; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdMyComputer }
    (CSIDL: CSIDL_DRIVES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdFonts }
    (CSIDL: CSIDL_FONTS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdNetHood }
    (CSIDL: CSIDL_NETHOOD; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdNetwork }
    (CSIDL: CSIDL_NETWORK; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPersonal }
    (CSIDL: CSIDL_PERSONAL; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdPrinters }
    (CSIDL: CSIDL_PRINTERS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPrograms }
    (CSIDL: CSIDL_PROGRAMS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdRecent }
    (CSIDL: CSIDL_RECENT; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdSendTo }
    (CSIDL: CSIDL_SENDTO; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartMenu }
    (CSIDL: CSIDL_STARTMENU; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartup }
    (CSIDL: CSIDL_STARTUP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdTemplates }
    (CSIDL: CSIDL_TEMPLATES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdStartUpNonLocalized }
    (CSIDL: CSIDL_ALTSTARTUP; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonStartUpNonLocalized }
    (CSIDL: CSIDL_COMMON_ALTSTARTUP; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonDocuments }
    (CSIDL: CSIDL_COMMON_DOCUMENTS; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonFavorites }
    (CSIDL: CSIDL_COMMON_FAVORITES; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonPrograms }
    (CSIDL: CSIDL_COMMON_PROGRAMS; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonStartUp }
    (CSIDL: CSIDL_COMMON_STARTUP; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonTemplates }
    (CSIDL: CSIDL_COMMON_TEMPLATES; MinVersion: 0; OnlyNT: True;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCookies }
    (CSIDL: CSIDL_COOKIES; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdFavorites }
    (CSIDL: CSIDL_FAVORITES; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdHistory }
    (CSIDL: CSIDL_HISTORY; MinVersion: 0; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdInternet }
    (CSIDL: CSIDL_INTERNET; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdMyMusic }
    (CSIDL: CSIDL_MYMUSIC; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdPrinthood }
    (CSIDL: CSIDL_PRINTHOOD; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdConnections }
    (CSIDL: CSIDL_CONNECTIONS; MinVersion: 0; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdAppData }
    (CSIDL: CSIDL_APPDATA; MinVersion: $00040071; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdInternetCache }
    (CSIDL: CSIDL_INTERNET_CACHE; MinVersion: $00040072; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdAdminTools }
    (CSIDL: CSIDL_ADMINTOOLS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonAdminTools }
    (CSIDL: CSIDL_COMMON_ADMINTOOLS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCommonAppData }
    (CSIDL: CSIDL_COMMON_APPDATA; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdLocalAppData }
    (CSIDL: CSIDL_LOCAL_APPDATA; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdMyPictures }
    (CSIDL: CSIDL_MYPICTURES; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdPersonal),
    { fdProfile }
    (CSIDL: CSIDL_PROFILE; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdProgramFiles }
    (CSIDL: CSIDL_PROGRAM_FILES; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdProgramFilesCommon }
    (CSIDL: CSIDL_PROGRAM_FILES_COMMON; MinVersion: $00050000; OnlyNT: True;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdSystem }
    (CSIDL: CSIDL_SYSTEM; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdWindows }
    (CSIDL: CSIDL_WINDOWS; MinVersion: $00050000; OnlyNT: False;
    CanSimulate: True; Alternative: fdNoSpecialFolder),
    { fdCDBurnArea }
    (CSIDL: CSIDL_CDBURN_AREA; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonMusic }
    (CSIDL: CSIDL_COMMON_MUSIC; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdCommonPictures }
    (CSIDL: CSIDL_COMMON_PICTURES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdCommonVideo }
    (CSIDL: CSIDL_COMMON_VIDEO; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdCommonDocuments),
    { fdMyDocuments }
    (CSIDL: CSIDL_MYDOCUMENTS; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdPersonal),
    { fdMyVideo }
    (CSIDL: CSIDL_MYVIDEO; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdPersonal),
    { fdProfiles }
    (CSIDL: CSIDL_PROFILES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdResources }
    (CSIDL: CSIDL_RESOURCES; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdResourcesLocalized }
    (CSIDL: CSIDL_RESOURCES_LOCALIZED; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdCommonOEMLinks }
    (CSIDL: CSIDL_COMMON_OEM_LINKS; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder),
    { fdComputersNearMe }
    (CSIDL: CSIDL_COMPUTERSNEARME; MinVersion: $00060000; OnlyNT: False;
    CanSimulate: False; Alternative: fdNoSpecialFolder)
    );

{$IFDEF CLR}
{$ELSE}
procedure InitSHFolder;
const
  SHFolderDll = 'SHFolder.dll';
var
  SHFolderHandle: HMODULE;
begin
  { You never know, maybe someone does not have SHFolder.dll, thus load on request }
  SHFolderHandle := GetModuleHandle(SHFolderDll);
  if SHFolderHandle <> 0 then
    SHGetFolderPathProc := GetProcAddress(SHFolderHandle, 'SHGetFolderPathA');
end;
{$ENDIF CLR}

procedure GetCSIDLLocation(const ASpecialDirectory: TFromDirectory;
  var CSIDL: Cardinal; var APath: string);
{ This function is a bit overkill }
var
  LSpecialDirectory: TFromDirectory;
  {$IFDEF CLR}
  Buffer: StringBuilder;
  {$ELSE}
  Buffer: PChar;
  {$ENDIF CLR}

  function IsOk: Boolean;
  begin
    with CSIDLLocations[LSpecialDirectory] do
      Result := (MinVersion <= GetShellVersion) and
        (not OnlyNT or (Win32Platform = VER_PLATFORM_WIN32_NT));
  end;

begin
  LSpecialDirectory := ASpecialDirectory;
  while (LSpecialDirectory <> fdNoSpecialFolder) and
    not CSIDLLocations[LSpecialDirectory].CanSimulate and not IsOk do
    LSpecialDirectory := CSIDLLocations[LSpecialDirectory].Alternative;

  if (LSpecialDirectory = fdNoSpecialFolder) or IsOk then
  begin
    CSIDL := CSIDLLocations[LSpecialDirectory].CSIDL;
    Exit;
  end;

  CSIDL := 0;
  {$IFDEF CLR}
  Buffer := StringBuilder.Create(MAX_PATH);
  Buffer.Length := MAX_PATH;
  if Succeeded(SHGetFolderPathProc(0, CSIDLLocations[LSpecialDirectory].CSIDL, 0, 0, Buffer)) then
    APath := Buffer.ToString()
  else
    APath := '';

  {$ELSE}
  GetMem(Buffer, MAX_PATH);
  try
    if not Assigned(SHGetFolderPathProc) then
      InitSHFolder;
    if Assigned(SHGetFolderPathProc) and
       Succeeded(SHGetFolderPathProc(0, CSIDLLocations[LSpecialDirectory].CSIDL, 0, 0, Buffer)) then
      APath := Buffer
    else
      APath := '';
  finally
    FreeMem(Buffer);
  end;
  {$ENDIF CLR}
end;

function CreateIDListFromPath(const APath: string): PItemIDList;
var
  WS: WideString;
  Eaten, Flags: LongWord;
  IDesktopFolder: IShellFolder;
begin
  { Returned value must be freed }

  Result := nil;

  if APath = '' then
    Exit;

  WS := APath;
  { MSDN : Since Flags is an in/out parameter, it should always be initialized }
  Flags := 0;

  if Failed(SHGetDesktopFolder(IDesktopFolder)) or
    Failed(IDesktopFolder.ParseDisplayName(0, nil, POleStr(WS), Eaten, Result, Flags)) then
    Result := nil;
end;

function CreateIDListFromCSIDL(const ASpecialDirectory: TFromDirectory): PItemIDList;
var
  CSIDL: Cardinal;
  Path: string;
begin
  { Returned value must be freed }

  Result := nil;

  if ASpecialDirectory = fdNoSpecialFolder then
    Exit;

  GetCSIDLLocation(ASpecialDirectory, CSIDL, Path);

  if CSIDL <> 0 then
  begin
    { MSDN: The calling application is responsible for freeing this pointer }
    { SHGetSpecialFolderLocation is shell v4.7 or later}
    if Failed(SHGetSpecialFolderLocation(0, CSIDL, Result)) then
      Result := nil;
  end
  else
    Result := CreateIDListFromPath(Path);
end;

function IDListToPath(IDList: PItemIDList): string;
var
  IDesktopFolder: IShellFolder;
  StrRet: TStrRet;
begin
  { Similar to SHGetPathFromIDList }
  if Succeeded(SHGetDesktopFolder(IDesktopFolder)) and
    Succeeded(IDesktopFolder.GetDisplayNameOf(IDList, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet)) then

    { Result may be a GUID; Don't know whether these GUIDs are portable. Microsoft
      does recommend to return strings 'that are as close to the display names
      as possible'. But in this case display names aren't usable }
    Result := StrRetToString(IDList, StrRet)
  else
    Result := '';

  (* These GUID's seem pretty portable, you can enter them at RootDirectoryPath
     or Directory, ie the "::{GUID}" part (only tested on Windows XP).

    ::{00020D75-0000-0000-C000-000000000046} - Inbox
    ::{20D04FE0-3AEA-1069-A2D8-08002B30309D} - CSIDL_DRIVES
    ::{208D2C60-3AEA-1069-A2D7-08002B30309D} - CSIDL_NETWORK, CSIDL_NETHOOD
    ::{21EC2020-3AEA-1069-A2DD-08002B30309D} - CSIDL_CONTROLS
    ::{2227A280-3AEA-1069-A2DE-08002B30309D} - CSIDL_PRINTERS, CSIDL_PRINTHOOD
    ::{450D8FBA-AD25-11D0-98A8-0800361B1103} - CSIDL_PERSONAL
    ::{645FF040-5081-101B-9F08-00AA002F954E} - CSIDL_BITBUCKET
    ::{7007ACC7-3202-11D1-AAD2-00805FC1270E} - CSIDL_CONNECTIONS
    ::{871C5380-42A0-1069-A2EA-08002B30309D} - CSIDL_INTERNET
    ::{D6277990-4C6A-11CF-8D87-00AA0060F5BF} - Scheduled Tasks
  *)
end;

function CSIDLToPath(const ASpecialDirectory: TFromDirectory): string;
var
  CSIDL: Cardinal;
  IDList: PItemIDList;
  ShellMalloc: IMalloc;
begin
  if ASpecialDirectory = fdNoSpecialFolder then
  begin
    Result := '';
    Exit;
  end;

  GetCSIDLLocation(ASpecialDirectory, CSIDL, Result);

  if CSIDL = 0 then
    Exit;

  { SHGetSpecialFolderLocation is shell v4.7 or later}
  if Succeeded(SHGetSpecialFolderLocation(0, CSIDL, IDList)) then
  try
    Result := IDListToPath(IDList);
  finally
    if Succeeded(SHGetMalloc(ShellMalloc)) then
      ShellMalloc.Free(IDList);
  end
  else
    Result := '';
end;

procedure SetDialogPos(AParentHandle, AWndHandle: THandle;
  Position: TJvFolderPos);
var
  R, SR: TRect;
begin
  if GetClientRect(AWndHandle, R) then
  begin
    //R.Right := R.Left + AWidth;
    //R.Bottom := R.Top + AHeight;
    SystemParametersInfo(SPI_GETWORKAREA, 0, @SR, 0);
    case Position of
      fpScreenCenter:
        begin
          R.Left := ((SR.Right - SR.Left - (R.Right - R.Left)) div 2);
          R.Top := (SR.Bottom - SR.Top - (R.Bottom - R.Top)) div 2;
        end;
      fpFormCenter:
        begin
          GetWindowRect(AParentHandle, SR);
          R.Left := SR.Left + ((SR.Right - SR.Left - (R.Right - R.Left)) div 2);
          R.Top := SR.Top + (SR.Bottom - SR.Top - (R.Bottom - R.Top)) div 2;
        end;
      fpTopLeft:
        begin
          R.Left := SR.Left;
          R.Top := SR.Top;
        end;
      fpTopRight:
        begin
          R.Top := SR.Top;
          R.Left := SR.Right - (R.Right - R.Left) -
            GetSystemMetrics(SM_CXFIXEDFRAME);
        end;
      fpBottomLeft:
        begin
          R.Top := SR.Bottom - (R.Bottom - R.Top) -
            GetSystemMetrics(SM_CYCAPTION) -
            -GetSystemMetrics(SM_CYFIXEDFRAME);
          R.Left := SR.Left;
        end;
      fpBottomRight:
        begin
          R.Top := SR.Bottom - (R.Bottom - R.Top) -
            GetSystemMetrics(SM_CYCAPTION) -
            GetSystemMetrics(SM_CYFIXEDFRAME);
          R.Left := SR.Right - (R.Right - R.Left) -
            GetSystemMetrics(SM_CXFIXEDFRAME);
        end;
      fpDefault:
        Exit;
    end;
    SetWindowPos(AWndHandle, 0, R.Left, R.Top, 0, 0,
      SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

//=== { TJvBrowseForFolderDialog } ===========================================

function lpfnBrowseProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
  Result := 0;

  with TJvBrowseForFolderDialog(lpData) do
  begin
    FDialogWindow := Wnd;
    case uMsg of
      BFFM_INITIALIZED:
        DoInitialized;
      BFFM_SELCHANGED:
        DoSelChanged(PItemIDList(lParam));
      BFFM_IUNKNOWN:
        DoIUnknown(IUnknown(lParam));
      BFFM_VALIDATEFAILEDA:
        Result := DoValidateFailed(PChar(lParam));
      BFFM_VALIDATEFAILEDW:
        Result := DoValidateFailedW(PWideChar(lParam));
    end;
  end;
end;

constructor TJvBrowseForFolderDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := [odStatusAvailable, odNewDialogStyle];
  FPosition := fpScreenCenter; // ahuser: changed from fpDefault - I think no one wants the dialog in the right bottom corner
  FRootDirectory := fdNoSpecialFolder;
  FObjectInstance := JvMakeObjectInstance(MainWndProc);
end;

destructor TJvBrowseForFolderDialog.Destroy;
begin
  PidlFree(FPidl);
  JvFreeObjectInstance(FObjectInstance);
  inherited Destroy;
end;

procedure TJvBrowseForFolderDialog.DefaultHandler(var Msg);
begin
  if FDialogWindow <> 0 then
    with TMessage(Msg) do
      Result := CallWindowProc(FDefWndProc, FDialogWindow, Msg, WParam, LParam)
  else
    inherited DefaultHandler(Msg);
end;

function TJvBrowseForFolderDialog.DoGetEnumFlags(const AFolder: string;
  var Flags: TJvBrowsableObjectClasses): Boolean;
begin
  { (rb) Always return True? }
  Result := True;
  if Assigned(FOnGetEnumFlags) then
    FOnGetEnumFlags(Self, AFolder, Flags);
end;

procedure TJvBrowseForFolderDialog.DoInitialized;
const
  SBtn = 'BUTTON';
  HelpButtonId = $FFFF;
var
  BtnHandle, BtnFont: THandle;
  BtnSize, WindowSize: TRect;
begin
  { We can now change the position of the dialog - if it's not NewDialogStyle.. }
  FPositionSet := not (odNewDialogStyle in FUsedOptions);
  if FPositionSet then
    SetDialogPos(FOwnerWindow, FDialogWindow, Position);

  { ..Otherwise we have to delay the change until receive of WM_SHOWWINDOW,
    thus we need to hook the dialog; we also need to hook the dialog if there
    is a new help button on the dialog and the dialog is resizeable - ie
    NewDialogStyle }
  if not FPositionSet or ((FHelpContext <> 0) and (odNewDialogStyle in FUsedOptions)) then
    HookDialog;

  // [roko] Rx's code to insert Help button
  if FHelpContext <> 0 then
  begin
    { SomeBtnHandle is some button on the window; we need it to determine a
      useable height & width for the new help button }
    BtnHandle := FindWindowEx(FDialogWindow, 0, SBtn, nil);
    if BtnHandle <> 0 then
    begin
      GetWindowRect(BtnHandle, BtnSize);
      GetWindowRect(FDialogWindow, WindowSize);
      ScreenToClient(FDialogWindow, BtnSize.TopLeft);
      ScreenToClient(FDialogWindow, BtnSize.BottomRight);
      BtnFont := SendMessage(FDialogWindow, WM_GETFONT, 0, 0);
      { Note: BtnSize.Top = "Window.Height" - FHelpButtonHeightDelta, used in
              WM_SIZE }
      FHelpButtonHeightDelta := WindowSize.Bottom - WindowSize.Top - BtnSize.Top;
      { Remember the new buttons handle, because we need it, when the dialog
        is resized }
      FHelpButtonHandle := CreateWindow(SBtn, PChar(SHelpButton),
        WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE or BS_PUSHBUTTON or WS_TABSTOP,
        12, BtnSize.Top, BtnSize.Right - BtnSize.Left, BtnSize.Bottom - BtnSize.Top,
        FDialogWindow, HelpButtonId, HInstance, nil);
      if BtnFont <> 0 then
        SendMessage(FHelpButtonHandle, WM_SETFONT, BtnFont, MakeLParam(1, 0));
      UpdateWindow(FDialogWindow);
    end;
  end;

  { Change directory (if possible) }
  if FDirectory <> '' then
    SetSelection(FDirectory);
  UpdateStatusText(FDirectory);

  if Assigned(FOnInit) then
    FOnInit(Self);
end;

procedure TJvBrowseForFolderDialog.DoIUnknown(const Unknown: IUnknown);
var
  FolderFilterSite: IFolderFilterSite;
begin
  if (Assigned(FOnGetEnumFlags) or Assigned(FOnShouldShow)) and
    Supports(Unknown, IID_IFolderFilterSite, FolderFilterSite) then
  begin
    FolderFilterSite.SetFilter(Self);
    FolderFilterSite := nil;
  end;
end;

procedure TJvBrowseForFolderDialog.DoSelChanged(IDList: PItemIDList);
var
  // (p3) use buff array instead of string as this works better
  Buffer: array [0..MAX_PATH] of Char;
  Path: string;
  Accept: Boolean;
  SavePidl: PItemIDList;
begin
  { Note :
    * If the location specified by the pidl parameter is not part of the file
      system, this function will fail.
    * If the pidl parameter specifies a shortcut, the pszPath will contain the
      path to the shortcut, not to the shortcut's target. (if not win XP )

    Could also use IDListToPath
  }

  if SHGetPathFromIDList(IDList, Buffer) then
    Path := Buffer
  else
    Path := '';

  SavePidl := FPidl;
  FPidl := IDList;
  try
    if Assigned(FOnAcceptChange) then
    begin
      Accept := True;
      FOnAcceptChange(Self, Path, Accept);
      SetOKEnabled(Accept);
    end;

    UpdateStatusText(Path);

    if Assigned(FOnChange) then
      FOnChange(Self, Path);
  finally
    FPidl := SavePidl;
  end;
end;

function TJvBrowseForFolderDialog.DoShouldShow(const AItem: string): Boolean;
begin
  if Assigned(FOnShouldShow) then
    FOnShouldShow(Self, AItem, Result)
  else
    Result := True;
end;

function TJvBrowseForFolderDialog.DoValidateFailed(AEditText: string): Integer;
var
  CanClose: Boolean;
begin
  { Return zero to allow the dialog to be dismissed or nonzero to keep
    the dialog displayed. }
  if Assigned(FOnValidateFailed) then
  begin
    CanClose := True;
    FOnValidateFailed(Self, AEditText, CanClose);
    Result := Integer(not CanClose);
  end
  else
    Result := 0; // = Integer(False)
end;

function TJvBrowseForFolderDialog.DoValidateFailedW(AEditText: WideString): Integer;
begin
  { Explicit conversion }
  Result := DoValidateFailed(PChar(string(AEditText)));
end;

function TJvBrowseForFolderDialog.Execute: Boolean;
var
  dspName: array [0..MAX_PATH] of Char;
  BrowseInfo: TBrowseInfo;
  ShellVersion: Cardinal;
  ActiveWindow: HWND;
  WindowList: Pointer;
  Option: TOptionsDirectory;
begin
  ShellVersion := GetShellVersion;
  if ShellVersion < $00040000 then
    raise EJVCLException.CreateRes(@RsEShellNotCompatible);

  FDialogWindow := 0;
  FOwnerWindow := GetOwnerWindow;
  FPositionSet := False;
  FHelpButtonHandle := 0;
  FHelpButtonHeightDelta := 0;

  Result := False;

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);

  { FUsedOptions is a subset of FOptions; the options that actually can be
    used because of shell version limitations }
  FUsedOptions := FOptions;
  if ShellVersion < $00060000 then
    FUsedOptions := FUsedOptions - [odNoNewButtonFolder, odUsageHint];
  if ShellVersion < $00050000 then
    FUsedOptions := FUsedOptions - [odIncludeUrls, odNewDialogStyle, odShareable];
  if ShellVersion < $00040071 then
    FUsedOptions := FUsedOptions - [odIncludeFiles, odEditBox, odValidate];

  for Option := Low(TOptionsDirectory) to High(TOptionsDirectory) do
    if Option in FUsedOptions then
      Inc(BrowseInfo.ulFlags, COptionsDirectory[Option]);

  BrowseInfo.hwndOwner := FOwnerWindow;
  BrowseInfo.pszDisplayName := dspName;
  BrowseInfo.lpfn := TFNBFFCallBack(@lpfnBrowseProc);
  BrowseInfo.lParam := Longint(Self);

  if (FStatusText = '') or not (odNewDialogStyle in FUsedOptions) then
    BrowseInfo.lpszTitle := Pointer(FTitle)
  else
  if FTitle = '' then
    BrowseInfo.lpszTitle := PChar(FStatusText)
  else
    BrowseInfo.lpszTitle := PChar(FTitle + Cr + FStatusText);

  if FRootDirectory = fdNoSpecialFolder then
    BrowseInfo.pidlRoot := CreateIDListFromPath(FRootDirectoryPath)
  else
    BrowseInfo.pidlRoot := CreateIDListFromCSIDL(FRootDirectory);

  try
    if odNewDialogStyle in FUsedOptions then
      CoInitialize(nil);
    try
      ActiveWindow := GetActiveWindow;
      WindowList := DisableTaskWindows(0);
      try
        if not PidlFree(FPidl) then
        begin
          Assert(False);    // FPidl comes from shell, so PidlFree should never fail
          FPidl := nil;     // in case building without assertions, need to ensure FPidl is nil
        end;
        FPidl := SHBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
        SetActiveWindow(ActiveWindow);
      end;

      Result := FPidl <> nil;
      if Result then
      begin
        FDisplayName := BrowseInfo.pszDisplayName;
        FDirectory := IDListToPath(FPidl);
      end;

      PidlFree(BrowseInfo.pidlRoot);
    finally
      FDialogWindow := 0;
      FOwnerWindow := 0;
      if odNewDialogStyle in FUsedOptions then
        CoUninitialize;
    end;
  except
  end;
end;

function TJvBrowseForFolderDialog.GetEnumFlags(psf: IShellFolder;
  pidlFolder: PItemIDList; const phWnd: THandle;
  var pgrfFlags: DWORD): HResult;
var
  Flags: TJvBrowsableObjectClasses;
  Obj: TJvBrowsableObjectClass;
begin
  { (rb) Don't know for sure if pgrfFlags is initialized }
  Flags := [];
  for Obj := Low(TJvBrowsableObjectClass) to High(TJvBrowsableObjectClass) do
    if pgrfFlags and CBrowseObjectClasses[Obj] = CBrowseObjectClasses[Obj] then
      Include(Flags, Obj);

  { This seems not to work ?? : }
  //if psf.GetDisplayNameOf(pidlFolder, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet) <> S_OK then
  //  Exit;
  try
    if DoGetEnumFlags(IDListToPath(pidlFolder), Flags) then
      Result := S_OK
    else
      Result := S_FALSE;
  except
    Result := E_UNEXPECTED;
  end;

  pgrfFlags := 0;
  for Obj := Low(TJvBrowsableObjectClass) to High(TJvBrowsableObjectClass) do
    if Obj in Flags then
      Inc(pgrfFlags, CBrowseObjectClasses[Obj]);
end;

function TJvBrowseForFolderDialog.GetOwnerWindow: THandle;
var
  F: TCustomForm;
begin
  // (Ralf Kaiser) Owner maybe a TDataModule
  if Owner is TControl then
    F := GetParentForm(TControl(Owner))
  else
    F := nil;
  if F <> nil then
    {$IFDEF VCL}
    Result := F.Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId(F.Handle)
    {$ENDIF VisualCLX}
  else
  if Owner is TWinControl then
    {$IFDEF VCL}
    Result := (Owner as TWinControl).Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId((Owner as TWinControl).Handle)
    {$ENDIF VisualCLX}
  else
  if (Screen <> nil) and (Screen.ActiveCustomForm <> nil) then
    {$IFDEF VCL}
    Result := Screen.ActiveCustomForm.Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId(Screen.ActiveCustomForm.Handle)
    {$ENDIF VisualCLX}
  else
    Result := GetForegroundWindow;
end;

function TJvBrowseForFolderDialog.GetRootDirectoryPath: string;
begin
  if FRootDirectory = fdNoSpecialFolder then
    Result := FRootDirectoryPath
  else
    Result := CSIDLToPath(FRootDirectory);
end;

procedure TJvBrowseForFolderDialog.HookDialog;
begin
  if FDialogWindow <> 0 then
    FDefWndProc := Pointer(SetWindowLong(FDialogWindow, GWL_WNDPROC,
      Longint(FObjectInstance)));
end;

function TJvBrowseForFolderDialog.IsRootDirectoryPathStored: Boolean;
begin
  Result := (RootDirectory = fdNoSpecialFolder) and (FRootDirectoryPath > '');
end;

procedure TJvBrowseForFolderDialog.MainWndProc(var Msg: TMessage);
begin
  try
    Dispatch(Msg);
  except
    Application.HandleException(Self);
  end;
end;

procedure TJvBrowseForFolderDialog.SetExpanded(const APath: string);
begin
  if FDialogWindow <> 0 then
    { Implicit conversion }
    SetExpandedW(APath);
end;

procedure TJvBrowseForFolderDialog.SetExpanded(IDList: PItemIDList);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETEXPANDED, WPARAM(False), LPARAM(IDList));
end;

procedure TJvBrowseForFolderDialog.SetExpandedW(const APath: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETEXPANDED, WPARAM(True), LPARAM(PWideChar(APath)));
end;

procedure TJvBrowseForFolderDialog.SetOKEnabled(const Value: Boolean);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_ENABLEOK, 0, LPARAM(Value));
end;

procedure TJvBrowseForFolderDialog.SetOKText(const AText: string);
begin
  if FDialogWindow <> 0 then
    { Implicit conversion }
    SetOKTextW(AText);
end;

procedure TJvBrowseForFolderDialog.SetOKTextW(const AText: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETOKTEXT, 0, LPARAM(PWideChar(AText)));
end;

procedure TJvBrowseForFolderDialog.SetOptions(const Value: TOptionsDir);
var
  AddedOptions, RemovedOptions: TOptionsDir;
begin
  if FOptions = Value then
    Exit;

  AddedOptions := Value - (FOptions * Value);
  RemovedOptions := FOptions - (FOptions * Value);

  FOptions := Value;

  { Force correct options }
  if odIncludeUrls in AddedOptions then
    FOptions := FOptions + [odEditBox, odNewDialogStyle, odIncludeFiles];
  if odShareable in AddedOptions then
    FOptions := FOptions + [odNewDialogStyle];
  if odUsageHint in AddedOptions then
    FOptions := FOptions + [odNewDialogStyle] - [odEditBox];
  if odValidate in AddedOptions then
    FOptions := FOptions + [odEditBox];
  if odEditBox in AddedOptions then
    FOptions := FOptions - [odUsageHint];

  if odEditBox in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls, odValidate];
  if odNewDialogStyle in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls, odShareable, odUsageHint];
  if odIncludeFiles in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls];

  { Last check }
  if odEditBox in FOptions then
    FOptions := FOptions - [odUsageHint]
  else
    FOptions := FOptions - [odIncludeUrls, odValidate];
  if odUsageHint in FOptions then
    FOptions := FOptions - [odValidate, odEditBox];
end;

procedure TJvBrowseForFolderDialog.SetRootDirectory(
  const Value: TFromDirectory);
begin
  if (Value = fdNoSpecialFolder) and (FRootDirectory <> fdNoSpecialFolder) then
    FRootDirectoryPath := GetRootDirectoryPath;

  FRootDirectory := Value;
end;

procedure TJvBrowseForFolderDialog.SetRootDirectoryPath(
  const Value: string);
begin
  FRootDirectory := fdNoSpecialFolder;
  FRootDirectoryPath := Value;
end;

procedure TJvBrowseForFolderDialog.SetSelection(const APath: string);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSELECTION, WPARAM(True), LPARAM(Pointer(APath)));
end;

procedure TJvBrowseForFolderDialog.SetSelection(IDList: PItemIDList);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSELECTION, WPARAM(False), LPARAM(IDList));
end;

procedure TJvBrowseForFolderDialog.SetStatusText(const AText: string);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSTATUSTEXT, 0, LPARAM(Pointer(AText)));
end;

procedure TJvBrowseForFolderDialog.SetStatusTextW(const AText: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSTATUSTEXTW, 0, LPARAM(PWideChar(AText)));
end;

function TJvBrowseForFolderDialog.ShouldShow(psf: IShellFolder; pidlFolder,
  pidlItem: PItemIDList): HResult;
var
  StrRet: TStrRet;
begin
  psf.GetDisplayNameOf(pidlItem, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet);

  try
    if DoShouldShow(StrRetToString(pidlItem, StrRet)) then
      Result := S_OK
    else
      Result := S_FALSE;
  except
    Result := E_UNEXPECTED;
  end;
end;

procedure TJvBrowseForFolderDialog.UpdateStatusText(AText: string);
const
  cStatusLabel = $3743;
var
  WindowRect, ItemRect: TRect;
  ItemHandle: THandle;
  LCanvas: TCanvas;
begin
  if [odStatusAvailable, odNewDialogStyle] * FUsedOptions <> [odStatusAvailable] then
    Exit;

  if StatusText <> '' then
    AText := StatusText
  else
  begin
    ItemHandle := GetDlgItem(FDialogWindow, cStatusLabel);
    if ItemHandle <> 0 then
    begin
      GetWindowRect(FDialogWindow, WindowRect);
      GetWindowRect(ItemHandle, ItemRect);
      if Application.MainForm <> nil then
        LCanvas := Application.MainForm.Canvas
      else
      begin
        LCanvas := TCanvas.Create;
        LCanvas.Handle := GetDC(HWND_DESKTOP);
      end;
      AText := MinimizeFileName(AText, LCanvas,
        (WindowRect.Right - WindowRect.Left) - (ItemRect.Left - WindowRect.Left) * 2 - 8);
      if Application.MainForm = nil then
        LCanvas.Free;
    end;
  end;

  SetStatusText(AText);
end;

procedure TJvBrowseForFolderDialog.WMShowWindow(var Msg: TMessage);
begin
  { If the dialog isn't resized, we won't get a WM_SIZE message. Thus we
    respond to the WM_SHOWWINDOW message }

  if not FPositionSet then
    SetDialogPos(FOwnerWindow, FDialogWindow, Position);
  FPositionSet := True;

  inherited;
end;

procedure TJvBrowseForFolderDialog.WMSize(var Msg: TWMSize);
var
  BtnSize: TRect;
  WindowSize: TRect;
begin
  inherited;

  if FHelpButtonHandle <> 0 then
  begin
    GetWindowRect(FHelpButtonHandle, BtnSize);
    GetWindowRect(FDialogWindow, WindowSize);
    ScreenToClient(FDialogWindow, BtnSize.TopLeft);
    ScreenToClient(FDialogWindow, BtnSize.BottomRight);

    SetWindowPos(FHelpButtonHandle, 0, BtnSize.Left,
      WindowSize.Bottom - WindowSize.Top - FHelpButtonHeightDelta,
      BtnSize.Right - BtnSize.Left, BtnSize.Bottom - BtnSize.Top,
      SWP_NOZORDER + SWP_NOACTIVATE);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.