Browser Folder (fix for scrolling)

Category: Dialogs (built-in)

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
Global hDlg, gHook As Dword
 
Function PBMain() As Long
   Local title$, start$, flags&, folder$
   title$ = "Select Folder"    'if "" then "Open" is used
   start$ = "c:\program files\"
   start$ = "c:\data\apps\powerbasic"
   flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
   gHook = SetWindowsHookEx(%WH_CBT, CodePtr(InputBoxProc), GetModuleHandle(""), GetCurrentThreadId)
   Display Browse  hDlg, 100, 100, title$, start$, flags& To folder$
End Function
 
 
Function InputBoxProc(ByVal nCode As LongByVal wParam As LongByVal lParam As LongAs Long
   Local szTemp As WStringZ * %Max_Path, cw As CBT_CREATEWND Ptr, cst As CREATESTRUCT Ptr
   Local Style As Long, hPos As Long
   Static hTreeView As Dword
   Function = CallNextHookEx(ByVal gHook, ByVal nCode, ByVal wParam, ByVal lParam)
   If nCode < 0 Then Exit Function
   If nCode = %HCBT_ACTIVATE Then
      Style = GetWindowLong(hTreeView, %GWL_style)
      Style = (Style And Not %BIF_NewDialogStyle)
      hPos = SendMessage(hTreeView, %TVM_GetNextItem, %TVGN_Caret, 0)
      SendMessage hTreeView, %TVM_ENSUREVISIBLE, hPos, 0
      UnhookWindowsHookEx gHook
   End If
   If nCode = %HCBT_CREATEWND Then
      cw = lParam         ' Get pointer to CBT_CREATEWND struct so we can...    TT: Nick Melnick
      cst = @cw.lpcs      ' get a pointer to the CREATESTRUCT struct
      GetClassName wParam, szTemp, %Max_Path      ' for each window / control as it is created
      If UCase$(szTemp) = "SYSLISTVIEW32Then hTreeView = wParam
   End If
End Function
 
 
Function BrowseForFolderCallBack (ByVal hwnd As Long,ByVal uMsg As Dword,ByVal wparam As LongByVal lparam As DwordExport As Long
  Local hPos As Long
  Select Case As uMSG
     Case %BFFM_INITIALIZED
        If lparam Then SendMessage hWnd, %BFFM_SETSELECTIONA, %TRUE, lparam
     Case %BFFM_SELCHANGED
  End Select
End Function    
 
'gbs_01263
'Date: 05-11-2013


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm