Discussion :

[f5jcg_Lulu]

Bonjour,
En utilisant la fonction SelectDirectory j'ai une erreur "Identifier not found DisableTaskWindows et EnableTaskWindows". C'est un code venant directement de la même appli sous Delphi et qui fonctionne bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
function SelectDirectory(const Caption, InitialDir: string; const Root:
WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList,
  ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
  Windows: Pointer;
  Path: string;
begin
  Result := False;
  Directory := '';
  Path := 'D:\Radio\HF\Sauvegardes\Contacts\bin32\Systeme';
  if (Length(Path) > 0) and (Path[Length(Path)] = '\') then
    Delete(Path, Length(Path), 1);
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      SHGetDesktopFolder(IDesktopFolder);
      IDesktopFolder.ParseDisplayName(Application.Handle, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
        if ShowStatus then
          ulFlags := ulFlags or BIF_STATUSTEXT;
        lParam := Integer(PChar(Path));
        lpfn := BrowseCallbackProc;
      end;
 
      Windows := DisableTaskWindows(Application.Handle);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(Windows);
      end;
 
      Result :=  ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

J'ai bien déclaré FileCtrl, ActiveX, ShlObj et ShellAPI dans Uses.

Merci pour votre aide.
Cordialement

[Jipété]

Bonjour,

C'est un code venant directement de la même appli sous Delphi et qui fonctionne bien.

Il existe des choses en Delphi qui n'existent pas en Lazarus.

C'est comme ça, faut s'y faire et retourner tout internet avec les bons mots-clé...
Bienvenue au club !

[f5jcg_Lulu]

Bon, ben me voilà averti. Et ce n'est pas faute d'avoir écumé internet dans tous les sens avec les bons mots-clé (du moins le crois-je). En attendant mieux, retour dare-dare sur Delphi faute de mieux pour l'instant.
Merci. A bientôt

[tourlourou]

Bonjour,
Certaines choses n''existent pas car elles ne sont pas multi-plateformes, par exemple.
J'ai trouvé ici la suggestion d'utiliser pour les remplacer les fonctions Screen.DisableForms et Screen.EnableForms.
Il y aura pê une petite adaptation à faire, mais ça a l'air d'être ça.

[f5jcg_Lulu]

Merci Tourlourou. Mais vu mes "très hautes compétences" une suggestion de code serait la bienvenue et pourquoi pas la modification du code joint à mon message initial. Si c'est possible ce serait super.

[tourlourou]

Bonsoir,
J'ai adapté comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  FileCtrl, ActiveX, ShlObj, ShellAPI, 
  Windows;
 
//
 
function MyBrowseCallBackProc(Wnd: HWND; uMsg: DWORD; lParam, lpData:LPARAM ): integer; stdcall;
begin
 
end;   
 
function SelectDirectory2(const Caption, InitialDir: string; const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
 BrowseInfo: TBrowseInfo;
 Buffer: PChar;
 RootItemIDList,
 ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
 IDesktopFolder: IShellFolder;
 Eaten, Flags: LongWord;
 Windows: TList; //Pointer
 Path: string;
begin
 Result := False;
 Directory := '';
 Path := 'D:\Radio\HF\Sauvegardes\Contacts\bin32\Systeme';
 if (Length(Path) > 0) and (Path[Length(Path)] = '\') then
   Delete(Path, Length(Path), 1);
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);
   try
     SHGetDesktopFolder(IDesktopFolder);
     IDesktopFolder.ParseDisplayName(Application.Handle, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
     with BrowseInfo do
     begin
       hwndOwner := Application.Handle;
       pidlRoot := RootItemIDList;
       pszDisplayName := Buffer;
       lpszTitle := PChar(Caption);
       ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
       if ShowStatus then
         ulFlags := ulFlags or BIF_STATUSTEXT;
       lParam := Integer(PChar(Path));
       lpfn := @MyBrowseCallBackProc;
     end;
 
     Windows := Screen.DisableForms(nil); //DisableTaskWindows(Application.Handle);
     try
       ItemIDList := ShBrowseForFolder(@BrowseInfo);
     finally
       Screen.EnableForms(Windows); //EnableTaskWindows(Windows);
     end;
 
     Result :=  ItemIDList <> nil;
     if Result then
     begin
       ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);
       Directory := Buffer;
     end;
   finally
     ShellMalloc.Free(Buffer);
   end;
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
 sDir: string;
begin
 if SelectDirectory2('Test Caption', 'c:\', 'e:\', true, sDir) then
   ShowMessage(sDir)
 else
   ShowMessage('raté');
end;

Pour le champ TBrowseInfo.lpfn, il attend qu'on lui passe une fonction CallBack du type BFFCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPARAM; _para4:LPARAM):longint;stdcall;.
Cette fonction réagit aux événements/messages de la boîte de dialogue afin de la personnaliser, si j'ai bien compris.
Comme tu n'en as pas fourni, je l'ai laissée vide !

[f5jcg_Lulu]

Merci pour la suggestion. J'ai compris l'adaptation à Screen.DisableForms et Screen.EnableForms. Par contre il y a maintenant un blocage sur la variable ShellMalloc: IMalloc; et ce depuis toujours.
Merci pour ton aide.

Dernière minute : le blocage sur la variable ShellMalloc: IMalloc; ne se produit pas en partant d'une application vide (comme l'exemple de ton message) et tout fonctionne. Curieux !

[Jipété]

Par contre il y a maintenant un blocage sur la variable ShellMalloc: IMalloc; et ce depuis toujours.

un blocage n'est pas un message d'erreur valide pour qu'on comprenne ce qui coince...

[f5jcg_Lulu]

Bonjour Jipété,
Voici quelques messages d'erreur générés lors de la compilation :

Messages, Avertissements : 1
Warning: other unit files search path (aka unit path) of "Contacts" contains "D:\Radio\WebView4Delphi-main\source", which belongs to package "WebView4Delphi"
Compilation du projet, Cible : D:\Radio\WebView4Delphi-main\bin64\contacts.exe : Code de sortie 1, Erreurs : 7, Avertissements : 10, Conseils : 4
contacts.lpr(6,4) Warning: Comment level 2 found
contacts.lpr(8,3) Warning: Comment level 2 found
contacts.lpr(9,3) Warning: Comment level 2 found
contacts.lpr(11,3) Warning: Comment level 2 found
uMainForm.pas(451,15) Error: Identifier not found "IMalloc"
uMainForm.pas(451,22) Error: Error in type definition
uMainForm.pas(462,21) Hint: Local variable "BrowseInfo" does not seem to be initialized
uMainForm.pas(463,29) Error: Call by var for arg no. 1 has to match exactly: Got "<erroneous type>" expected "IMalloc"
shlobj.pp(2552,10) Hint: Found declaration: SHGetMalloc(out IMalloc):LongInt; StdCall;
uMainForm.pas(463,44) Warning: Local variable "ShellMalloc" does not seem to be initialized
uMainForm.pas(463,56) Error: Operator is not overloaded: "<erroneous type>" = "Pointer"
uMainForm.pas(465,26) Error: Illegal qualifier
uMainForm.pas(468,50) Warning: Symbol "Handle" is not portable
uMainForm.pas(468,108) Hint: Local variable "Flags" does not seem to be initialized
uMainForm.pas(471,33) Warning: Symbol "Handle" is not portable
uMainForm.pas(478,18) Warning: Conversion between ordinals and pointers is not portable
uMainForm.pas(493,20) Error: Illegal qualifier
uMainForm.pas(497,18) Error: Illegal qualifier
uMainForm.pas(519,15) Hint: Local variable "fos" does not seem to be initialized
uMainForm.pas(734,50) Warning: Implicit string type conversion with potential data loss from "wvstring" to "AnsiString"
uMainForm.pas(2368,84) Warning: Implicit string type conversion from "RawByteString" to "wvstring"

Alors que tout fonctionne à partir d'une application minimale : la fonction, un bouton et sa procédure Click (voir le message de Tourlourou).

Merci. Cordialement

[f5jcg_Lulu]

Fin d'alerte. Tout fonctionne. J'ai simplement repris le code de Tourlourou mais j'avais oublié de déclarer FileCtrl et ActiveX dans Uses.
Merci à Tourlourou et à Jipété pour leur aide précieuse.
Cordialement à tous

[f5jcg_Lulu]

Bonjour à tous,
Toujours sur mon SelectDirectory qui, je m'empresse de le dire, fonctionne à merveille. J'ouvre une boîte de dialogue "Sélectionner le dossier à copier" puis "Sélectionner le dossier de sortie". Malgré la variable Path := <chemin du dossier à copier> la boîte s'ouvre toujours sur la racine "Ce PC".
J'appelle la boîte par la fonction CopyFolder et la procédure suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
procedure TMainForm.mnSauvegarderSystemeClick(Sender: TObject);
begin
  if(SelectDirectory('Sélectionner le dossier à copier','','',true,repertoireACopier))then
  begin
    if(SelectDirectory('Sélectionner le dossier de sortie','','',true,repertoireDeDestination))then
    begin
      if(CopyFolder(repertoireACopier,repertoireDeDestination))then
      begin
        ShowMessage('Copie effectuée avec succès');
      end
      else
      begin
        ShowMessage('La copie a échoué');
      end;
    end;
  end;
end;

Je ne peux pas dire que ce soit bloquant, tout fonctionne, mais c'est juste irritant ! Tout se passe comme si la variable Path était ignorée.

Merci. Cordialement

[Jipété]

Salustre,

je crois que c'est une histoire d'InitialDir à... initialiser mais je n'en dirai pas plus, je n'utilise quasiment jamais ça, et ggl est ton ami, c'est bien connu,

[f5jcg_Lulu]

Il n'y a pas InitialDir parce que ce n'est pas un contrôle mais une boîte de dialogue Windows.
Cordialement

[Jipété]

Il n'y a pas InitialDir parce que ce n'est pas un contrôle mais une boîte de dialogue Windows.

Mais qu'est-ce que tu racontes ?
Tiens, regarde, à gauche une fiche où j'ai posé un TOpenDialog et à droite l'éditeur de code de Lazarus avec le début de la complétion, où on voit bien qu'elle propose InitialDir !

[f5jcg_Lulu]

Bonjour Jipété,
Je raconte que tu as raison et que je n'ai pas tort . Toi, tu parles des contrôles de la barre de composants de Lazarus présents dans l'onglet Dialogs : TOpenDialog, TSaveDialog, TSaveDirectoryDialog, etc...
Moi, je parle de la boîte de dialogue du système Windows ouverte par la fonction SelectDirectory sans poser aucun contrôle sur ma Form.
Dans Lazarus, ouvre un projet vide, pose un bouton et rentre le code suivant (proposition de Tourlourou qui fonctionne, voir plus haut) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  FileCtrl, ActiveX, ShlObj, ShellAPI, 
  Windows;
 
//
public
      repertoireACopier,repertoireDeDestination:string; 
 
//
 
 
function MyBrowseCallBackProc(Wnd: HWND; uMsg: DWORD; lParam, lpData:LPARAM ): integer; stdcall;
begin
 
end; 
 
function SelectDirectory(const Caption, InitialDir: string; const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
 BrowseInfo: TBrowseInfo;
 Buffer: PChar;
 RootItemIDList,
 ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
 IDesktopFolder: IShellFolder;
 Eaten, Flags: LongWord;
 Windows: TList; //Pointer
 Path: string;
begin
 Result := False;
 Directory := '';
 Path := 'D:\Radio\HF\Sauvegardes\Contacts\bin32\Systeme';
 if (Length(Path) > 0) and (Path[Length(Path)] = '\') then
   Delete(Path, Length(Path), 1);
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);
   try
     SHGetDesktopFolder(IDesktopFolder);
     IDesktopFolder.ParseDisplayName(Application.Handle, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
     with BrowseInfo do
     begin
       hwndOwner := Application.Handle;
       pidlRoot := RootItemIDList;
       pszDisplayName := Buffer;
       lpszTitle := PChar(Caption);
       ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
       if ShowStatus then
         ulFlags := ulFlags or BIF_STATUSTEXT;
       lParam := Integer(PChar(Path));
       lpfn := @MyBrowseCallBackProc;
     end;
 
     Windows := Screen.DisableForms(nil); //DisableTaskWindows(Application.Handle);
     try
       ItemIDList := ShBrowseForFolder(@BrowseInfo);
     finally
       Screen.EnableForms(Windows); //EnableTaskWindows(Windows);
     end;
 
     Result :=  ItemIDList <> nil;
     if Result then
     begin
       ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);
       Directory := Buffer;
     end;
   finally
     ShellMalloc.Free(Buffer);
   end;
 end;
end;
 
function CopyFolder(FromFld, ToFld: string): boolean;
var fos: TSHFileopStruct;
begin
  FromFld := ExcludeTrailingPathDelimiter(Trim(FromFld));
  ToFld := ExcludeTrailingPathDelimiter(Trim(ToFld));
  FillChar(fos, SizeOf(fos),0);
  with fos do
  begin
    wFunc := FO_COPY;
    pFrom := PChar(FromFld+#0);
    pTo   := PChar(ToFld+#0);
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
  end;
  Result := ShFileOperation(fos)=0;
end;     
 
procedure TForm1.Button1Click(Sender: TObject); 
begin
  if(SelectDirectory('Sélectionner le dossier à copier','','',true,repertoireACopier))then
  begin
    if(SelectDirectory('Sélectionner le dossier de sortie','','',true,repertoireDeDestination))then
    begin
      if(CopyFolder(repertoireACopier,repertoireDeDestination))then
      begin
        ShowMessage('Copie effectuée avec succès');
      end
      else
      begin
        ShowMessage('La copie a échoué');
      end;
    end;
  end;
end;

Tu remarqueras qu'il n'y a pas un seul contrôle Dialogs.
Bien sûr, tu modifies la variable Path (ligne en rouge) que tu adaptes à ton besoin. Mais en principe cela importe peu et c'est bien là le problème. Sur mon ordinateur, cette variable n'agit pas.

A+

[Jipété]

Moi, je parle de la boîte de dialogue du système Windows ouverte par la fonction SelectDirectory sans poser aucun contrôle sur ma Form.
Dans Lazarus, ouvre un projet vide, pose un bouton et rentre le code suivant (proposition de Tourlourou qui fonctionne, voir plus haut) :

Admettons (je n'ai pas trop le temps, là), mais pourquoi réinventer la roue ? Ton bout de code m'a renvoyé 20 ans en arrière alors qu'en utilisant l'unité FileUtil (sans "s", contrairement à SysUtils -- pourquoi faire simple quand on peut faire compliqué...), on y trouve, tout en bas,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
// flags for copy
type
  TCopyFileFlag = (
    cffOverwriteFile,
    cffCreateDestDirectory,
    cffPreserveTime
    );
  TCopyFileFlags = set of TCopyFileFlag;
 
// Copy a file and a whole directory tree
function CopyFile(const SrcFilename, DestFilename: string; Flags: TCopyFileFlags=[cffOverwriteFile]; ExceptionOnError: Boolean=False): boolean;
function CopyFile(const SrcFilename, DestFilename: string; PreserveTime: boolean; ExceptionOnError: Boolean=False): boolean;
function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;

À tester, non ?

[f5jcg_Lulu]

Oui je connais et d'ailleurs j'utilise CopyFile dans mon application quand j'impose les 2 dossiers source et destination. Cela fonctionne très bien. Mais avec SelectDirectory je veux imposer le dossier source mais choisir le dossier destination.
Par contre je ne connaissais pas CopyDirTree. Je vais voir.
Merci en tout cas.

[bb84000]

Bonjour,

J'avoue avoir du mal à comprendre cette allergie aux dialogues tout prêts de Lazarus .

Si je reprends le schéma de votre procedure buttonclick, ainsi que la suggestion de Jipété pour la copie, ça donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  s:= 'La copie a échoué';
  SD1.InitialDir:= 'C:\Users\Bernard\Documents\Lazarus\lazbbunits' ; // Remplacer par le nom du dossier source que vous voulez forcer  
  SD1.Filename:= '';
  SD1.Title:= 'Sélectionner le dossier à copier';
  if SD1.Execute then
  begin
    repertoireACopier:= SD1.FileName;
    SD1.InitialDir:= 'C:\temp\'; // Remplacer par le nom du dossier destination par défaut, sinon il va reprendre celui du dossier source
    SD1.Filename:= '';
    if SD1.Execute then
    begin
      repertoireDeDestination:= SD1.FileName;
      SD1.Title:= 'Sélectionner le dossier de destination';
      if CopyDirTree(repertoireACopier, repertoireDeDestination, [cffCreateDestDirectory])  // ajouter le flag cffOverwriteFile si on veut écraser les anciens fichiers
      then s:= 'La copie a réussi';
    end;
  end;
  ShowMessage(s);
end;

On peut laisser en blanc le nom du répertoire dans la zone de saisie des dialogues si les dossiers source et destination par défaut conviennent.

bb84000

[f5jcg_Lulu]

Cette proposition fonctionne très bien dans le cas où le dossier de destination existe déjà. Autrement dit, ce n'est pas le dossier et son contenu qui est copié mais juste son contenu. Il faut donc que le dossier de destination existe.
Cette solution a le mérite d'être simple et de se passer de fonctions.
Dernière minute : j'adopte cette solution après avoir mis le flag cffOverwriteFile car le transfert échoue si le dossier de destination n'est pas vide.
Je vais arrêter là par crainte de devenir saoûlant
Merci à tous pour votre aide et vos suggestions.
Cordialement et bon WE

[tourlourou]

Bonjour,
Sauf méprise, le code était inutilement compliqué, avec des paramètres InitialDir et Root semblant avoir la même fonction, et celui buffer n'ayant pas besoin d'une valeur : c'est automatiquement Root si validation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
function SelectDirectory2(const Caption {, InitialDir}: string; const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
 BrowseInfo: TBrowseInfo;
 Buffer: PChar;
 RootItemIDList, ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
 IDesktopFolder: IShellFolder;
 Eaten, Flags: LongWord;
 Windows: TList; //Pointer
 Path: string;
 Err: HRESULT;
begin
 Result := False;
 Directory := '';
 
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);
 
   try
     SHGetDesktopFolder(IDesktopFolder);
     Flags := 0;
     Err := IDesktopFolder.ParseDisplayName(Application.Handle, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
     {if Err = S_OK then
       ShowMessage('S_OK')
     else
       ShowMessage(LongInt(Eaten).ToString);}
     with BrowseInfo do
     begin
       hwndOwner := Application.Handle; // A handle to the owner window for the dialog box.
       pidlRoot := RootItemIDList; // A PIDL that specifies the location of the root folder from which to start browsing
       pszDisplayName := Buffer; // Pointer to a buffer to receive the display name of the folder selected by the user
       lpszTitle := PChar(Caption);
       ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
       if ShowStatus then
         ulFlags := ulFlags or BIF_STATUSTEXT;
       lParam := 0; //Integer(PChar(Path)); // An application-defined value that the dialog box passes to the callback function, if one is specified in lpfn.
       lpfn := nil; // @MyBrowseCallBackProc;  //
     end;
 
     Windows := Screen.DisableForms(nil); //DisableTaskWindows(Application.Handle);
     try
       ItemIDList := ShBrowseForFolder(@BrowseInfo);
     finally
       Screen.EnableForms(Windows); //EnableTaskWindows(Windows);
     end;
 
     Result :=  ItemIDList <> nil;
     if Result then
     begin
       ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);
       Directory := Buffer;
     end;
   finally
     ShellMalloc.Free(Buffer);
   end;
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
 sDir: string;
 Path: String;
begin
 Path := 'E:\Images\';
 if SelectDirectory2('Test Caption', WideString(Path), true, sDir) then
   ShowMessage(sDir)
 else
   ShowMessage('raté');
end;