Tuesday, 28 July 2009

Mostrar el Dialogo de carpetas

Con delphi no tenemos ningún dialogo para mostrar solo las carpetas. Disponemos de los componentes TDialog que nos permiten abrir ficheros, seleccionarlos o abrir otros tipos de dialogo como los de colores, fuentes, etc. Para cargar solo el dialogo de carpetas, lo tenemos que hacer como siempre se ha hecho, utilizando la Win32 API Shell objects Interface Unit (ShlObj). En ésta unit encontraremos toda la información para ejecutar nuestro dialogo. Aquí os dejo el código fuente sacado de Scalabium Software y unas imágenes de muestra del dialogo.

Con el siguiente código fuente, obtendremos el dialogo mostrado a continuación:




uses
SysUtils
, ShlObj;

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
begin
if (uMsg = BFFM_INITIALIZED) then
SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
BrowseCallbackProc := 0;
end;

function GetFolderDialog(Handle: Integer; Caption: string; var strFolder: string): Boolean;
const
BIF_STATUSTEXT = $0004;
BIF_NEWDIALOGSTYLE = $0040;
BIF_RETURNONLYFSDIRS = $0080;
BIF_SHAREABLE = $0100;
BIF_USENEWUI = BIF_EDITBOX or BIF_NEWDIALOGSTYLE;
var
BrowseInfo: TBrowseInfo;
ItemIDList: PItemIDList;
JtemIDList: PItemIDList;
Path: PAnsiChar;
begin
Result := False;
Path := StrAlloc(MAX_PATH);
SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, JtemIDList);
with BrowseInfo do
begin
hwndOwner := GetActiveWindow;
pidlRoot := JtemIDList;
SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList);
pszDisplayName := StrAlloc(MAX_PATH);
lpszTitle := PChar(Caption);
lpfn := @BrowseCallbackProc;
lParam := LongInt(PChar(strFolder));
end;
ItemIDList := SHBrowseForFolder(BrowseInfo);
if (ItemIDList <> nil) then
if SHGetPathFromIDList(ItemIDList, Path) then
begin
strFolder := Path;
Result := True
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := 'C:\';
if GetFolderDialog(Application.Handle, 'Select a folder', s) then
Edit1.text := s;
end;





0 comments:

Post a Comment