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

Вниз

Выбор каталога   Найти похожие ветки 

← →
Шишкин Илья ©   (2004-07-06 12:03) [0]

Как в программе сделать выбор каталога? Раньше всё время пользовался LMDTools. Теперь решил обходиться стандартными средствами...

---

← →
Юрий Зотов ©   (2004-07-06 12:08) [1]

См. SelectDirectory

---

← →
TUser ©   (2004-07-06 12:09) [2]

> LMDTools

Что правда есть такие компоненты :) ?

---

← →
Fay ©   (2004-07-06 12:31) [3]

2TUser ©   (06.07.04 12:09) [2]
Правда.

---

← →
Anatoly Podgoretsky ©   (2004-07-06 12:35) [4]

TUser ©   (06.07.04 12:09) [2]
Правда :-)

---

← →
TUser ©   (2004-07-06 12:38) [5]

А оно расшифровывается так как я думаю или как?

---

← →
Fay ©   (2004-07-06 12:40) [6]

А как ты думаешь?

---

← →
antonn   (2004-07-06 12:45) [7]

> Fay ©   (06.07.04 12:40) [6]
> А как ты думаешь?

LamerMastDietools :)

---

← →
Amoeba ©   (2004-07-06 12:59) [8]

> antonn   (06.07.04 12:45) [7]

Не смешно.

http://www.ceberus.com/lmd/index.php3

---

← →
GuAV ©   (2004-07-06 13:21) [9]

> http://www.ceberus.com/lmd/index.php3

Ну и что? Ну не написали там расшифровку LMD, сути не меняет.

---

← →
Amoeba ©   (2004-07-06 13:30) [10]

> GuAV ©   (06.07.04 13:21) [9]

Откуда у тебя такое отвращение к этой библиотеке?

---

← →
GuAV ©   (2004-07-06 14:09) [11]

Название. Только и всего :)

---

← →
Amoeba ©   (2004-07-06 14:15) [12]

> Название. Только и всего :)

Назови хоть горшком, только в печку не ставь...

---

← →
Шишкин Илья ©   (2004-07-06 14:46) [13]

На самом деле LMDTools один из самых лучших наборов дополнительных компонентов.
---
Вопрос. Как сделать так, чтобы окно от SelectDirectory появлялось в центре экрана?

---

← →
Amoeba ©   (2004-07-06 15:07) [14]

> Как сделать так, чтобы окно от SelectDirectory появлялось
> в центре экрана?

Кажется, такой вопрос уже задавался на форуме.

---

← →
КаПиБаРа ©   (2004-07-06 15:33) [15]

uses IniFiles, ShlObj, ActiveX, Registry;

const
 BIF_NEWDIALOGSTYLE   = $0040;
{$R *.dfm}

// CallBack процедура диалога выбора папки
function BrCbProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
const
_left = 60;
_top = 150;
var
 R: TRect;
 Path: array [0..MAX_PATH] of Char;
begin
 Result := 0;
 // Установка положения окна при инициализации
 if uMsg = BFFM_INITIALIZED then
 begin
   GetWindowRect(Wnd, R);
   SetWindowPos(Wnd, 0, _left, _top, R.Right - R.Left, R.Bottom - R.Top,
   SWP_NOZORDER + SWP_NOACTIVATE);
 end;
 // Открытие заданного каталога
 if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
   SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
 // Отключение кнопки OK при выборе папки
 if uMsg = BFFM_SELCHANGED then
 begin
   if (lParam <> 0) then
   begin
     if SHGetPathFromIDList(PItemIDlist(lParam), Path) and (Path <> "") and DirectoryExists(Path) then
       Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 1)
     else
       Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
   end
   else
     Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
end;

end;

// Модернизированный диалог выбора папки
// В параметре Directory задается каталог который нужно открыть
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
  Buffer := ShellMalloc.Alloc(MAX_PATH);
  try
    RootItemIDList := nil;
    if Root <> "" then
    begin
      SHGetDesktopFolder(IDesktopFolder);
      IDesktopFolder.ParseDisplayName(Application.Handle, nil,
        POleStr(Root), Eaten, RootItemIDList, Flags);
    end;
    with BrowseInfo do
    begin
      hwndOwner := Application.Handle;
      pidlRoot := RootItemIDList;
      pszDisplayName := Buffer;
      lpszTitle := PChar(Caption);
      ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
      lpfn := BrCbProc;
      lParam := Integer(PChar(Directory));
    end;
    WindowList := DisableTaskWindows(0);
    try
      ItemIDList := ShBrowseForFolder(BrowseInfo);
    finally
      EnableTaskWindows(WindowList);
    end;
    Result :=  ItemIDList <> nil;
    if Result then
    begin
      ShGetPathFromIDList(ItemIDList, Buffer);
      ShellMalloc.Free(ItemIDList);
      Directory := Buffer;
    end;
  finally
    ShellMalloc.Free(Buffer);
  end;
end;
end;

---

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

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

Наверх

Память: 0.49 MB
Время: 0.033 c