Autor Téma: Opendialog  (Přečteno 2490 krát)

Offline jarex

  • Plnoletý
  • ***
  • Příspěvků: 216
  • Karma: 4
Opendialog
« kdy: 25-06-2012, 13:25:43 »
Prosil bych o radu.

Poradil by mi prosím někdo jak donutím Opendialog aby mi vracel název adresáře? Tedy nechci po kliknutí do něj vlézt, ale chci vrátit jeho název s cestou. Díky.
D2007 Professional

Offline KarelHorky

  • Plnoletý
  • ***
  • Příspěvků: 204
  • Karma: 8
    • Verze Delphi: 7, XE6, Delphi 10.2 Tokyo
Re:Opendialog
« Odpověď #1 kdy: 25-06-2012, 14:59:22 »
S pomocí OpenDialog adresář vybereš těžko, leda soubor v adresáři a z něj pak cestu pomocí ExtractFilePath. Pro otevření složek používám níže uvedenou unitu, prohledává i síťové jednotky, prostě cokoliv. Jak jsem našel, tak předávám  :) :
Kód: Delphi [Vybrat]
  1. unit SelDirU;
  2.  
  3. interface
  4. uses Windows, ActiveX, ShlObj;
  5.  
  6. var
  7.   SelectDir           :string;
  8.   BrowseInfo          :TBrowseInfo;
  9.  
  10. function  SelDir(const Caption: string; const Root: WideString; const Select: string;const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;
  11. function  BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall;
  12.  
  13. implementation
  14.  
  15. uses
  16.   Forms, SysUtils;
  17.  
  18.  
  19. function SelDir(const Caption: string; const Root: WideString; const Select: string;
  20.   const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;
  21. var
  22.   Buffer: PChar;
  23.   ItemIDList: PItemIDList;
  24.   ShellMalloc: IMalloc;
  25.   IDesktopFolder: IShellFolder;
  26.   Eaten, Flags: LongWord;
  27.   RootItemIDList: PItemIDList;
  28.   Titulek,Adrs: string;
  29. begin
  30.   Result := False;
  31.   Directory := '';
  32.   SelectDir := Select;
  33.   if Caption='' then Titulek := 'Vyberte adresár:' // nadpis
  34.                 else Titulek := Caption;
  35.   FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  36.   if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
  37.     Buffer := ShellMalloc.Alloc(MAX_PATH);
  38.     try
  39.       if (Length(Root)>0) then begin
  40.         SHGetDesktopFolder(IDesktopFolder);
  41.         IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);
  42.       end
  43.       else
  44.         RootItemIDList := nil;
  45.       with BrowseInfo do begin
  46.         hwndOwner := Application.Handle;
  47.         pidlRoot := RootItemIDList;
  48.         pszDisplayName := Buffer;
  49.         lpszTitle := PChar(Titulek);
  50.         ulFlags := BIF_STATUSTEXT;
  51.         if BrowseFiles then ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES
  52.                        else ulFlags := ulFlags or BIF_RETURNONLYFSDIRS;
  53.         if CreateNewDir then ulFlags := ulFlags or BIF_NEWDIALOGSTYLE;
  54.         lpfn := BrowseCallbackProc;
  55.       end;
  56.       ItemIDList := ShBrowseForFolder(BrowseInfo);
  57.       Result := ItemIDList <> nil;
  58.       if Result then begin
  59.         ShGetPathFromIDList(ItemIDList, Buffer);
  60.         ShellMalloc.Free(ItemIDList);
  61.         Adrs := Buffer;
  62.         if BrowseFiles then
  63.           Directory := Adrs
  64.         else
  65.           Directory := IncludeTrailingPathDelimiter(Adrs);
  66.       end;
  67.     finally
  68.       ShellMalloc.Free(Buffer);
  69.     end;
  70.   end;
  71.  end;
  72.  
  73. function BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall;
  74.  var
  75.   Buffer  : array[0..MAX_PATH - 1] of char;
  76.   Buffer1 : array[0..MAX_PATH - 1] of char;
  77.   hStatus : HWND;
  78.   buff    : AnsiString;
  79.  const
  80.   WM_SETTEXT = $000C;
  81.  begin
  82.   case uMsg of
  83.     BFFM_INITIALIZED:
  84.       begin
  85. //        CenterWindow(Wnd);
  86.         if DirectoryExists(SelectDir) then
  87.           SendMessage(Wnd, BFFM_SETSELECTION, 1, LPARAM(SelectDir));
  88.       end;
  89.     BFFM_SELCHANGED:
  90.       begin
  91.         SHGetPathFromIDList(PItemIDList(lPar), Buffer);
  92.         if (BrowseInfo.ulFlags and BIF_NEWDIALOGSTYLE) = 0 then begin
  93.           SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, Integer(@Buffer));
  94.         end
  95.         else begin
  96.           hStatus := FindWindowEx(Wnd, 0, 'Static', nil);
  97.           if hStatus <> 0 then begin
  98.             buff := BrowseInfo.lpszTitle + #13#13 + Buffer + #0;
  99.             Move(buff[1], Buffer1, Length(buff));
  100.             SendMessage(hStatus, WM_SETTEXT, 0, Integer(@Buffer1));
  101.           end;
  102.         end;
  103.       end;
  104.   end;
  105.   Result := 0;
  106.  end;
  107.  
  108. end.
  109.  
  110.  

K.

Offline jarex

  • Plnoletý
  • ***
  • Příspěvků: 216
  • Karma: 4
Re:Opendialog
« Odpověď #2 kdy: 25-06-2012, 15:44:34 »
Super. Díky moc. Funguje.
D2007 Professional

Offline < z >

  • Administrátoři
  • Guru
  • *****
  • Příspěvků: 1127
  • Karma: 42
    • Verze Delphi: 7, 2010
Re:Opendialog
« Odpověď #3 kdy: 25-06-2012, 17:30:46 »
proc tak slozite, kdyz v Delphi je na to funkce

Kód: Delphi [Vybrat]
  1. SelectDirectory('Select a directory', '', Dir)

Offline Radek Červinka

  • Administrátoři
  • Padawan
  • *****
  • Příspěvků: 2349
  • Karma: 102
    • Verze Delphi: D5,D2007, DXE, DXE2 + 2 poslední (Tokyo)
    • O Delphi v češtině
Re:Opendialog
« Odpověď #4 kdy: 25-06-2012, 22:32:20 »
Méně známá varianta je přes standardní akce (TBrowseForFolder je následníkem TCommonDialogAction). Je to více variabilní než SelectDirectory.

Kód: Delphi [Vybrat]
  1. uses
  2.   StdActns;
  3.  
  4. procedure TForm1.Button1Click(Sender: TObject);
  5. var
  6.   sDir: string;
  7. begin
  8.   with TBrowseForFolder.Create(nil) do
  9.   begin
  10.     try
  11.       Folder := 'c:\Windows';
  12.       BrowseOptions := [
  13.         bifEditBox, bifNewDialogStyle, //bifNoTranslateTargets, bifReturnFSAncestors,
  14.         bifUseNewUI];
  15.  
  16.  
  17.       Execute; // pozor návratová hodnota Execute znamená jen že se nepodařilo akci spusti nebo tak
  18.       if Folder = '' then
  19.         Exit;
  20.  
  21.       sDir := Folder;
  22.     finally
  23.       Free;
  24.     end;
  25.   end;
  26.   ShowMessage(sDir);
  27. end;
  28.  
  29.  
Embarcadero MVP - Czech republic

Offline KarelHorky

  • Plnoletý
  • ***
  • Příspěvků: 204
  • Karma: 8
    • Verze Delphi: 7, XE6, Delphi 10.2 Tokyo
Re:Opendialog
« Odpověď #5 kdy: 26-06-2012, 07:55:34 »
proc tak slozite, kdyz v Delphi je na to funkce

Nevím, jak ve vyšších verzích Delphi, ale v mém D7 dialog SelectDirectory vypadá a funguje jako z Win 95. Proto jsem hledal něco jiného a výsledek jsem uveřejnil nahoře. Ale každý ať si používá, co se mu líbí  :).

Offline Morrison

  • Hrdina
  • ****
  • Příspěvků: 273
  • Karma: 12
    • Verze Delphi: D5, XE2
Re:Opendialog
« Odpověď #6 kdy: 27-06-2012, 15:34:20 »
Nevím, jak ve vyšších verzích Delphi, ale v mém D7 dialog SelectDirectory vypadá a funguje jako z Win 95. Proto jsem hledal něco jiného a výsledek jsem uveřejnil nahoře. Ale každý ať si používá, co se mu líbí  :).

SelectDirectory() jsou dvě verze a vysloveně zastarale vypadá jenom jedna z nich, určitě používáš tu správnou? Vyzkoušeno v D5.
SelectDirectory(Adr,[sdAllowCreate, sdPerformCreate, sdPrompt],0); // zastaraly vzhled
SelectDirectory('Vyberte adresář','',Adr); // tato vypada moderneji
« Poslední změna: 27-06-2012, 15:37:07 od Morrison »
nil

Offline < z >

  • Administrátoři
  • Guru
  • *****
  • Příspěvků: 1127
  • Karma: 42
    • Verze Delphi: 7, 2010
Re:Opendialog
« Odpověď #7 kdy: 28-06-2012, 08:43:58 »
koukal jsem na to vsechno a vsechno to jsou stejne funkce

at uz od KarelHorky "vlastni", SelectDirectory (ten druhy, ne ten stary) nebo ten TBrowseForFolder (ktery je jen v novych Delphi),
vsude je ten samy kod, jen mirne jinak vytuneny ;)