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...
Code:
'----------------------------------------------------------------------------(') ' 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
Comment