Un selectdirectory qui se place au bon endroit

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.

Du même auteur (ThWilliam)