Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

How To

Browse Directories and Files by Glenn9999
Posted: 23 Aug 09 (Edited 21 Jun 11)

Just a code sample.  This is a component that encapsulates SHBrowseForFolder and should hold most of the functionality offered through it.

I do not have the capability to test a lot of it, so YMMV.  Please let me know if you find a problem, find it useful, or both.


unit DirBrowseDialog;
  {TDirBrowse component by Glenn9999 at tek-tips.com, updated here 6/21/2011 }

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  shlobj, DsgnIntf;


  CSIDL_PERSONAL = $0005; { My Documents }
  CSIDL_APPDATA = $001A; { Application Data, new for NT4 }
  CSIDL_LOCAL_APPDATA = $001C; { non roaming, user\Local Settings\Application Data }
  CSIDL_COOKIES = $0021;
  CSIDL_HISTORY = $0022;
  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; { My Pictures, new for Win2K }
  CSIDL_PROGRAM_FILES_COMMON = $002b; { C:\Program Files\Common }
  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 }

{ TPathName is an explicit path name designed to be connected to a property
  editor which triggers this control.  It must be defined like this so Delphi
  distinguishes it from regular string types in this control and in other
  controls }
  TPathName = String[255];
  TBDirFlag = (bifBrowseFolders, bifBrowseFiles, bifBrowseComputer,
  TBStartFlag = (ciNone, ciRecycleBin, ciControlPanel,
                 ciDesktopDirectory, ciMyComputer, ciFonts, ciNetHood,
                 ciMyDocuments, ciPrograms, ciRecent, ciSendTo,
                 ciStartMenu, ciStartup, ciTemplates, ciAppdata, ciFavorites,
                 ciHistory, ciInternetCache, ciLocalAppData,
                 ciMyPictures, ciSystem, ciWindows, ciAdminTools,
                 ciCommonAdminTools, ciCommonAppData,
                 ciCookies, ciProgramFiles, ciCommonProgramFiles);

  TBDSelectEvent = procedure (Sender: TObject; selitem: string;
                          var stext: string; var valid: Boolean) of object;

  TStub = packed record
    PopEDX: Byte;
    MovEAX: Byte;
    SelfPointer: Pointer;
    PushEAX: Byte;
    PushEDX: Byte;
    JmpShort: Byte;
    Displacement: Integer;

  // property editor for TPathName within this component
  TPathNameProperty = class(TStringProperty)
      function GetAttributes: TPropertyAttributes; override;
      procedure Edit; override;

  TDirBrowseDialog = class(TCommonDialog)
    // processing variables
    FBrowseInfo : TBrowseInfo;
    FHandle: Cardinal;
    FFlag: Integer;

    FTitle: string;           // title or caption
    FDirName: TPathName;      // path or dir returned
    FStartDir: TPathName;     // directory to start with

    FUserFlag: TBDirFlag;     // determines functionality
    FStartFlag: TBStartFlag;  // determines special start places
    FStatusMsg: Boolean;      // show status messages?
    FNewStyle: Boolean;       // use new display style?
    FCenter: Boolean;         // center the dialog?
    FFSAncestors: Boolean;    // allow only file system ancestors?
    FBelowDomain: Boolean;    // do not go below domain level in network browse?
    FRootDir: Boolean;        // truncate browse in root dir instead of simply select?

    FOnItemSelect: TBDSelectEvent;

    procedure UFlagHandle;
    procedure SFlagHandle;

    function BD_Callback(wnd: hwnd; umsg: uint;
                        lparam, lpdata: lparam): integer; stdcall;
    FMyCallBack: Pointer;
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    function Execute: Boolean; override;

    property Title: string read FTitle write FTitle;
    property StartDir: TPathName read FStartDir write FStartDir;
    property StatusMsg: Boolean read FStatusMsg write FStatusMsg;
    property DirName: TPathName read FDirName write FDirName;
    property UserFlag: TBDirFlag read FUserFlag
                      write FUserFlag default bifbrowsefolders;
    property StartFlag: TBStartFlag read FStartFlag write FStartFlag default ciNone;
    property NewStyle: Boolean read FNewStyle write FNewStyle default false;
    property Centered: Boolean read FCenter write FCenter;
    property FSAncestors: Boolean read FFSAncestors write FFSAncestors;
    property BelowDomain: Boolean read FBelowDomain write FBelowDomain;
    property RootDir: Boolean read FRootDir write FRootDir;
    property OnItemSelect: TBDSelectEvent read FOnItemSelect write FOnItemSelect;

procedure Register;


function CreateStub(ObjectPtr: Pointer; MethodPtr: Pointer): Pointer;
  { Jeroen Mineur's code as found on the Internet.  Allows a class
    method to be called as a procedure in the case of call backs}
    AsmPopEDX = $5A;
    AsmMovEAX = $B8;
    AsmPushEAX = $50;
    AsmPushEDX = $52;
    AsmJmpShort = $E9;
    Stub: ^TStub;
    Stub^.PopEDX := AsmPopEDX;
    Stub^.MovEAX := AsmMovEAX;
    Stub^.SelfPointer := ObjectPtr;
    Stub^.PushEAX := AsmPushEAX;
    Stub^.PushEDX := AsmPushEDX;
    Stub^.JmpShort := AsmJmpShort;
    Stub^.Displacement := (Integer(MethodPtr) - Integer(@(Stub^.JmpShort))) -
      (Sizeof(Stub^.JmpShort) + Sizeof(Stub^.Displacement));
    Result := Stub;

  procedure DisposeStub(Stub: Pointer);
  // dispose of the procedure reference made in createstub

  procedure centercbwindow(wnd: HWnd);
   // centers a window on the screen.
      wa, rect: TRect;
      dialogPT: TPoint;
      wa.Top := 0; wa.Left := 0;
      Wa.Right := Screen.Width; Wa.Bottom := Screen.Height;
      GetWindowRect(Wnd, Rect);
      dialogPT.X := ((wa.Right - wa.Left) div 2) -
                    ((rect.Right - rect.Left) div 2);
      dialogPT.Y := ((wa.Bottom - wa.Top) div 2) -
                    ((rect.Bottom - rect.Top) div 2);
      MoveWindow(Wnd, dialogPT.X, dialogPT.Y, rect.Right - Rect.Left,
                  Rect.Bottom - Rect.Top, True);

  function BD_Callback(wnd: hwnd; umsg: uint; lparam, lpdata: lparam): integer; stdcall;
    // callback function for SHBrowseforfolder through TPathNameProperty
       case uMsg of
         BFFM_INITIALIZED: // initialization code
             SendMessage(wnd, BFFM_SETSELECTIONA, Longint(true), lpdata);
       Result := 0;

  function TPathNameProperty.GetAttributes: TPropertyAttributes;
    // property handler for file dir paths, set attributes for the property
      Result := [paDialog, paReadOnly];
    end {GetAttributes};

  procedure TPathNameProperty.Edit;
    // property handler for file paths.  Returns directory path.
      lpItemID : PItemIDList;
      DisplayName : array[0..MAX_PATH] of char;
      TempPath : array[0..MAX_PATH] of char;
      FBr: TBrowseInfo;
      FillChar(FBr, sizeof(TBrowseInfo), #0);
      with FBr do
          hwndOwner := Application.Handle;
          pszDisplayName := @DisplayName;
          lpszTitle := PChar('Select the value for ' + GetName);
          lpfn := BD_Callback;
          lparam := Longint(PChar(GetValue));
          ulFlags := BIF_RETURNONLYFSDIRS;
      lpItemID := SHBrowseForFolder(FBr);
      if lpItemId <> nil then
          if SHGetPathFromIDList(lpItemID, TempPath) then

  function TDirBrowseDialog.BD_Callback(wnd: hwnd; umsg: uint;
                        lparam, lpdata: lparam): integer; stdcall;
    // callback function for SHBrowseforfolder VCL dialog
       TempPath : array[0..MAX_PATH] of char;
       SText: string;
       valid: Boolean;
       case uMsg of
         BFFM_INITIALIZED: // initialization code
             { set browse directory }
             SendMessage(wnd, BFFM_SETSELECTIONA, Longint(true), lpdata);
             if FCenter then centercbwindow(wnd);
         BFFM_SELCHANGED:  // selection code, handles status message & validation
             SHGetPathFromIDList(PItemIDList(lparam), @TempPath);
             if Assigned(FOnItemSelect) then
                 OnItemSelect(Self, String(TempPath), stext, valid);
                 if valid then
                   SendMessage(wnd, BFFM_ENABLEOK, 1, 1)
                   SendMessage(wnd, BFFM_ENABLEOK, 0, 0);
                 SendMessage(wnd, BFFM_SETSTATUSTEXT, 0, Longint(@stext[1]));
       Result := 0;

Constructor TDirBrowseDialog.Create(AOwner: TComponent);
    FHandle := Application.Handle;
    FMyCallBack := CreateStub(Self, @TDirBrowseDialog.BD_CallBack);

    inherited create(aowner);

Destructor TDirBrowseDialog.Destroy;

procedure TDirBrowseDialog.SFlagHandle;
  // handles the special starting flag
    IDRoot: PItemIDList;
    sflag: integer;
    case FStartflag of
      ciNone: sflag := CSIDL_DESKTOP;
      ciRecycleBin: sflag := CSIDL_BITBUCKET;
      ciControlPanel: sflag := CSIDL_CONTROLS;
      ciDesktopDirectory: sflag := CSIDL_DESKTOPDIRECTORY;
      ciMyComputer: sflag := CSIDL_DRIVES;
      ciFonts: sflag := CSIDL_FONTS;
      ciNetHood: sflag := CSIDL_NETHOOD;
      ciMyDocuments: sflag := CSIDL_PERSONAL;
      ciPrograms: sflag := CSIDL_PROGRAMS;
      ciRecent: sflag := CSIDL_RECENT;
      ciSendTo: sflag := CSIDL_SENDTO;
      ciStartMenu: sflag := CSIDL_STARTMENU;
      ciStartup: sflag := CSIDL_STARTUP;
      ciTemplates: sflag := CSIDL_TEMPLATES;
      ciAppdata: sflag := CSIDL_APPDATA;
      ciFavorites: sflag := CSIDL_FAVORITES;
      ciHistory: sflag := CSIDL_HISTORY;
      ciInternetCache: sflag := CSIDL_INTERNET_CACHE;
      ciLocalAppData: sflag := CSIDL_LOCAL_APPDATA;
      ciMyPictures: sflag := CSIDL_MYPICTURES;
      ciSystem: sflag := CSIDL_SYSTEM;
      ciWindows: sflag := CSIDL_WINDOWS;
      ciAdminTools: sflag := CSIDL_ADMINTOOLS;
      ciCommonAdminTools: sflag := CSIDL_COMMON_ADMINTOOLS;
      ciCommonAppData: sflag := CSIDL_COMMON_APPDATA;
      ciCookies: sflag := CSIDL_COOKIES;
      ciProgramFiles: sflag := CSIDL_PROGRAM_FILES;
      ciCommonProgramFiles: sflag := CSIDL_PROGRAM_FILES_COMMON;
      sFlag := 0;
    SHGetSpecialFolderLocation(FHandle, sflag, IDRoot);
    FBrowseInfo.pidlRoot := IDRoot;

procedure TDirBrowseDialog.UFlagHandle;
  // handles the user functionality flag
    IDRoot: PItemIDList;
    case FUserFlag of
      bifBrowseFolders: Fflag := BIF_RETURNONLYFSDIRS;
      bifBrowseFiles: Fflag := BIF_BROWSEINCLUDEFILES;
      bifBrowseComputer: Fflag := BIF_BROWSEFORCOMPUTER;
      bifBrowsePrinter: Fflag := BIF_BROWSEFORPRINTER;
      Fflag := 0;
    // special cases
        SHGetSpecialFolderLocation(FHandle, CSIDL_NETWORK, IDRoot);
        FBrowseInfo.pidlRoot := IDRoot;
    if Fflag = BIF_BROWSEFORPRINTER then
        SHGetSpecialFolderLocation(FHandle, CSIDL_PRINTERS, IDRoot);
        FBrowseInfo.pidlRoot := IDRoot;
    // not mutually exclusive options
    if FStatusMsg then
      FFlag := FFlag + BIF_STATUSTEXT;
    if FNewStyle then
      FFlag := FFlag + BIF_NEWDIALOGSTYLE;
    if FBelowDomain then
    if FFSAncestors then

function TDirBrowseDialog.Execute: boolean;
    lpItemID : PItemIDList;
    DisplayName : array[0..MAX_PATH] of char;
    TempPath : array[0..MAX_PATH] of char;

    RootIDList: PItemIDList;
    IDesktopFolder: IShellFolder;
    Dummy: Longint;

    FillChar(FBrowseInfo, sizeof(TBrowseInfo), #0);

    // find the ItemIDList for startdir if truncate the dir
    if FRootDir then
        RootIDList := nil;
        if StartDir <> '' then
            IDesktopFolder.ParseDisplayName(FHandle, nil,
                PWideChar(WideString(startdir)), Dummy, RootIDList, Dummy);
            FBrowseInfo.pidlRoot := RootIDList;
    with FBrowseInfo do
        hwndOwner := FHandle;
        pszDisplayName := @DisplayName;
        lpszTitle := PChar(Title);
        lpfn := FMyCallback;
        lparam := Longint(PChar(String(FStartDir)));
        ulFlags := FFlag;
    lpItemID := SHBrowseForFolder(FBrowseInfo);
    if lpItemId <> nil then
        { must check whether the item selected is file system item or not
          display name is selected item if it is a printer or machine and not
          a file or directory }
        if SHGetPathFromIDList(lpItemID, TempPath) then
          FDirName := String(temppath)
          FDirName := String(DisplayName);
        Result := true;
      Result := false;

procedure Register;
  RegisterComponents('Samples', [TDirBrowseDialog]);
// this line below isolates the property editor to this control only
//  RegisterPropertyEditor(TypeInfo(TPathName), TDirBrowseDialog, '', TPathNameProperty);
  RegisterPropertyEditor(TypeInfo(TPathName), nil, '', TPathNameProperty)


Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close