Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Вниз

Как вызвать стандартный диалог выбора папки?   Найти похожие ветки 

 
lipskiy   (2003-10-24 00:15) [0]

Не используя RX (D7)?


 
MBo   (2003-10-24 00:16) [1]

selectdirectory


 
Романов Р.В.   (2003-10-24 06:30) [2]

Модернизированный диалог открытия папки
const
BIF_NEWDIALOGSTYLE = $0040;

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);
if uMsg = BFFM_SELCHANGED then
begin
if (lParam <> 0) then
begin
if SHGetPathFromIDList(PItemIDlist(lParam), 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;

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;


 
LexXP   (2003-10-24 09:55) [3]

Примерно вот так


function BrowseFolder(Parent:hWnd=0): string;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName,TempPath : array[0..MAX_PATH-1] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo),#0);
BrowseInfo.hwndOwner:=Parent;
BrowseInfo.pszDisplayName:=DisplayName;
BrowseInfo.lpszTitle:="


 
lipskiy   (2003-10-27 18:39) [4]

Всем спасибо!



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

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

Наверх





Память: 0.45 MB
Время: 0.04 c
7-42160
Fontom
2003-09-02 11:38
2003.11.13
COM порт (Таймауты)


8-41761
AlexRush
2003-07-07 15:05
2003.11.13
Звуковая карта - настройка и съём входящего потока


8-41749
Vik_mix
2003-07-10 21:39
2003.11.13
Воспроизведение mp3


1-41462
TRyaSS
2003-10-29 09:37
2003.11.13
Загрузка программ


1-41201
yozhik
2003-11-04 19:26
2003.11.13
Картинка на fsMDIForm





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский