SelectDirectory : erreur "Identifier not found DisableTaskWindows et EnableTaskWindows"

**f5jcg_Lulu** · 01/02/2023, 12h01

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é** · 01/02/2023, 13h03

Bonjour,

Envoyé par f5jcg_Lulu

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** · 01/02/2023, 13h26

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** · 01/02/2023, 15h24

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** · 01/02/2023, 16h21

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** · 01/02/2023, 18h34

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 !

**Jipété** · 03/02/2023, 16h48

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** · 03/02/2023, 17h17

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é** · 03/02/2023, 19h07

Envoyé par f5jcg_Lulu

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 !

Nom : initialdir.png
Affichages : 256
Taille : 16,9 Ko

Nom : initialdir.png
Affichages : 256
Taille : 16,9 Ko

**f5jcg_Lulu** · 04/02/2023, 09h29

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é** · 04/02/2023, 11h23

Envoyé par f5jcg_Lulu

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 ?

SelectDirectory : erreur "Identifier not found DisableTaskWindows et EnableTaskWindows" [Lazarus]

Lazarus Pascal

Vue hybride

Discussions similaires

Partager

Partager