Тема: Отображение текущего каталога в окне выбора каталога

Недавно нашёл код как отобразить окно выбора каталога на языке C++.
Вот этот код:

#include <windows.h>
#include <shlobj.h>
#pragma comment(lib,"shell32")
bool GetFolder (LPTSTR szPath)
{
    szPath[0] = 0;
    bool result = false;
    LPMALLOC pMalloc;
    if (::SHGetMalloc(&pMalloc) == NOERROR) {
        BROWSEINFO bi;
        ::ZeroMemory(&bi,sizeof bi);
        bi.ulFlags = BIF_RETURNONLYFSDIRS;
        LPITEMIDLIST pidl = ::SHBrowseForFolder(&bi);
        if (pidl != NULL) {
            if (::SHGetPathFromIDList(pidl,szPath))
                result = true;
            pMalloc->Free(pidl);
        }
        pMalloc->Release();
    }
    return result;
}

Хотя наша функция и делает то, что нам нужно, но, скорее всего, вы найдёте её возможности слишком скромными. С другой стороны возможности функции ::SHBrowseForFolder позволяют добавить следующую функциональность:
- Установка дескриптора окна-владельца диалога.
- Добавление заголовка к диалогу.
- Отображение текущего каталога.
- Установка каталога по умолчанию.
- Установка корневого каталога.
Я не вижу причин не использовать эти возможности. Изменим нашу функцию.

#include <windows.h>
#include <atlbase.h>
#include <shlobj.h>
#pragma comment(lib,"shell32")
static int CALLBACK
BrowseCallbackProc (HWND hWnd, UINT uMsg, LPARAM lParam, LPARAM lpData)
{
    TCHAR szPath[_MAX_PATH];
    switch (uMsg) {
    case BFFM_INITIALIZED:
        if (lpData)
            SendMessage(hWnd,BFFM_SETSELECTION,TRUE,lpData);
        break;
    case BFFM_SELCHANGED:
        SHGetPathFromIDList(LPITEMIDLIST(lParam),szPath);
        SendMessage(hWnd, BFFM_SETSTATUSTEXT, NULL, LPARAM(szPath));
        break;
    }
    return 0;
}
BOOL GetFolder (LPCTSTR szTitle, LPTSTR szPath, LPCTSTR szRoot, HWND hWndOwner)
{
    if (szPath == NULL)
        return false;
    bool result = false;
    LPMALLOC pMalloc;
    if (::SHGetMalloc(&pMalloc) == NOERROR) {
        BROWSEINFO bi;
        ::ZeroMemory(&bi,sizeof bi);
        bi.ulFlags   = BIF_RETURNONLYFSDIRS;
        // дескриптор окна-владельца диалога
        bi.hwndOwner = hWndOwner;
        // добавление заголовка к диалогу
        bi.lpszTitle = szTitle;
        // отображение текущего каталога
        bi.lpfn      = BrowseCallbackProc;
        bi.ulFlags  |= BIF_STATUSTEXT;
        // установка каталога по умолчанию
        bi.lParam    = LPARAM(szPath);
        // установка корневого каталога
        if (szRoot != NULL) {
            IShellFolder *pDF;
            if (SHGetDesktopFolder(&pDF) == NOERROR) {
                LPITEMIDLIST pIdl = NULL;
                ULONG        chEaten;
                ULONG        dwAttributes;
                USES_CONVERSION;
                LPOLESTR oleStr = T2OLE(szRoot);
                pDF->ParseDisplayName(NULL,NULL,oleStr,&chEaten,&pIdl,&dwAttributes);
                pDF->Release();
                bi.pidlRoot = pIdl;
            }
        }
        LPITEMIDLIST pidl = ::SHBrowseForFolder(&bi);
        if (pidl != NULL) {
            if (::SHGetPathFromIDList(pidl,szPath))
                result = true;
            pMalloc->Free(pidl);
        }
        if (bi.pidlRoot != NULL)
            pMalloc->Free(bi.pidlRoot);
        pMalloc->Release();
    }
    return result;
}

Прототип нашей функции может выглядеть следующим образом:

BOOL GetFolder(LPCTSTR szTitle,LPTSTR szPath,LPCTSTR szRoot=NULL,HWND hWndOwner=NULL);

Уважаемые специалисты языка VisualBasic! Конвертируйте этот код на язык VisualBasic и для помощи Вам привожу ниже код который сам сейчас использую, но в этом коде нет возможности отображения текущего каталога. Поэтому очень Вас прошу добавьте код отображения текущего каталога в код VisualBasic основываясь на коде C++.
Вот код который я использую:

Private Type BrowseInfo
   hOwner As Long
   pIDLRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Function GetFolder(szDialogTitle As String) As String
Dim X As Long, bi As BrowseInfo, dwIList As Long
Dim szPath As String, wPos As Integer
   With bi
      .lpszTitle = szDialogTitle
      .ulFlags = BIF_RETURNONLYFSDIRS + &H40
   End With
   dwIList = SHBrowseForFolder(bi)
   szPath = Space$(512)
   X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
   If X Then
      wPos = InStr(szPath, Chr(0))
      GetFolder = Left$(szPath, wPos - 1)
   Else
      GetFolder = ""
   End If
End Function

Очень Вас прошу, добавьте код отображения текущего каталога в код VisualBasic основываясь на коде C++.
С уважением Михаил.

Re: Отображение текущего каталога в окне выбора каталога

http://www.codeguru.com/vb/controls/vb_ … 3051/#more
http://vbnet.mvps.org/index.html?code/c … llback.htm
И еще кучу ссылок дает великий и могучий Google

Re: Отображение текущего каталога в окне выбора каталога

Спасибо большое Александр!
Остановился на следующем коде:

Option Explicit
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
  hWndOwner      As Long
  pIDLRoot       As Long
  pszDisplayName As Long
  lpszTitle      As Long
  ulFlags        As Long
  lpfnCallback   As Long
  lParam         As Long
  iImage         As Long
End Type
Private m_CurrentDirectory As String   'The current directory
'
Public Function BrowseForFolder(Title As String, StartDir As String) As String
  'Opens a Treeview control that displays the directories in a computer
  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar
  szTitle = Title
  With tBrowseInfo
'    .hWndOwner = owner.hWnd
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT + &H150
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.
  End With
  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
End Function
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
  End Select
  BrowseCallbackProc = 0
End Function
' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

Путём подбора значения &HЧисло в строке:

.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT + &H150

добился чтобы окно было изменяемых размеров.
Правда не могу добиться чтобы сверху окна отображался текстом путь к выбранному каталогу
Может быть Вы знаете Александр как это сделать?

Re: Отображение текущего каталога в окне выбора каталога

> Миша
Я не пишу на VB. Поэтому могу только догадываться, что если в BrowseCallbackProc после Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer) поставить SendMessage(hWnd, WM_SETTEXT, 0, sBuffer) должно меняться в заголовке окна.