2003-12-30 08:53

'*************************************
'API DECLARATION FOR BROWSE FOR FOLDER
'With btn create (see BIF_USENEWUI Const)
'
'USAGE ShowDLGFolder
'RETURN the path of the folder
'
'*************************************
'Change that one !!
     $INCLUDE "rapidq.inc"

     $DEFINE MAX_PATH 260

     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

'This Constant is used to choose a layout for the dlg window.
     CONST BIF_USENEWUI = &H40
'Const BIF_RETURNONLYFSDIRS = 1'This is the standard one...
'----------------------------------------------------------------
     Private DECLARE FUNCTION lstrcat LIB "kernel32" ALIAS "lstrcatA" (BYVAL lpString1 AS STRING, BYVAL lpString2 AS STRING) AS LONG
     Private DECLARE FUNCTION SHBrowseForFolder LIB "shell32" ALIAS "SHBrowseForFolderA"(lpbi AS BrowseInfo) AS LONG
     Private DECLARE FUNCTION SHGetPathFromIDList LIB "shell32" ALIAS "SHGetPathFromIDListA"(BYVAL pidList AS LONG, BYVAL lpBuffer AS STRING) AS LONG
     Private DECLARE SUB CoTaskMemFree LIB "ole32.dll" "AliasCoTaskMemFree"(BYVAL hMem AS LONG)
'----------------------------------------------------------------
'----------------------------------------------------------------

     DECLARE SUB pShowFoldDlg(Sender AS QBUTTON)

     Private FUNCTION ShowDLGFolder() AS STRING
     DIM iNull AS INTEGER
     DIM lpIDList AS LONG
     DIM lResult AS LONG
     DIM sPath AS STRING
     DIM udtBI AS BrowseInfo

    'Set the owner window
     udtBI.hWndOwner = Form.Handle
    'lstrcat appends the two strings and returns the memory address
     udtBI.lpszTitle = lstrcat("C:\", "")
    'Return only if the user selected a directory
     udtBI.ulFlags = BIF_USENEWUI

    'Show the 'Browse for folder' dialog
     lpIDList = SHBrowseForFolder(udtBI)
     IF lpIDList THEN
      sPath = STRING$(MAX_PATH, 0)
        'Get the path from the IDList
      SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
      CoTaskMemFree lpIDList
      iNull = INSTR(sPath, "")
      IF iNull THEN
            'on ne passe pas ici -:)
       sPath = LEFT$(sPath, iNull - 1)
      END IF
     END IF
     ShowDLGFolder = sPath
     END SUB


     CREATE Form AS QFORM
      CAPTION = "Test browse for folder"
      CREATE btnFolder AS QBUTTON
       CAPTION = "Show"
       OnClick = pShowFoldDlg
      END CREATE
      SHOWMODAL
     END CREATE

     SUB pShowFoldDlg
      MESSAGEBOX(ShowDlgFolder,"",0)
     END SUB

2003-12-30 08:53