Browse for Folder 2022

[Michael Mattias]

Seems like a lot of effort for very little gain and loss of a lot of functionality. Apart from fancy fonts, what does it do that this doesn't?

DISPLAY BROWSE (or DISPLAY OPENFILE) does not include access to the callback functions provided in the underlying Windows API function used to implement the statements.

See: Explorer-Style hook Procedures for OpenFileDialog and SaveFileDialog 3-31-07

They are, however, a bit easier to use than the Common Dialog functions when you don't need/want all the bells and whistles.

[George Bleck]

Delete the "ONLY" in the "ONLY 16" and it switches from BFFolder to BFFolder OR BFFile

Will need a little work to remove the trailing "\" for files though, but that's the point of your own code; customize as you want it.





*** ADDED LATER: Feature now exists and code updated. The config UDT now includes the ability to supply the GetAttrib/DIR$ attributes as well as acknowledge the DIR$ "ONLY" clause.

[David Clarke]

Very cool George!

[George Bleck]

ANYTHING you want it to... it's pure code. Want it different color, different layout, want larger fonts/icons for the sight impaired, like gradients, bitmap backgrounds, want it to read what's in the path, want it SDK vs DDT, etc....

The Windows BFF does NOT fit my needs and looks ugly so this (and the original framework) was the solution.

You, as one of the senior and respected programmers here... am surprised to hear you say it's a loss of functionality. Just add what and only what you want in code. Plus others have asked for similar code.

I do have one simple ask, can you please show me how your example can JUST display local hard drives and their child hierarchy (one of my specific needs)?

[Stuart McLachlan]

Seems like a lot of effort for very little gain and loss of a lot of functionality. Apart from fancy fonts, what does it do that this doesn't?
'

#COMPILE EXE
#DIM ALL
FUNCTION PBMAIN () AS LONG
    LOCAL sFoldername AS WSTRING
    DISPLAY BROWSE 0, ,, "Select Folder","",%BIF_NEWDIALOGSTYLE  TO sFolderName
    MSGBOX sFolderName
END FUNCTION
'

N

[George Bleck]

So, I was bored and decided to re-visit my self rolled BFF routine. Yes this is "source code" but I figured I'd be adding to this on a whim so I am plopping it here... have fun...

'----------------------------------------------------------------------------(')

' Comment out %libBFFTestEXE to switch from a test EXE to an INCLUDE
%libBFFTestEXE = 1

'----------------------------------------------------------------------------(')

#IF %DEF(%libBFFTestEXE)
  #COMPILE EXE "BFFTest.exe"
  %UNICODE = 1    ' Not Required but will switch code to UNICODE support if defined
  ' PBS SECTION BEGIN === REQUIRED Somewhere at top of code
  #IF %DEF(%Unicode)
    MACRO PBSTRING = WSTRING
    MACRO PBSTRINGZ = WSTRINGZ
  #ELSE
    MACRO PBSTRING = STRING
    MACRO PBSTRINGZ = STRINGZ
  #ENDIF
  ' PBS SECTION END === REQUIRED Somewhere at top of code
#ENDIF

'----------------------------------------------------------------------------(')

TYPE libBFFType
  hDlg AS DWORD                   ' libBFF Dialog Handle
  lngAttribFlag AS LONG           ' Attributes to match, Defaults to 16 (Dirs) when OPT is missing
  lngIgnoreOnlyFlag AS LONG       ' Ignore ONLY for atributes, 1=True, 0=False, defaults to 0=False (use ONLY)
  strTVFName AS PBSTRINGZ * 32    ' Treeview Font Name
  lngTVFPnts AS LONG              ' Treeview Font Point Size
  lngTVFStl AS LONG               ' Treeview Font Style
  strPathFName AS PBSTRINGZ * 32  ' Path Font Name
  lngPathFPnts AS LONG            ' Path Font Point Size
  lngPathFStl AS LONG             ' Path Font Style
  strBtnFName AS PBSTRINGZ * 32   ' Treeview Font Name
  lngBtnFPnts AS LONG             ' Button Font Point Size
  lngBtnFStl AS LONG              ' Button Font Style
END TYPE

'----------------------------------------------------------------------------(')

#IF %DEF(%libBFFTestEXE)
  #INCLUDE "Win32API.inc"   ' José Roca vIII.107
  #INCLUDE "PBForms.inc"    ' REQUIRED Somewhere near top of includes if using PBFormsInitComCtls to Init Common Controls
  FUNCTION PBMAIN()
    LOCAL v_strPath AS PBSTRING
    LOCAL v_udtBFF AS libBFFType
    PBFormsInitComCtls(%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES)    ' REQUIRED early in a code block to Init Common Controls
    ' v_udtBFF is OPTIONAL and not needed (uses "Arial,12,0" by default for each font if not defined)
    v_udtBFF.lngAttribFlag = 39    ' If you do use the OPT v_udtBFF then you should define this using GetAttrib values, 0 for BFFile, 16 for BFFolder, etc.
    v_udtBFF.strPathFName = "Brush Script MT Italic"
    v_udtBFF.lngPathFPnts = 14
    IF fn_libBFF(%HWND_DESKTOP, "Test the boundaries...", v_strPath, v_udtBFF) THEN
      MSGBOX "The path was: " + CHR$(13, 10, 13, 10) + v_strPath
    ELSE
      MSGBOX "No path selected"
    END IF
  END FUNCTION
#ENDIF

'----------------------------------------------------------------------------(')

%libBff_Dialog = 100
%libBff_tvcFileSystem = 101
%libBff_edtPath = 102
%libBff_btnAccept = 103
%libBff_btnCancel = 104
%libBff_lblFakeGripper = 105
%libBff_LocalDrive = (%DRIVE_FIXED OR %DRIVE_REMOVABLE)

'----------------------------------------------------------------------------(')

FUNCTION fn_GetImgListIconIdx(BYVAL v_pudtBFF AS libBFFType PTR, BYREF v_strPath AS PBSTRING) AS DWORD
  LOCAL v_udtSHFI AS SHFILEINFO
  v_strPath = RTRIM$(v_strPath, "\")
  SHGETFILEINFO BYCOPY v_strPath, 0, v_udtSHFI, SIZEOF(v_udtSHFI), %SHGFI_SMALLICON OR %SHGFI_SYSICONINDEX
  FUNCTION = v_udtSHFI.iIcon + 1    ' "+ 1" because PB ImageLists are 1 based
END FUNCTION

'----------------------------------------------------------------------------(')

FUNCTION fn_GetTVPath(BYVAL v_pudtBFF AS libBFFType PTR, BYVAL v_hItem AS DWORD) AS PBSTRING
  LOCAL v_strPath AS PBSTRING
  LOCAL v_strText AS PBSTRING
  LOCAL v_udtTVI AS TV_ITEM
  DO WHILE (v_hItem <> %TVI_ROOT)
    TREEVIEW GET TEXT @v_pudtBFF.hDlg, %libBff_tvcFileSystem, v_hItem TO v_strText
    v_strPath = TRIM$(v_strText, "\") + "\" + v_strPath
    TREEVIEW GET PARENT @v_pudtBFF.hDlg, %libBff_tvcFileSystem, v_hItem TO v_hItem
  LOOP UNTIL v_hItem = 0
  IF (GETATTR(v_strPath) AND 16) THEN
    FUNCTION = v_strPath
  ELSE
    FUNCTION = TRIM$(v_strPath, "\")
  END IF
END FUNCTION

'----------------------------------------------------------------------------(')

FUNCTION fn_PathHasChildren(BYVAL v_pudtBFF AS libBFFType PTR, BYREF v_strPath AS PBSTRING) AS LONG
  IF ISFOLDER(v_strPath) THEN
    IF LEN(DIR$(RTRIM$(v_strPath, "\") + "\*.*", 16)) THEN
      FUNCTION = %TRUE
      DIR$ CLOSE
    END IF
  END IF
END FUNCTION

'----------------------------------------------------------------------------(')

SUB sub_InsertTVI(BYVAL v_pudtBFF AS libBFFType PTR, BYVAL v_hParent AS DWORD, BYREF v_strPath AS PBSTRING, BYREF v_strText AS PBSTRING)
  LOCAL v_dwdIconIdx AS DWORD
  LOCAL v_hItem AS DWORD
  LOCAL v_strNewPath AS PBSTRING
  LOCAL v_udtTVI AS TV_ITEM
  IF LEN(v_strPath) THEN
    v_strNewPath = v_strPath + v_strText
    v_dwdIconIdx = fn_GetImgListIconIdx(v_pudtBFF, v_strNewPath)
  ELSE
    v_strNewPath = v_strText
    v_dwdIconIdx = fn_GetImgListIconIdx(v_pudtBFF, v_strNewPath)
  END IF
  TREEVIEW INSERT ITEM @v_pudtBFF.hDlg, %libBff_tvcFileSystem, v_hParent, %TVI_LAST, v_dwdIconIdx, v_dwdIconIdx, v_strText TO v_hItem
  IF fn_PathHasChildren(v_pudtBFF, v_strNewPath) THEN
    v_udtTVI.cChildren = 1
    v_udtTVI.mask = %TVIF_CHILDREN
    v_udtTVI.hItem = v_hItem
    TreeView_SetItem GETDLGITEM(@v_pudtBFF.hDlg, %libBff_tvcFileSystem), v_udtTVI
  END IF
END SUB

'----------------------------------------------------------------------------(')

SUB sub_PopulateLocalDrives(BYVAL v_pudtBFF AS libBFFType PTR)
  LOCAL v_boolImgListSet AS LONG
  LOCAL v_hSysImgList AS DWORD
  LOCAL v_lngDrive AS LONG
  LOCAL v_lngType AS LONG
  LOCAL v_strPath AS PBSTRINGZ * 4
  LOCAL v_udtSHFI AS SHFILEINFO
  FOR v_lngDrive = 65 TO 90    ' A to Z
    v_strPath = CHR$(v_lngDrive, ":\")
    v_lngType = GETDRIVETYPE(v_strPath)
    IF (v_lngType AND %libBff_LocalDrive) = %libBff_LocalDrive THEN
      IF ISFALSE(v_boolImgListSet) THEN    ' Get the System Image List, but only need to do it on the first drive found
        v_hSysImgList = SHGETFILEINFO(v_strPath, 0, v_udtSHFI, SIZEOF(v_udtSHFI), %SHGFI_USEFILEATTRIBUTES OR %SHGFI_SMALLICON OR %SHGFI_SYSICONINDEX)
        TREEVIEW SET IMAGELIST @v_pudtBFF.hDlg, %libBff_tvcFileSystem, v_hSysImgList
        v_boolImgListSet = %TRUE
      END IF
      sub_InsertTVI v_pudtBFF, %TVI_ROOT, "", BYCOPY v_strPath
    END IF
  NEXT v_lngDrive
END SUB

'----------------------------------------------------------------------------(')

SUB sub_ExpandTVI(BYVAL v_pudtBFF AS libBFFType PTR, BYVAL v_hItem AS DWORD)
  LOCAL v_lngCount AS LONG
  LOCAL v_lngIdx AS LONG
  LOCAL v_strArray() AS PBSTRING
  LOCAL v_strPath AS PBSTRING
  LOCAL v_strText AS PBSTRING
  LOCAL v_udtTVI AS TV_ITEM
  v_strPath = fn_GetTVPath(v_pudtBFF, v_hItem)
  if IsTrue(@v_pudtBFF.lngIgnoreOnlyFlag) THEN
    v_strText = DIR$(v_strPath + "\*.*", @v_pudtBFF.lngAttribFlag OR 16) ' Always "OR 16" or TV Subdirs won't show
  ELSE
    v_strText = DIR$(v_strPath + "\*.*", ONLY @v_pudtBFF.lngAttribFlag OR 16) ' Always "OR 16 to get the SUBDIRs in the TV
  END IF
  IF LEN(v_strText) THEN
    DO
      INCR v_lngCount
      IF v_lngCount > UBOUND(v_strArray) THEN REDIM PRESERVE v_strArray(v_lngCount + 999)
      v_strArray(v_lngCount) = v_strText
      v_strText = DIR$
    LOOP WHILE LEN(v_strText)
    IF v_lngCount THEN
      REDIM PRESERVE v_strArray(v_lngCount)
      ARRAY SORT v_strArray(1), COLLATE UCASE
      FOR v_lngIdx = 1 TO v_lngCount
        sub_InsertTVI v_pudtBFF, v_hItem, v_strPath, v_strArray(v_lngIdx)
      NEXT v_lngIdx
    END IF
  ELSE
    v_udtTVI.cChildren = 0
    v_udtTVI.mask = %TVIF_CHILDREN
    v_udtTVI.hItem = v_hItem
    TreeView_SetItem GETDLGITEM(@v_pudtBFF.hDlg, %libBff_tvcFileSystem), v_udtTVI
  END IF
  DIR$ CLOSE
END SUB

'----------------------------------------------------------------------------(')

CALLBACK FUNCTION cb_libBFF()
  LOCAL v_pstrPath AS PBSTRING PTR
  LOCAL v_pudtNMTV AS NM_TREEVIEW PTR
  LOCAL v_strPath AS PBSTRING
  LOCAL v_udtBaseWndwRect AS RECT
  LOCAL v_udtCurrClntPT AS POINT
  LOCAL v_udtMMI AS MINMAXINFO PTR
  STATIC v_pudtBFF AS libBFFType PTR
  STATIC v_udtBaseClntPT AS POINT
  STATIC v_udtBaseWndwPT AS POINT
  SELECT CASE AS LONG CB.MSG
    CASE %WM_INITDIALOG
      DIALOG GET USER CB.HNDL, 1 TO v_pudtBFF
      CONTROL DISABLE @v_pudtBFF.hDlg, %libBff_btnAccept    ' disabled till something is selected
      DIALOG GET CLIENT @v_pudtBFF.hDlg TO v_udtBaseClntPT.x, v_udtBaseClntPT.y    ' Dialog size (units), referenced when resizing
      ' The following 3 lines populate v_udtBaseWndwPT
      ' It is the initial size of the window and is used
      ' to set the minimum size the Window can shrink to
      GETWINDOWRECT @v_pudtBFF.hDlg, v_udtBaseWndwRect
      v_udtBaseWndwPT.x = v_udtBaseWndwRect.right - v_udtBaseWndwRect.left
      v_udtBaseWndwPT.y = v_udtBaseWndwRect.bottom - v_udtBaseWndwRect.top
      sub_PopulateLocalDrives v_pudtBFF
    CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CB.WPARAM THEN
        hWndSaveFocus = GETFOCUS()
      ELSEIF hWndSaveFocus THEN
        SETFOCUS(hWndSaveFocus)
        hWndSaveFocus = 0
      END IF
    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL
        CASE %libBff_btnAccept
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            CONTROL GET TEXT @v_pudtBFF.hDlg, %libBff_edtPath TO v_strPath
            IF LEN(v_strPath) THEN
              DIALOG GET USER @v_pudtBFF.hDlg, 2 TO v_pstrPath
              @v_pstrPath = v_strPath
            END IF
            DIALOG END @v_pudtBFF.hDlg
          END IF
        CASE %libBff_btnCancel
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN DIALOG END @v_pudtBFF.hDlg
      END SELECT
    CASE %WM_NOTIFY
      v_pudtNMTV = CB.LPARAM
      SELECT CASE @v_pudtNMTV.hdr.idFrom
        CASE %libBff_tvcFileSystem
          SELECT CASE @v_pudtNMTV.hdr.code
            CASE %TVN_ITEMEXPANDING
              SELECT CASE @v_pudtNMTV.action
                CASE %TVE_EXPAND
                  sub_ExpandTVI v_pudtBFF, @v_pudtNMTV.itemNew.hItem
                CASE %TVE_COLLAPSE
                  TreeView_Expand @v_pudtNMTV.hdr.hwndFrom, @v_pudtNMTV.itemNew.hItem, %TVE_COLLAPSE OR %TVE_COLLAPSERESET
              END SELECT
            CASE %TVN_SELCHANGED
              v_strPath = fn_GetTVPath(v_pudtBFF, TreeView_GetSelection(GETDLGITEM(@v_pudtBFF.hDlg, %libBff_tvcFileSystem)))
              IF (GETATTR(v_strPath) AND 16) AND ((@v_pudtBFF.lngAttribFlag AND 16) = 0) THEN
                CONTROL DISABLE @v_pudtBFF.hDlg, %libBff_btnAccept
                CONTROL SET TEXT @v_pudtBFF.hDlg, %libBff_edtPath, ""
              ELSE
                CONTROL ENABLE @v_pudtBFF.hDlg, %libBff_btnAccept
                CONTROL SET TEXT @v_pudtBFF.hDlg, %libBff_edtPath, fn_GetTVPath(v_pudtBFF, TreeView_GetSelection(GETDLGITEM(@v_pudtBFF.hDlg, %libBff_tvcFileSystem)))
              END IF
          END SELECT
      END SELECT
    CASE %WM_SIZE
      DIALOG GET CLIENT @v_pudtBFF.hDlg TO v_udtCurrClntPT.x, v_udtCurrClntPT.y
      CONTROL SET SIZE @v_pudtBFF.hDlg, %libBff_tvcFileSystem, v_udtCurrClntPT.x - 20, v_udtCurrClntPT.y - (v_udtBaseClntPT.y - 185)
      CONTROL SET SIZE @v_pudtBFF.hDlg, %libBff_edtPath, v_udtCurrClntPT.x - 20, 40
      CONTROL SET LOC @v_pudtBFF.hDlg, %libBff_edtPath, 10, v_udtCurrClntPT.y - (v_udtBaseClntPT.y - 205)
      CONTROL SET LOC @v_pudtBFF.hDlg, %libBff_btnAccept, v_udtCurrClntPT.x - 120, v_udtCurrClntPT.y - (v_udtBaseClntPT.y - 255)
      CONTROL SET LOC @v_pudtBFF.hDlg, %libBff_btnCancel, v_udtCurrClntPT.x - 60, v_udtCurrClntPT.y - (v_udtBaseClntPT.y - 255)
      CONTROL SET LOC @v_pudtBFF.hDlg, %libBff_lblFakeGripper, v_udtCurrClntPT.x - 11, v_udtCurrClntPT.y - 11
    CASE %WM_GETMINMAXINFO
      ' This is here just so the dialog does't shrink TOO small
      DEFWINDOWPROC @v_pudtBFF.hDlg, CB.MSG, CB.WPARAM, CB.LPARAM
      v_udtMMI = CB.LPARAM
      @v_udtMMI.ptMinTrackSize.x = v_udtBaseWndwPT.x
      @v_udtMMI.ptMinTrackSize.y = v_udtBaseWndwPT.Y
  END SELECT
END FUNCTION

'----------------------------------------------------------------------------(')

FUNCTION fn_libBFF(BYVAL v_hParent AS DWORD, BYREF v_strTitle AS PBSTRING, BYREF v_strPath AS PBSTRING, OPT v_optConfig AS libBFFType) AS LONG
  LOCAL v_hFont1 AS DWORD
  LOCAL v_hFont2 AS DWORD
  LOCAL v_hFont3 AS DWORD
  LOCAL v_hFont4 AS DWORD
  LOCAL v_lngResult AS LONG
  LOCAL v_udtBFF AS libBFFType
  v_udtBFF.lngAttribFlag = 16    ' Directories default
  IF Ismissing(v_optConfig) = %FALSE THEN v_udtBFF = v_optConfig
  IF v_udtBFF.strTVFName = "" THEN v_udtBFF.strTVFName = "Arial"
  IF v_udtBFF.lngTVFPnts = 0 THEN v_udtBFF.lngTVFPnts = 12
  IF v_udtBFF.strPathFName = "" THEN v_udtBFF.strPathFName = "Arial"
  IF v_udtBFF.lngPathFPnts = 0 THEN v_udtBFF.lngPathFPnts = 12
  IF v_udtBFF.strBtnFName = "" THEN v_udtBFF.strBtnFName = "Arial"
  IF v_udtBFF.lngBtnFPnts = 0 THEN v_udtBFF.lngBtnFPnts = 12
  DIALOG NEW v_hParent, v_strTitle, 358, 167, 295, 290, %WS_POPUP OR _
    %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CLIPSIBLINGS OR _
    %WS_VISIBLE OR %DS_MODALFRAME OR %DS_CENTER OR %DS_3DLOOK OR _
    %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR _
    %WS_EX_TOOLWINDOW OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR, TO v_udtBFF.hDlg
  CONTROL ADD TREEVIEW, v_udtBFF.hDlg, %libBff_tvcFileSystem, "", 10, 10, 275, 185, _
    %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR %WS_GROUP OR %WS_TABSTOP OR _
    %TVS_HASBUTTONS OR %TVS_HASLINES OR %TVS_LINESATROOT OR _
    %TVS_SHOWSELALWAYS, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR
  CONTROL ADD TEXTBOX, v_udtBFF.hDlg, %libBff_edtPath, "", 10, 205, 275, 40, %WS_CHILD OR _
    %WS_VISIBLE OR %WS_BORDER OR %WS_GROUP OR %ES_LEFT OR %ES_MULTILINE OR _
    %ES_AUTOVSCROLL OR %ES_READONLY, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR
  CONTROL ADD BUTTON, v_udtBFF.hDlg, %libBff_btnAccept, "&Accept", 175, 255, 50, 25, _
    %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %BS_TEXT OR _
    %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, %WS_EX_LEFT OR _
    %WS_EX_LTRREADING
  CONTROL ADD BUTTON, v_udtBFF.hDlg, %libBff_btnCancel, "&Cancel", 235, 255, 50, 25
  CONTROL ADD LABEL, v_udtBFF.hDlg, %libBff_lblFakeGripper, "o", 285, 280, 10, 10, _
    %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT, %WS_EX_LEFT OR _
    %WS_EX_LTRREADING
  FONT NEW v_udtBFF.strTVFName, v_udtBFF.lngTVFPnts, v_udtBFF.lngTVFStl, %ANSI_CHARSET TO v_hFont1
  FONT NEW v_udtBFF.strPathFName, v_udtBFF.lngPathFPnts, v_udtBFF.lngPathFStl, %ANSI_CHARSET TO v_hFont2
  FONT NEW v_udtBFF.strBtnFName, v_udtBFF.lngBtnFPnts, v_udtBFF.lngBtnFStl, %ANSI_CHARSET TO v_hFont3
  FONT NEW "Marlett", 12, 1, %SYMBOL_CHARSET TO v_hFont4
  CONTROL SET FONT v_udtBFF.hDlg, -1, v_hFont1
  CONTROL SET FONT v_udtBFF.hDlg, %libBff_tvcFileSystem, v_hFont1
  CONTROL SET FONT v_udtBFF.hDlg, %libBff_edtPath, v_hFont2
  CONTROL SET FONT v_udtBFF.hDlg, %libBff_btnAccept, v_hFont3
  CONTROL SET FONT v_udtBFF.hDlg, %libBff_btnCancel, v_hFont3
  CONTROL SET FONT v_udtBFF.hDlg, %libBff_lblFakeGripper, v_hFont4
  DIALOG SET USER v_udtBFF.hDlg, 1, VARPTR(v_udtBFF)
  DIALOG SET USER v_udtBFF.hDlg, 2, VARPTR(v_strPath)
  DIALOG SHOW MODAL v_udtBFF.hDlg, CALL cb_libBFF TO v_lngResult
  FONT END v_hFont1
  FONT END v_hFont2
  FONT END v_hFont3
  FONT END v_hFont4
  IF LEN(v_strPath) THEN FUNCTION = %TRUE
END FUNCTION