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

Вниз

SHBrowseForFolder открывается пустым   Найти похожие ветки 

 
Дмитрий Белькевич   (2009-03-23 17:16) [0]

Пробую вызывать диалог выбора папки. Диалог открывается без дерева каталога папок.

Код:


function AdvSelectDirectory(const Caption: string; Handle: HWND; const Root: WideString;
var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
AllowCreateDirs: Boolean = True): Boolean;

implementation

function AdvSelectDirectory(const Caption: string; Handle: HWND; const Root: WideString;
var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
AllowCreateDirs: Boolean = True): Boolean;
// callback function that is called when the dialog has been initialized
//or a new directory has been selected

// Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
//ein neues Verzeichnis selektiert wurde
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;
 //var
 //  PathName: array[0..MAX_PATH] of Char;
begin
 case uMsg of
  BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
  // include the following comment into your code if you want to react on the
  //event that is called when a new directory has been selected
  // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
  //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
  {BFFM_SELCHANGED:
  begin
    SHGetPathFromIDList(PItemIDList(lParam), @PathName);
    // the directory "PathName" has been selected
    // das Verzeichnis "PathName" wurde selektiert
  end;}
 end;
 Result := 0;
end;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
const
// necessary for some of the additional expansions
// notwendig fur einige der zusatzlichen Erweiterungen
BIF_USENEWUI = $0040;
BIF_NOCREATEDIRS = $0200;
begin
Result := False;
if not DirectoryExists(Directory) then
 Directory := "";
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;
  OleInitialize(nil);
  with BrowseInfo do
  begin
   hwndOwner := {Application.}Handle;
   pidlRoot := RootItemIDList;
   pszDisplayName := Buffer;
   lpszTitle := PChar(Caption);
   // defines how the dialog will appear:
  // legt fest, wie der Dialog erscheint:
   ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES *
    Ord(ShowFiles) or BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
   lpfn := @SelectDirCB;
   if Directory <> "" then
    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;


Пробовал JvBrowseFolder. Он тоже использует SHBrowseForFolder. В нём похожая проблема. Первый раз открывается без дерева. Второй раз открывается с деревом. Далее нормально открывается до закрытия программы.


 
Дмитрий Белькевич   (2009-03-23 17:18) [1]

Пробовал вызывать с Application.Handle и Form.Handle (над которой показывается диалог). Поведение одинаковое.


 
Rouse_ ©   (2009-03-23 17:35) [2]

http://rouse.drkb.ru/components.php#fwopendirectory


 
Дмитрий Белькевич   (2009-03-23 17:38) [3]

Спасибо, попробую.


 
Дмитрий Белькевич   (2009-03-23 18:58) [4]

Попробовал. Та же проблема, что у Jv. Первый раз появляется без дерева.


 
Rouse_ ©   (2009-03-23 19:50) [5]

Хм... а вызов ShBrowseForFolder ошибку возвращает?


 
Дмитрий Белькевич   (2009-03-23 21:05) [6]

Нашел закономерность.

У меня приложение инициализируется с многопоточной моделью COINIT_MULTITHREADED CoInitializeEx(nil, COINIT_MULTITHREADED);.

У вас - CoInitializeEx(nil, COINIT_APARTMENTTHREADED);

Были у меня подозрения на это. Т.к. баг появился только в новой версии программы, где я вынужден устанавливать COINIT_MULTITHREADED.

Если в приложении ставлю COINIT_APARTMENTTHREADED - то всё нормально работает. Но мне нужен именно COINIT_MULTITHREADED.

Будут ли какие-нибудь идеи?


 
Дмитрий Белькевич   (2009-03-23 21:19) [7]

В Jv:

   if odNewDialogStyle in FUsedOptions then
     CoInitialize(nil);

Всё интереснее :) Чувствую, некоторые неуловимые баги у меня из-за этого вылазили.


 
Дмитрий Белькевич   (2009-03-23 21:21) [8]

Сдаётся мне, что стандартный диалог браузера папок - очередной клиент на выбрасывание...


 
Дмитрий Белькевич   (2009-03-23 21:26) [9]

Тем более, что у меня еще какая-то проблема из-за DisableTaskWindows(0); и/или EnableTaskWindows(WindowList); были. Смотрю - закоментировал я их в Jv как-то. Уже не помню, правда, что конкретно было. Но до CoInitializeEx(nil, COINIT_MULTITHREADED) работало.



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

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

Наверх





Память: 0.47 MB
Время: 0.004 c
2-1260988667
Дмитрий
2009-12-16 21:37
2010.02.14
Заполнение массива из графика


15-1260347327
ford
2009-12-09 11:28
2010.02.14
TRegExpr поогите составить выражение


2-1260883760
Лёша
2009-12-15 16:29
2010.02.14
Turbo Pascal и файлы


2-1260983201
S-C-L
2009-12-16 20:06
2010.02.14
Как в Delphi работать с операторами?


1-1237195269
man Yury
2009-03-16 12:21
2010.02.14
Ошибка 32 при вызове TFileStream





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