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_P ATH] of Char;
begin
result:=box.text;
with BrowseInfo do begin
FillChar(BrowseInfo,SizeOf (BrowseInf o),#0);
hwndOwner:=form6.Handle;
pszDisplayName:=@DisplayNa me[0];
lpszTitle:=pchar(title);
ulFlags:=BIF_RETURNONLYFSD IRS or BIF_EDITBOX or $40;
end;
CoInitialize(NIL);
PIDL := SHBrowseForFolder(BrowseIn fo);
if Assigned(PIDL) then
if SHGetPathFromIDList(PIDL,D isplayName ) then
if DisplayName <> '' then
box.text:= IncludeTrailingBackSlash(D isplayName );
end;
thanks
4R.
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
var
BrowseInfo:TBrowseInfo;
PIDL:PItemIDList;
DisplayName:array[0..MAX_P
begin
result:=box.text;
with BrowseInfo do begin
FillChar(BrowseInfo,SizeOf
hwndOwner:=form6.Handle;
pszDisplayName:=@DisplayNa
lpszTitle:=pchar(title);
ulFlags:=BIF_RETURNONLYFSD
end;
CoInitialize(NIL);
PIDL := SHBrowseForFolder(BrowseIn
if Assigned(PIDL) then
if SHGetPathFromIDList(PIDL,D
if DisplayName <> '' then
box.text:= IncludeTrailingBackSlash(D
end;
thanks
4R.
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.
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.
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.
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.
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?
Options: TSelectDirOpts; HelpCtx: Longint
what do I put in there?
could you show me that in a button1, like paste in your unit?
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(Wi ndow: 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(PItemI DList(lPar am), 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:=ExcludeTrailin gBackslash (FDirector y);
// Copy directory to folder string
StrPLCopy(@lpszFolder, FDirectory, MAX_PATH);
// Set browse info fields
if IsWindow(FParent) then
FBrowseInfo.hwndOwner:=FPa rent
else
FBrowseInfo.hwndOwner:=Get DesktopWin dow;
FBrowseInfo.pszDisplayName :=@lpszFol der;
FBrowseInfo.lpszTitle:=Poi nter(FTitl e);
FBrowseInfo.ulFlags:=BIF_R ETURNONLYF SDIRS or BIF_STATUSTEXT;
FBrowseInfo.lpfn:=@BrowseF orFolderCa llBack;
FBrowseInfo.lParam:=Intege r(@lpszFol der);
// Browse for folder
pidlContext:=SHBrowseForFo lder(FBrow seInfo);
// Check result
if Assigned(pidlContext) then
begin
// Resource protection
try
// Get the path from the pidl
if SHGetPathFromIDList(pidlCo ntext, @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(ParentWi ndow: HWND);
begin
// Perform inherited
inherited Create;
// Set working default values
FParent:=ParentWindow;
ZeroMemory(@FBrowseInfo, SizeOf(TBrowseInfo));
SetLength(FTitle, 0);
SetLength(FDirectory, 0);
end;
end.
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, FolderDlg;
Example usage:
procedure TForm1.Button1Click(Sender
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(Wi
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(PItemI
// 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:=ExcludeTrailin
// Copy directory to folder string
StrPLCopy(@lpszFolder, FDirectory, MAX_PATH);
// Set browse info fields
if IsWindow(FParent) then
FBrowseInfo.hwndOwner:=FPa
else
FBrowseInfo.hwndOwner:=Get
FBrowseInfo.pszDisplayName
FBrowseInfo.lpszTitle:=Poi
FBrowseInfo.ulFlags:=BIF_R
FBrowseInfo.lpfn:=@BrowseF
FBrowseInfo.lParam:=Intege
// Browse for folder
pidlContext:=SHBrowseForFo
// Check result
if Assigned(pidlContext) then
begin
// Resource protection
try
// Get the path from the pidl
if SHGetPathFromIDList(pidlCo
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(ParentWi
begin
// Perform inherited
inherited Create;
// Set working default values
FParent:=ParentWindow;
ZeroMemory(@FBrowseInfo, SizeOf(TBrowseInfo));
SetLength(FTitle, 0);
SetLength(FDirectory, 0);
end;
end.
ASKER
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
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.
It's fairly straight forward. I've included the delphi help on the TSelectDirOpts parameter.
procedure TForm1.Button4Click(Sender
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.
ASKER
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
http://www.in4sa.com/browsewithnewfolder.jpg
ASKER
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?
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.
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
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
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.
ASKER
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:\fo lder\')
BrowseFolders('select a folder',form1.edit1,'c:\fo
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.Crea te(Applica tion.Handl e);
// Resource protection
try
// Set title
dlgFolder.Title:=Title;
// Set initial path
dlgFolder.Directory:=Initi alFolder;
// Execute the dialog
if dlgFolder.Execute and Assigned(Box) then Box.Text:=dlgFolder.Direct ory;
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');
function BrowseFolders(Title: String; Box: TEdit; InitialFolder: String): String;
var dlgFolder: TFolderDlg;
begin
// Create the dialog wrapper object
dlgFolder:=TFolderDlg.Crea
// Resource protection
try
// Set title
dlgFolder.Title:=Title;
// Set initial path
dlgFolder.Directory:=Initi
// Execute the dialog
if dlgFolder.Execute and Assigned(Box) then Box.Text:=dlgFolder.Direct
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');
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