Форум: "Начинающим";
Текущий архив: 2008.04.06;
Скачать: [xml.tar.bz2];

Вниз

Помогите с SaveDialog   Найти похожие ветки 

← →
Toha   (2008-03-10 13:03) [0]

Добрый день. Как в SaveDialog выбрать только папку для сохранения?

---

← →
DrPass ©   (2008-03-10 14:15) [1]

Взять вместо SaveDialog функцию SelectDirectory

---

← →
Дмитрий Патрушев ©   (2008-03-11 23:09) [2]

Сделай отдельную форму с Shell-компонентами или DirectoryListBox

---

← →
Loginov Dmitry ©   (2008-03-11 23:40) [3]

Вот один из вариантов диалого выбора папки:


function SelectDirectoryEx(var APath: string; const Title: string = ""; CanCreateDir: Boolean = False): Boolean;

implementation

uses
 ShlObj;

threadvar
 StoreBrowsePath: string;

function SelectDirectoryEx(var APath: string; const Title: string = ""; CanCreateDir: Boolean = False): Boolean;

 function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
 begin
   Result := 0;
   if uMsg = BFFM_INITIALIZED then
     SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(StoreBrowsePath)))
 end;

var
 ItemID: Pointer;
 BrowseInfo: TBrowseInfo;
 DisplayName, Path: array [0..MAX_PATH] of Char;
begin
 Result := False;

 {Запоминаем переданный путь, иначе callback-функция BrowseCallbackProc не сможет
  получить доступ к строке APath}
 StoreBrowsePath := APath;

 ZeroMemory(@BrowseInfo, SizeOf(BrowseInfo));

 BrowseInfo.hwndOwner := GetActiveWindow;
 BrowseInfo.pszDisplayName := @DisplayName;
 BrowseInfo.lpszTitle := PChar(Title);
 BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX;
 if CanCreateDir then
   BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE;
 BrowseInfo.lpfn:= @BrowseCallbackProc;

 ItemID:= SHBrowseForFolder(BrowseInfo);
 if ItemID <> nil then
 try
   SHGetPathFromIDList(ItemID, Path);
   if DirectoryExists(Path) then
   begin
     APath := Path;
     Result := True;
   end;
 finally
   GlobalFreePtr(ItemID);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 APath: string;
begin
 APath := Caption;
 if SelectDirectoryEx(APath, "Выберите каталог", True) then
   Caption := APath;
end;


---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.04.06;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.007 c