Link to home
Start Free TrialLog in
Avatar of 4Rabbits
4Rabbits

asked on

Ways to Improve This Function.

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.
Avatar of BigRat
BigRat
Flag of France image

> >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
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.
Avatar of naartjie
naartjie

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.

Avatar of 4Rabbits

ASKER

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?
Avatar of Russell Libby
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.
could that also add to make a folder?
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

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.
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
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?
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.




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\')
ASKER CERTIFIED SOLUTION
Avatar of Russell Libby
Russell Libby
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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');