Главная страница
    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
10-1162891871
312kbps
2006-11-07 12:31
2010.02.14
Помощь в организации Client Server DCOM


15-1260162590
Дмитрий С
2009-12-07 08:09
2010.02.14
Вопрос к админам IIS


2-1260795886
AIK
2009-12-14 16:04
2010.02.14
При клике курсором на едите не появляется фокус


2-1260801136
serhiyiv
2009-12-14 17:32
2010.02.14
FREE TBITMAP


2-1260646194
BenderAnt
2009-12-12 22:29
2010.02.14
TelnetServer





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