La fonction SelectDirectory est très pratique pour permettre à l'utilisateur de sélectionner un répertoire. Le problème est que la fenêtre s'ouvre un peu n'importe où (sous D7 en tout cas).
Voici une fonction qui permet de placer la fenêtre au centre d'un TRect.
Pour placer au centre de l'écran : R:= Screen.WorkAreaRect;
Pour placer au centre d'une Form : with Form1 do R:= Rect(Left, Top, Left + Width, Top + Height);
...
Si le paramètre ATools = true : accès au bouton 'Nouveau Dossier' et au PopUpMenu système.
Remarque : ShellAPI et ShlObj sont à déclarer dans la clause Uses.
J'espère que ceci vous sera utile...
Thierry
Source / Exemple :
function SelDirCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): integer stdcall;
var
WRect, SRect : TRect;
X, Y : smallInt;
W, H: integer;
begin
if uMsg = BFFM_INITIALIZED then
begin
SRect:= Screen.WorkAreaRect;
X:= LoWord(lpData);
Y:= HiWord(lpData);
GetWindowRect(Wnd, WRect);
W:= WRect.Right - WRect.Left;
H:= WRect.Bottom - WRect.Top;
X:= X - (W div 2);
if X < 0 then X:= 0
else if (X + W) > SRect.Right then X:= SRect.Right - W;
Y:= Y - (H div 2);
if Y < 0 then Y:= 0
else if (Y + H) > SRect.Bottom then Y:= SRect.Bottom - H;
MoveWindow(Wnd, X, Y, W, H, True);
end;
Result := 0;
end;
function SelectDirectoryEx(const Caption: string; var Directory: string; ARect: TRect; ATools: boolean = false): boolean;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
X, Y: smallInt;
begin
Result:= false;
Directory:= '';
X:= ARect.Left + (ARect.Right - ARect.Left) div 2;
Y:= ARect.Top + (ARect.Bottom - ARect.Top) div 2;
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Caption);
if ATools then ulFlags:= BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE
else ulFlags := BIF_RETURNONLYFSDIRS;
lpfn := SelDirCallBack;
lparam:= MakeLong(X, Y);
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
Directory := TempPath;
GlobalFreePtr(lpItemID);
Result:= (Directory <> '');
end;
end;
Conclusion :
L'idée d'employer la fonction CallBack m'a été "soufflée" sur delphi.about.com
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.