Mega Code Archive
Use Browse Folder Dialog example
<![CDATA[
Title: Use Browse Folder Dialog example
Question: How to use Browse Folder Dialog of Windows ?
It's a example to do that.
Answer:
unit ScreenBrowseForFolder;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons,
ShlObj; // TBrowseInfo, pItemIDList
type
TFormFolderBrowse = class(TForm)
ButtonBrowse: TButton;
Memo1: TMemo;
EditFolderName: TEdit;
SpeedButtonUp: TSpeedButton;
procedure ButtonBrowseClick(Sender: TObject);
procedure SpeedButtonUpClick(Sender: TObject);
procedure EditFolderNameChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
PROCEDURE FreePIDL(PIDL: pItemIDList); StdCall;
var
FormFolderBrowse: TFormFolderBrowse;
implementation
{$R *.DFM}
USES
FileCtrl; // DirectoryExists
// Direct call to undocumented Windows function
PROCEDURE FreePIDL; EXTERNAL 'Shell32.DLL' INDEX 155;
FUNCTION BrowseCallback(Wnd : hWND;
MessageID: UINT;
Param: LPARAM;
Data: LPARAM): INTEGER STDCALL;
VAR
Name: ARRAY[0..MAX_PATH] OF CHAR;
pIDL: pItemIDList;
s : STRING;
BEGIN
CASE MessageID OF
BFFM_INITIALIZED:
BEGIN
FormFolderBrowse.Memo1.Lines.Add('BFFM_INITIALIZED (' + IntToStr(MessageID) + ')');
IF (LENGTH(FormFolderBrowse.EditFolderName.Text) 0) AND
DirectoryExists(FormFolderBrowse.EditFolderName.Text)
THEN BEGIN
SendMessage(Wnd, BFFM_SETSELECTION, Integer(TRUE),
Integer( pChar(FormFolderBrowse.EditFolderName.Text) ) );
END
END;
BFFM_SELCHANGED:
BEGIN
FormFolderBrowse.Memo1.Lines.Add('BFFM_SELCHANGED (' + IntToStr(MessageID) + ')');
END;
BFFM_ENABLEOK:
BEGIN
FormFolderBrowse.Memo1.Lines.Add('BFFM_ENABLEOK (' + IntToStr(MessageID) + ')');
END;
BFFM_SETSELECTION:
BEGIN
FormFolderBrowse.Memo1.Lines.Add('BFFM_ENABLEOK (' + IntToStr(MessageID) + ')');
END;
ELSE
// ignore
END;
pIDL := Pointer(Param);
s := '';
IF Assigned(PIDL)
THEN SHGetPathFromIDList(pIDL, Name);
FormFolderBrowse.Memo1.Lines.Add(' ' + IntToStr(MessageID) + ' ' + IntToStr(Data) + ' ' + Name );
RESULT := 0
END {BrowseCallback};
procedure TFormFolderBrowse.ButtonBrowseClick(Sender: TObject);
VAR
BrowseInfo : TBrowseInfo;
ItemIDList : pItemIDList; // some would use PIDL here
DisplayName: ARRAY[0..MAX_PATH] OF CHAR;
begin
BrowseInfo.hwndOwner := Handle;
BrowseInfo.pidlRoot := NIL;
BrowseInfo.pszDisplayName := @DisplayName[0];
BrowseInfo.lpszTitle := 'Select Directory';
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
BrowseInfo.lpfn := BrowseCallback;
BrowseInfo.lParam := 0;
BrowseInfo.iImage := 0;
// Display browse folder set as the return value to itemlist
ItemIDList := SHBrowseForFolder(BrowseInfo);
TRY
// Get directory from the ItemIDList
IF Assigned(ItemIDList)
THEN
IF SHGetPathFromIDList(ItemIDList, DisplayName)
THEN BEGIN
EditFolderName.Text := DisplayName;
Memo1.Lines.Add(' Icon index = ' + IntToStr(BrowseInfo.iImage));
SpeedButtonUp.Enabled := (StrLen(DisplayName) 0)
END;
FINALLY
FreePIDL(ItemIDList)
END
end;
{$IFNDEF VER130} // If not Delphi 5
FUNCTION ExcludeTrailingBackSlash(CONST s: STRING): STRING;
BEGIN
RESULT := s;
IF RESULT[LENGTH(s)] = '\'
THEN SetLength(RESULT, LENGTH(RESULT)-1)
END {ExcludeTrailingBackSlash};
{$ENDIF}
procedure TFormFolderBrowse.SpeedButtonUpClick(Sender: TObject);
begin
IF (LENGTH(EditFolderName.Text) 0) AND
DirectoryExists(EditFolderName.Text)
THEN BEGIN
EditFolderName.Text := ExcludeTrailingBackSlash( ExtractFilePath(EditFolderName.Text) )
END;
// Kludge: Must have X:\ instead of X: to re-start search
IF (LENGTH(EditFolderName.Text) = 2) AND (EditFolderName.Text[2] = ':')
THEN EditFolderName.Text := EditFolderName.Text + '\'
end;
procedure TFormFolderBrowse.EditFolderNameChange(Sender: TObject);
begin
SpeedButtonUp.Enabled := (LENGTH(EditFolderName.Text) 0)
end;
end.
]]>