Results 1 to 4 of 4

Thread: Browse for folders

  1. #1

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    I'm using the browseforfolders thing (code below) and I'm wondering if it's possible to control where on the screen it appears. Anyone?

    Option Explicit
    Public 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

    Public Const BIF_RETURNONLYFSDIRS = 1
    Public Const MAX_PATH = 260

    Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
    Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
    Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
    Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

    Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
    'Declare variables to be used
    Dim iNull As Integer
    Dim lpIDList As Long
    Dim lResult As Long
    Dim sPath As String
    Dim udtBI As BrowseInfo
    'initialise variables
    With udtBI
    .hwndOwner = hwndOwner
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    'Call the browse for folder API
    lpIDList = SHBrowseForFolder(udtBI)
    'get the resulting string path
    If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    lResult = SHGetPathFromIDList(lpIDList, sPath)
    Call CoTaskMemFree(lpIDList)
    iNull = InStr(sPath, vbNullChar)
    If iNull Then sPath = Left$(sPath, iNull - 1)
    End If
    'If cancel was pressed, sPath = ""
    BrowseForFolder = sPath
    End Function

  2. #2
    Guru Aaron Young's Avatar
    Join Date
    Jun 1999
    Location
    Red Wing, MN, USA
    Posts
    2,177

    Post

    No Problem, the BrowseInfo Structure allows you to specify the Address of a Callback Function which will process the Dialogs Messages, so you can get the Handle of the Dialog Window..

    In a Module..
    Code:
    Option Explicit
    
    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 Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
    
    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
    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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    
    Private Const SWP_NOSIZE = &H1
    Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const WM_CREATE = &H1
    
    Private Function BrowseProc(ByVal hwnd As Long, ByVal msg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
        Dim tRECT As RECT
        If msg = WM_CREATE Then
            'The Dialog is Being Created, so Reposition it Now
            'Get the Current Pos
            Call GetWindowRect(hwnd, tRECT)
            'Center it
            Call SetWindowPos(hwnd, 0&, ((Screen.Width / Screen.TwipsPerPixelX) - (tRECT.Right - tRECT.Left)) / 2, ((Screen.Height / Screen.TwipsPerPixelY) - (tRECT.Bottom - tRECT.Top)) / 2, 0, 0, SWP_NOSIZE)
        End If
    End Function
    
    Private Function GetAddress(ByVal lAddress As Long) As Long
        GetAddress = lAddress
    End Function
    
    Public Function BrowseForFolder(ByVal lHwnd As Long, ByVal sPrompt As String) As String
        Dim tBI As BROWSEINFO
        Dim lList As Long
        Dim lResult As Long
        Dim sPath As String
        
        With tBI
            .hwndOwner = lHwnd
            .lpszTitle = lStrCat(sPrompt, Chr(0))
            .ulFlags = BIF_RETURNONLYFSDIRS
            .lpfnCallback = GetAddress(AddressOf BrowseProc)
        End With
        lList = SHBrowseForFolder(tBI)
        If lList Then
            sPath = Space(260)
            lResult = SHGetPathFromIDList(lList, sPath)
            Call CoTaskMemFree(lList)
            sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)
        End If
        BrowseForFolder = sPath
    End Function
    In the Form..
    Code:
    Private Sub Command1_Click()
        Caption = BrowseForFolder(hwnd, "Select Directory..")
    End Sub
    ------------------
    Aaron Young
    Analyst Programmer
    aarony@redwingsoftware.com
    adyoung@win.bright.net

  3. #3

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    Hi Aaron, thanks for that but I'm getting the following line appearing in red (which I assume is bad):

    .lpfncallback = getAddress(AddressOf BrowseProc)

    I'm using VBA - is this the cause?

  4. #4
    Guru Aaron Young's Avatar
    Join Date
    Jun 1999
    Location
    Red Wing, MN, USA
    Posts
    2,177

    Post

    Yep, I don't believe you can use the AddressOf Function in VBA, sorry, didn't realize you were using VBA.

    ------------------
    Aaron Young
    Analyst Programmer
    aarony@redwingsoftware.com
    adyoung@win.bright.net

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width