We help IT Professionals succeed at work.

Ways to Improve This Function.

4Rabbits
4Rabbits asked
on
603 Views
Last Modified: 2010-04-04
Hi Experts!?

I have this function here that Lets you select a folder, the problem is that it doesn't allow me to select where I'd like to start, how could I make it so I can select where I'd like it to start for example.

BrowseFolders('select folder',edit1,'c:\folder\')

function BrowseFolders(title:string;box:tedit):string;
var
  BrowseInfo:TBrowseInfo;
  PIDL:PItemIDList;
  DisplayName:array[0..MAX_PATH] of Char;
begin
  result:=box.text;
  with BrowseInfo do begin
    FillChar(BrowseInfo,SizeOf(BrowseInfo),#0);
    hwndOwner:=form6.Handle;
    pszDisplayName:=@DisplayName[0];
    lpszTitle:=pchar(title);
    ulFlags:=BIF_RETURNONLYFSDIRS or BIF_EDITBOX or $40;
  end;
    CoInitialize(NIL);
    PIDL := SHBrowseForFolder(BrowseInfo);
  if Assigned(PIDL) then
    if SHGetPathFromIDList(PIDL,DisplayName) then
      if DisplayName <> '' then
        box.text:= IncludeTrailingBackSlash(DisplayName);
end;

thanks
4R.
Comment
Watch Question

Commented:
> >that it doesn't allow me to select where I'd like to start,

Well actually it does, it's held in the pidlRoot member of the TBrowseInfo structure. This should actually be a pointer to an item list (TItemIdList(?)) (LPCITEMIDLIST in C) which contains a short and a byte string (the short is the length, the string the root directory).

You'll find the code at :-

http://www.cryer.co.uk/brian/delphi/howto_browseforfolder.htm

Commented:
Ooops!!

I missed out :-

Alternatively you can do this in the call back by sending the message BFFM_SETSELECTION with a pointer to the directory. This does require a global, whereas the other way requires only the stack.

Commented:
Hi,

I know this doesn't answer your direct question to improve the function.  
But it is an alternative that is already provided by Delphi, so you don't have to write BrowseFolder.

SelectDirectory procedure is found in the FileCtrl unit.

function SelectDirectory(var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload;

So if you call it with the Directory param set to 'c:\abc\def', that is the folder it'll start up in.

Author

Commented:
what do I do with that naartjie?

Options: TSelectDirOpts; HelpCtx: Longint

what do I put in there?


could you show me that in a button1, like paste in your unit?
Russell LibbySoftware Engineer, Advisory
CERTIFIED EXPERT
Top Expert 2005

Commented:
Include the FolderDlg in your form uses clause, eg:

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, FolderDlg;

Example usage:

procedure TForm1.Button1Click(Sender: TObject);
begin

  with TFolderDlg.Create(Handle) do
  begin
     Title:='Testing';
     Directory:='c:\windows\';
     if Execute then ShowMessage(Directory);
     Free;
  end;

end;

-----

Russell

unit FolderDlg;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  FolderDlg
//   Date        :  02.22.2006
//   Author      :  rllibby
//   Description :  Wrapper around the SHBrowseForFolder function call
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, SysUtils, Classes, ComObj, ActiveX, ShlObj;

////////////////////////////////////////////////////////////////////////////////
//   Dialog wrapper
////////////////////////////////////////////////////////////////////////////////
type
  TFolderDlg        =  class(TObject)
  private
     // Private declarations
     FParent:       HWND;
     FTitle:        String;
     FDirectory:    String;
     FBrowseInfo:   TBrowseInfo;
  protected
     // Protected declarations
  public
     // Public declarations
     constructor    Create(ParentWindow: HWND);
     function       Execute: Boolean;
     property       Directory: String read FDirectory write FDirectory;
     property       Title: String read FTitle write FTitle;
  end;

implementation

function BrowseForFolderCallBack(Window: HWND; uMsg: UINT; lParam, lpData: Integer): Integer stdcall;
var  lpszPath:      Array [0..MAX_PATH] of Char;
begin

  // Handle callback message
  case uMsg of
     // Init
     BFFM_INITIALIZED  :  SendMessage(Window, BFFM_SETSELECTION, 1, lpData);
     // Selection changed
     BFFM_SELCHANGED   :
     begin
        // Clear buffer
        ZeroMemory(@lpszPath, SizeOf(lpszPath));
        // Convert pidl to path
        if SHGetPathFromIDList(PItemIDList(lParam), lpszPath) then StrPCopy(@lpszPath, ExtractFileName(lpszPath));
        // Set status text
        SendMessage(Window, BFFM_SETSTATUSTEXT, 0, Integer(@lpszPath));
     end;
  end;

  // Return zero for all messages
  result:=0;

end;

function TFolderDlg.Execute: Boolean;
var  lpszFolder:    Array [0..MAX_PATH] of Char;
     pidlContext:   PItemIDList;
     pvMalloc:      IMalloc;
begin

  // Clear browse info buffer
  ZeroMemory(@FBrowseInfo, SizeOf(TBrowseInfo));

  // Check starting directory
  if (Length(FDirectory) = 2) then
     // Drive only
     FDirectory:=FDirectory+'\'
  else
     // Make sure it does not have trailing backslash
     FDirectory:=ExcludeTrailingBackslash(FDirectory);

  // Copy directory to folder string
  StrPLCopy(@lpszFolder, FDirectory, MAX_PATH);

  // Set browse info fields
  if IsWindow(FParent) then
     FBrowseInfo.hwndOwner:=FParent
  else
     FBrowseInfo.hwndOwner:=GetDesktopWindow;
  FBrowseInfo.pszDisplayName:=@lpszFolder;
  FBrowseInfo.lpszTitle:=Pointer(FTitle);
  FBrowseInfo.ulFlags:=BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
  FBrowseInfo.lpfn:=@BrowseForFolderCallBack;
  FBrowseInfo.lParam:=Integer(@lpszFolder);

  // Browse for folder
  pidlContext:=SHBrowseForFolder(FBrowseInfo);

  // Check result
  if Assigned(pidlContext) then
  begin
     // Resource protection
     try
        // Get the path from the pidl
        if SHGetPathFromIDList(pidlContext, @lpszFolder) then
        begin
           // Set selected directory
           FDirectory:=lpszFolder;
           // Success
           result:=True;
        end
        else
           // Failed to get path
           result:=False;
     finally
        // Get malloc to release memory
        if (SHGetMalloc(pvMalloc) = S_OK) then
        begin
           // Resource protection
           try
              // Free memory
              pvMalloc.Free(pidlContext);
           finally
              // Release the interface
              pvMalloc:=nil;
           end;
        end;
     end;
  end
  else
     // Failure or dialog was cancelled
     result:=False;

end;

constructor TFolderDlg.Create(ParentWindow: HWND);
begin

  // Perform inherited
  inherited Create;

  // Set working default values
  FParent:=ParentWindow;
  ZeroMemory(@FBrowseInfo, SizeOf(TBrowseInfo));
  SetLength(FTitle, 0);
  SetLength(FDirectory, 0);

end;

end.

Author

Commented:
could that also add to make a folder?
Russell LibbySoftware Engineer, Advisory
CERTIFIED EXPERT
Top Expert 2005

Commented:
Not sure I follow you...
Do you want a method of the object to use for creating a folder? Or do want a way in the dialog to create a folder? if you just want to create a folder (eg the user selects a base folder to start in) after the dialog closes, you could just call ForceDirectories out of the filectrl unit.

Unit - FileCtrl
Category - file management routines

function ForceDirectories(Dir: string): Boolean;

if your looking for something else, please explain further.

Regards,
Russell

Commented:
Hi 4R,

It's fairly straight forward.  I've included the delphi help on the TSelectDirOpts parameter.

procedure TForm1.Button4Click(Sender: TObject);
var
  MyDir: string
begin
  if SelectDirectory(MyDir, [sdAllowCreate, sdPrompt], 0) then
  begin
    // do stuff here, if directory was successfully selected...
  end;
end;



type
  TSelectDirOpt = (sdAllowCreate, sdPerformCreate, sdPrompt);
  TSelectDirOpts = set of TSelectDirOpt;

Description

These are the possible values that can be added to the set of options:


sdAllowCreate      An edit box allows the user to type in the name of a directory that does not exist. This option does not create a directory: the application must read the name of the selected directory and create it if desired.
sdPerformCreate      Used only in combination with sdAllowCreate. If the user enters a directory name that does not exist, the directory selection dialog creates it.

sdPrompt      Used only in combination with sdAllowCreate. Displays a message box that informs the user when the entered directory does not exist and asks if the directory should be created. If the user chooses OK, the directory is created if the option set includes sdPerformCreate. If the option set does not include sdPerformCreate, the directory is not created: the application must read the directory name and create it.

sdPrompt      Used only in combination with sdAllowCreate. Displays a message box that informs the user when the entered directory does not exist and asks if the directory should be created. If the user chooses OK, the directory is created if the option set includes sdPerformCreate. If the option set does not include sdPerformCreate, the directory is not created: the application must read the directory name and create it.

Author

Commented:
Hi rllibby, this is what I mean, the original function does this, but it always starts at the very beginning, like to select where, or even last selected.

http://www.in4sa.com/browsewithnewfolder.jpg

Author

Commented:
naartjie


function SelectDirectory(var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload

[Error] Unit1.pas(28): E2029 BEGIN expected but END found

ive copyed this

function SelectDirectory(var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload

put that where functions go,

put a button1 and get that error, what do I do with that?

Commented:
Hi 4R,

You could use it in two ways (button1 and button2 in below eg.).

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, ExtDlgs;

type
  TForm3 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
var
  DirSelected: string;
begin
  if SelectDirectory('Select a folder:', 'c:\', DirSelected) then
    ShowMessage('You selected ' + DirSelected)
  else
    ShowMessage('You did not select a folder');
end;

// Or another way:

procedure TForm3.Button2Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'c:\';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
    ShowMessage('You selected ' + Dir)
  else
    ShowMessage('You did not select a folder');
end;

end.




Author

Commented:
I really like it looking like this http://www.in4sa.com/browsewithnewfolder.jpg :) wile at the same time being able to control the dir with the finction.

BrowseFolders('select a folder',form1.edit1,'c:\folder\')
Software Engineer, Advisory
CERTIFIED EXPERT
Top Expert 2005
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Russell LibbySoftware Engineer, Advisory
CERTIFIED EXPERT
Top Expert 2005

Commented:
You could also create a simple utility function based from the unit code to match what you were originally trying to do:

function BrowseFolders(Title: String; Box: TEdit; InitialFolder: String): String;
var  dlgFolder:     TFolderDlg;
begin

  // Create the dialog wrapper object
  dlgFolder:=TFolderDlg.Create(Application.Handle);

  // Resource protection
  try
     // Set title
     dlgFolder.Title:=Title;
     // Set initial path
     dlgFolder.Directory:=InitialFolder;
     // Execute the dialog
     if dlgFolder.Execute and Assigned(Box) then Box.Text:=dlgFolder.Directory;
  finally
     // Free the object
     dlgFolder.Free;
  end;

  // Check edit control
  if Assigned(Box) then
     // Return results
     result:=Box.Text
  else
     // No edit passed
     SetLength(result, 0);

end;

eg:

  BrowseFolders('Select Folder', Edit1, 'c:\windows');

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.