Delphi > Obecné

Opendialog

(1/2) > >>

jarex:
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.

KarelHorky:
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 ---unit SelDirU; interfaceuses Windows, ActiveX, ShlObj; var  SelectDir           :string;  BrowseInfo          :TBrowseInfo; function  SelDir(const Caption: string; const Root: WideString; const Select: string;const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;function  BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall; implementation uses  Forms, SysUtils;  function SelDir(const Caption: string; const Root: WideString; const Select: string;  const CreateNewDir: Boolean; const BrowseFiles: Boolean; out Directory: string): Boolean;var  Buffer: PChar;  ItemIDList: PItemIDList;  ShellMalloc: IMalloc;  IDesktopFolder: IShellFolder;  Eaten, Flags: LongWord;  RootItemIDList: PItemIDList;  Titulek,Adrs: string;begin  Result := False;  Directory := '';  SelectDir := Select;  if Caption='' then Titulek := 'Vyberte adresár:' // nadpis                else Titulek := Caption;  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin    Buffer := ShellMalloc.Alloc(MAX_PATH);    try      if (Length(Root)>0) then begin        SHGetDesktopFolder(IDesktopFolder);        IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);      end      else        RootItemIDList := nil;      with BrowseInfo do begin        hwndOwner := Application.Handle;        pidlRoot := RootItemIDList;        pszDisplayName := Buffer;        lpszTitle := PChar(Titulek);        ulFlags := BIF_STATUSTEXT;        if BrowseFiles then ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES                       else ulFlags := ulFlags or BIF_RETURNONLYFSDIRS;        if CreateNewDir then ulFlags := ulFlags or BIF_NEWDIALOGSTYLE;        lpfn := BrowseCallbackProc;      end;      ItemIDList := ShBrowseForFolder(BrowseInfo);      Result := ItemIDList <> nil;      if Result then begin        ShGetPathFromIDList(ItemIDList, Buffer);        ShellMalloc.Free(ItemIDList);        Adrs := Buffer;        if BrowseFiles then          Directory := Adrs        else          Directory := IncludeTrailingPathDelimiter(Adrs);      end;    finally      ShellMalloc.Free(Buffer);    end;  end; end; function BrowseCallbackProc(Wnd: HWND; uMsg: UINT;lPar, lpData: LPARAM): Integer stdcall; var  Buffer  : array[0..MAX_PATH - 1] of char;  Buffer1 : array[0..MAX_PATH - 1] of char;  hStatus : HWND;  buff    : AnsiString; const  WM_SETTEXT = $000C; begin  case uMsg of    BFFM_INITIALIZED:      begin//        CenterWindow(Wnd);        if DirectoryExists(SelectDir) then          SendMessage(Wnd, BFFM_SETSELECTION, 1, LPARAM(SelectDir));      end;    BFFM_SELCHANGED:      begin        SHGetPathFromIDList(PItemIDList(lPar), Buffer);        if (BrowseInfo.ulFlags and BIF_NEWDIALOGSTYLE) = 0 then begin          SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, Integer(@Buffer));        end        else begin          hStatus := FindWindowEx(Wnd, 0, 'Static', nil);          if hStatus <> 0 then begin            buff := BrowseInfo.lpszTitle + #13#13 + Buffer + #0;            Move(buff[1], Buffer1, Length(buff));            SendMessage(hStatus, WM_SETTEXT, 0, Integer(@Buffer1));          end;        end;      end;  end;  Result := 0; end; end.  
K.

jarex:
Super. Díky moc. Funguje.

< z >:
proc tak slozite, kdyz v Delphi je na to funkce


--- Kód: Delphi ---SelectDirectory('Select a directory', '', Dir)

Radek Červinka:
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 ---uses  StdActns; procedure TForm1.Button1Click(Sender: TObject);var  sDir: string;begin  with TBrowseForFolder.Create(nil) do  begin    try      Folder := 'c:\Windows';      BrowseOptions := [        bifEditBox, bifNewDialogStyle, //bifNoTranslateTargets, bifReturnFSAncestors,        bifUseNewUI];        Execute; // pozor návratová hodnota Execute znamená jen že se nepodařilo akci spusti nebo tak      if Folder = '' then        Exit;       sDir := Folder;    finally      Free;    end;  end;  ShowMessage(sDir);end;  

Navigace

[0] Seznam témat

[#] Další strana

Přejít na plnou verzi