Un selectdirectory qui se place au bon endroit

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 952 fois - Téléchargée 19 fois

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

Ajouter un commentaire

Commentaires

Cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
32 -
Pour information:

cette portion de code, qui replace le dialogue au centre de la fiche, fait partie intégrante des sources, au moins, depuis TurboDelphi 2006.

Pour les versions de Delphi personnelles ... ben depuis qu'Embarcadero a repris les commandes il n'existe plus de versions gratuites, que des versions d'évaluations d'1 mois.

Alors oui je sais on peut encore télécharger à certains endroits un TurboDelphi mais l'enregistrement de ces produits n'est plus assuré par Embarcadero.
ps:
TuboDelphi Explorer ne m'a jamais empêché de créer et d'utiliser des composants perso et apporte bien plus qu'un D7
ThWilliam
Messages postés
424
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
2 -
@Christophe: merci pour le lien, mais je le connaissais et je ne suis pas certain d'être intéressé par TurboDelphi Explorer.
@Dom: "c'est les "1 mois" qui font problème ?" : eh oui...

A+
Thierry
defis91
Messages postés
66
Date d'inscription
samedi 29 octobre 2005
Statut
Membre
Dernière intervention
8 août 2011
-
Pour jean-jean : tu as compris l'inverse.
Au dela de Delphi7 ces constantes ont été ajoutées.
Le code de Thierry utilise BIF_NEWDIALOGSTYLE, et ne se compile donc pas avec delphi6.
C'est pourquoi j'ai effectué une recherche pour connaitre leur valeur et tester si une simple déclaration suffisait, et la réponse est oui.
extrait en VB (désolé):
'Use the new dialog layout with the ability to resize: SHELL 5.0 or later only!
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)

Pour voir la signification de ces constantes, voir ici par exemple:
http://vbnet.mvps.org/index.html?code/browse/browsenetwork.htm

Pour Thierry, le score de 42% est celui d'un sondage sur les développeurs professionnel uniquement. Si l'on ajoute les non-professionnels, ce score doit surement être plus élevé.
Le lien pour avoir la dernière version gratuite (limitée à un mois)
https://downloads.embarcadero.com/free/delphi
Mais je suis sur que tu connais... c'est les "1 mois" qui font problème ?

Encore merci pour ce code.
A+
Dom
cs_Christophe67
Messages postés
80
Date d'inscription
lundi 2 juin 2003
Statut
Membre
Dernière intervention
15 juin 2012
-
Ah oui j'oubliais , d'après le sondage que j'ai mis sur mon site pour le moment 43% des utilisateurs programment encore avec Delphi7.
www.delphinautes.fr rubrique sondage pour voir les chiffres.
cs_Christophe67
Messages postés
80
Date d'inscription
lundi 2 juin 2003
Statut
Membre
Dernière intervention
15 juin 2012
-
Il y a Turbo Delphi 2006 explorer qui est gratuit, il suffit juste de demander une clé d'activation valable 10.000 jours soit environ 90 ans.
Seul hic tu ne peux installer de composants dans cette version , pour le reste c'est ok et complet.
http://delphi.developpez.com/telecharger/gratuit/turbo-delphi/

Cordialement.

Christophe

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.