Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.11.13;
Скачать: CL | DM;

Вниз

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

 
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;
Скачать: CL | DM;

Наверх




Память: 0.45 MB
Время: 0.036 c
1-41148
Layner
2003-11-03 11:55
2003.11.13
Подскажите, почему StringGrid не получается сменить цвет шрифта?


3-40904
SMOLIN
2003-10-20 10:28
2003.11.13
ado и SQLSERVER 7


1-41270
hepry
2003-10-31 14:38
2003.11.13
Правильная работа с ComboBox csDropDown


1-41455
ewgeny
2003-10-29 11:14
2003.11.13
отработка сообщений Windows


3-41084
нет
2003-10-23 15:28
2003.11.13
Уникальное поле в Парадоксе





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский