DlgDirSelectEx

[Nicola]

Hi
How can I use the DlgDirSelectEx function in the easiest way?

DlgDirSelectExA function (winuser.h) - Win32 apps | Microsoft Learn

I wish I could select a dir. I found the system by selecting a file and then taking the dir, but I wish I could just select the DIR.
Thank you

[Nicola]

Found this:

Code Select Expand

INT_PTR CALLBACK DlgDelFileProc(HWND hDlg, UINT message,
        UINT wParam, LONG lParam)
{
    PTSTR pszCurDir;
    PTSTR pszFileToDelete;
    int iLBItem;
    int cStringsRemaining;
    int iRet;
    TCHAR achBuffer[MAX_PATH];
    TCHAR achTemp[MAX_PATH];
    BOOL fResult;    
 
    switch (message)
    {
        case WM_INITDIALOG:
 
           // Initialize the list box by filling it with files from
           // the current directory.
           pszCurDir = achBuffer;
           GetCurrentDirectory(MAX_PATH, pszCurDir);
           DlgDirList(hDlg, pszCurDir, IDC_FILELIST, IDS_PATHTOFILL, 0);
           SetFocus(GetDlgItem(hDlg, IDC_FILELIST));
           return FALSE;
 
        case WM_COMMAND:
 
            switch (LOWORD(wParam))
            {
                case IDOK:
 
                    // When the user presses the DEL (IDOK) button,
                    // first retrieve the selected file.
                    pszFileToDelete = achBuffer;
                    DlgDirSelectEx(hDlg, pszFileToDelete, MAX_PATH,
                        IDC_FILELIST);

                    // Make sure the user really wants to delete the file.
                    achTemp[MAX_PATH];
                    StringCbPrintf (achTemp, ARRAYSIZE(achTemp), 
                            TEXT("Are you sure you want to delete %s?"),
                            pszFileToDelete);
                    iRet = MessageBox(hDlg, achTemp, L"Deleting Files",
                        MB_YESNO | MB_ICONEXCLAMATION);
                    if (iRet == IDNO)
                        return TRUE;;

                    // Delete the file.
                    fResult = DeleteFile(pszFileToDelete);
                    if (!fResult)
                    {
                        MessageBox(hDlg, L"Could not delete file.",
                            NULL, MB_OK);
                    }
                    else // Remove the filename from the list box.
                    {
                        // Get the selected item.
                        iLBItem = SendMessage(GetDlgItem(hDlg, IDC_FILELIST),
                            LB_GETCURSEL, 0, 0);
 
                        // Delete the selected item.
                        cStringsRemaining = SendMessage(GetDlgItem(hDlg, IDC_FILELIST),
                            LB_DELETESTRING, iLBItem, 0);
 
                        // If this is not the last item, set the selection to
                        // the item immediately following the one just deleted.
                        // Otherwise, set the selection to the last item.
                         if (cStringsRemaining > iLBItem)
                        {
                            SendMessage(GetDlgItem(hDlg, IDC_FILELIST),
                                LB_SETCURSEL, iLBItem, 0);
                        }
                        else
                        {
                            SendMessage(GetDlgItem(hDlg, IDC_FILELIST),
                                LB_SETCURSEL, cStringsRemaining, 0);
                        }
                    }
                    return TRUE;
 
                case IDCANCEL:
 
                    // Destroy the dialog box.
                     EndDialog(hDlg, TRUE);
                    return TRUE;
 
                default:
                    return FALSE;
            }
 
        default:
            return FALSE;
    }
}

[Charles Pegge]

Hi Nicola,

You can use GetFileList to return subdirectory lists instead of files:

Code Select Expand

'list of directories
uses sysutil
sys count
print GetFileList("\*.*", count, 1) '1 for filtering directories

would this help?

[Nicola]

Hi Charles,
With GetFilelist I was able to do this.

Code Select Expand

'====================================================================
' ListBox example, modal dialog as main.
'====================================================================

uses dialogs
uses .\Windows\User.inc
uses sysutil

int ID_Listbox=100
int ID_Info=IDOK
redim string d[100]  'questa definizione dev'essere fuori la funzione


function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as int callback
===============================================================================
  string Result
  string lista, w
 
  sys List1=GetDlgItem(hDlg, ID_Listbox)
  sys count
  int i,h
 
  select case uMsg
 
    case WM_INITDIALOG
       lista=GetFileList("\*.*", count, 1) '1 for filtering directories
       split(lista,d,count,h,w)
       for i=1 to count
          SendMessage(List1, LB_ADDSTRING, i, d[i])
       next
       'print DlgDirSelectex(hDlg,filter,count,List1)
       return true

    case WM_COMMAND
       select case loword(wParam)
      
         case IDCANCEL
            EndDialog( hDlg, null )

         case IDOK
           'get index of List, zero-based
           int index = SendMessage(List1, LB_GETCURSEL, 0, 0)
           'get Text
           zstring buffer[80]
           int TxtLen = SendMessage(List1,LB_GETTEXTLEN, index, 0)                                          
           SendMessage(List1, LB_GETTEXT, index, @buffer)
           'get count of items
           int count = SendMessage(List1, LB_GETCOUNT, 0, 0)

           Result =
           "List count = " count & chr(13) & chr(10) &
           "Selected Item Index = " index+1 & chr(13) & chr(10) &
           "Selected Item Text = " buffer

           mbox Result
         
       end select
 
    case WM_CLOSE
       EndDialog( hDlg, null )

  end select

  return 0
end function

sub winmain()
====================================================
  Dialog( 0, 0, 100, 115, "Select dir",
          WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

  ListBox( "", ID_Listbox, 10, 10, 60, 70 )
  PushButton( "Info", ID_Info, 10, 85, 20, 12 )
 
  CreateModalDialog( null, @DialogProc, 0 )
end sub

winmain()

[Nicola]

In fact, the right function to use to select a directory with the ability to vary in paths is this:  SHBrowseForFolder

I found an example of use in PB at this link: http://forum.it-berater.org/index.php?msg=15114

https://learn.microsoft.com/en-us/windows/win32/api/shlobj_core/nf-shlobj_core-shbrowseforfoldera

'https://www.vbforums.com/showthread.php?179025-treeview-sendmessage

https://www.arclab.com/en/kb/cppmfc/select-folder-shbrowseforfolder.html    (C example)

[Charles Pegge]

Hi Nicola,

With GetFilelist I was able to do this...

I worked on your dialog code.

This is an improved way of getting directory lists. It uses the dynamic string array directly.

Code Select Expand

uses sysutil

procedure BuildDirList(string filter, *dat[], int dmax, *count, dirq=0)
=======================================================================
  '
  indexbase 1
  WIN32_FIND_DATA f
  int    a,e,fi
  sys    h
  'string cr=chr(13,10)
  '
  h=FindFirstFile filter, @f
  count=0
  if h then
    do
      a=0
      if f.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY
        if dirq then a=1
        byte b at @f.cFileName
        if b=46 then  a=0 '.' ' ..'
      else 'NOT A DIRECTORY
        if not dirq then a=1
      end if
      if a then
        count++
        if count>=dmax
          dmax+=256
          redim string dat[dmax]
        endif
        dat[count]=f.cFileName
      end if
      e=FindNextFile h, @f
      if e=0 then
        e=GetLastError() 'should be 18 when no more files
        exit do
      end if
    end do
    FindClose h
  end if
  '
end procedure


The above procedure is used in your modified directory dialog:

Code Select Expand

#compact
uses sysutil
uses dialogs

indexbase 1
int ID_Listbox=100
int ID_Info=101

int dmax=0
redim string dat[dmax]  'questa definizione dev'essere fuori la funzione

'supports names that contain spaces
'
procedure BuildDirList(string filter, *dat[], int dmax, *count, dirq=0)
=======================================================================
  '
  indexbase 1
  WIN32_FIND_DATA f
  int    a,e,fi
  sys    h
  'string cr=chr(13,10)
  '
  h=FindFirstFile filter, @f
  count=0
  if h then
    do
      a=0
      if f.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY
        if dirq then a=1
        byte b at @f.cFileName
        if b=46 then  a=0 '.' ' ..'
      else 'NOT A DIRECTORY
        if not dirq then a=1
      end if
      if a then
        count++
        if count>=dmax
          dmax+=256
          redim string dat[dmax]
        endif
        dat[count]=f.cFileName
      end if
      e=FindNextFile h, @f
      if e=0 then
        e=GetLastError() 'should be 18 when no more files
        exit do
      end if
    end do
    FindClose h
  end if
  '
end procedure


/*
procedure SplitIntoLines(string s, *d[], int max, *n)
=====================================================
'**
  @param s is the data string to be split
  @param d is the array for the split data
  @param max is the max number of elements in d
  @param n is the count of elements split
'**
  indexbase 1
  int i = 1
  int a
  string w
  n=0
  do
    a=instr(i,s,cr)
    if a=0 then exit do
    if n>=max then exit do
    if dmax<=n
      dmax+=1000
      redim string d[dmax]
    endif
    w=mid(s,i,a-i)
    i=a+2
    n++
    d[n]=w 'unquote(w)
    'exit do
  end do
end procedure
*/

function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as int callback
===============================================================================
  static string dirname
  static sys hList
  static sys count, c
  int i,h
 
  select case uMsg
 
    case WM_INITDIALOG
       hlist=GetDlgItem(hDlg, ID_Listbox)
       dirname="\*.*"
       BuildDirList(dirname,dat[],dmax,count,1)
       for i=1 to count
         SendMessage(hList, LB_ADDSTRING, null, dat[i])
       next
       'print DlgDirSelectex(hDlg,filter,count,hList)
       return true

    case WM_COMMAND
       zstring buffer[80]
       int index
       select case loword(wParam)
     
         case IDCANCEL
            EndDialog( hDlg, null )

         case 101 'UP
           'SetCurrentDirectory ".."
           'i=instrev(-1,dirname,"\")
           i=len(dirname)-4
           if i>3
             i=instrev(i,dirname,"\")
             if i>0
               dirname=left(dirname,i)+"*.*"
               'print dirname cr count
               for i=count to 1 step -1
                 SendMessage hlist,LB_DELETESTRING,i-1,0
               next
               BuildDirList(dirname,dat[],dmax,c,1)
               for i=1 to c
                 SendMessage(hList, LB_ADDSTRING, null, dat[i])
               next
               count=c
             endif
           endif

         case 103 'SELECT
           index = SendMessage(hList, LB_GETCURSEL, 0, 0)
           SendMessage(hList, LB_GETTEXT, index, @buffer)
           i=instrev(-1,dirname,"\")
           if i>0
             if buffer
               print left(dirname,i)+buffer+"\*.*"
             endif
           endif

         case 102 'DOWN
           'get index of List, zero-based
           index = SendMessage(hList, LB_GETCURSEL, 0, 0)
           'get Text
           'int TxtLen = SendMessage(hList,LB_GETTEXTLEN, index, 0)                                         
           SendMessage(hList, LB_GETTEXT, index, @buffer)
           'get count of items
           count = SendMessage(hList, LB_GETCOUNT, 0, 0)
           '
           'string Result
           'Result =
           '"List count = " count & chr(13) & chr(10) &
           '"Selected Item Index = " index+1 & chr(13) & chr(10) &
           '"Selected Item Text = " buffer
           '
           if buffer
             c=count
             string b=dirname
             i=len(b)-3
             dirname=left(b,i)+buffer+"\*.*"
             'print dirname
             'SetCurrentDirectory dirname
             BuildDirList(dirname,dat[],dmax,count,1)
             if count
               'print "count del " c cr count cr lista
               for i=c to 1 step -1
                 SendMessage hlist,LB_DELETESTRING,i-1,0
               next
               for i=1 to count
                 SendMessage(hList, LB_ADDSTRING, null, dat[i])
               next
               'print  ">>>" dirname
             else 'count=0
               'revert
               'SetCurrentDirectory b
               dirname=b
               count=c
               'print "<<<" b
             endif
           endif
           'mbox Result
         
       end select
 
    case WM_CLOSE
       EndDialog( hDlg, null )

  end select

  return 0
end function

sub winmain()
====================================================
  Dialog( 0, 0, 100, 150, "Select dir",
          WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

  ListBox( "", ID_Listbox, 10, 10, 60, 70 )
  PushButton( "up", ID_Info  , 10, 85, 20, 12 )
  PushButton( "down", ID_Info+1, 10, 100, 20, 12 )
  PushButton( "select", ID_Info+2, 10, 115, 20, 12 )
 
  CreateModalDialog( null, @DialogProc, 0 )
end sub

winmain()


[Nicola]

nice job Charls, thanks

I tried to translate into o2 an example I found... It goes, but there's something wrong...

Code Select Expand

#compact
'#COMPILE EXE
'#DIM ALL
#INCLUDE ONCE .\Windows\Shell.inc
#INCLUDE ONCE .\Windows\user.inc
'#INCLUDE ONCE "shlobj.inc"

%MAX_PATH              260
%BIF_RETURNONLYFSDIRS  1
%BIF_USENEWUI          &H40
%BFFM_SETSELECTION     &H466 
%BFFM_INITIALIZED      1
%S_OK                  0

/*
typedef struct _browseinfoA {
  HWND              hwndOwner; 'Handle per la finestra del proprietario della finestra di dialogo
  PCIDLIST_ABSOLUTE pidlRoot;  'PIDL che specifica il percorso della cartella principale da cui iniziare l'esplorazione.
                               'può essere NUL
  LPSTR             pszDisplayName;  'Puntatore a un buffer per ricevere il nome visualizzato della cartella
                                     'selezionata dall'utente. Si presuppone che la dimensione di questo
                                     'buffer sia di MAX_PATH caratteri.
  LPCSTR            lpszTitle; 'Puntatore a una stringa con terminazione null visualizzata sopra il controllo
                               'visualizzazione struttura ad albero nella finestra di dialogo. Questa stringa
                               'può essere utilizzata per specificare le istruzioni per l'utente
  UINT              ulFlags;
  BFFCALLBACK       lpfn;  'Puntatore a una funzione definita dall'applicazione chiamata dalla finestra di dialogo
                           'quando si verifica un evento. Per ulteriori informazioni, vedere la funzione
                           'BrowseCallbackProc. Questo membro può essere NULL.
  LPARAM            lParam; 'Valore definito dall'applicazione che la finestra di dialogo passa alla funzione
                            'di callback, se specificata in lpfn.
  int               iImage; 'Valore intero che riceve l'indice dell'immagine associata alla cartella selezionata,
                            'memorizzata nell'elenco delle immagini di sistema.
} BROWSEINFOA, *PBROWSEINFOA, *LPBROWSEINFOA;
*/
 string null=nuls 1

type Browseinfo
  sys       hOwner
  sys    pidlRoot
  sys    pszDisplayName
  sys    lpszTitle
  sys       ulFlags
  sys       lpfn
  sys       lParam
  int       iImage
end type


Function SfogliaCartelle(ByVal hwnd As sys) As String
Dim BInfo As BROWSEINFO
long CartellaScelta
long PercorsoAllocato
string PercorsoScelto= space 260
'redim PercorsoScelto[max_path] as char
string title="Scegli una cartella:"
string root="C:\temp"

BInfo.hOwner    = GetActiveWindow()
'BInfo.pidlRoot  = "C:\temp"
BInfo.pidlRoot  = *root
'BInfo.pszDisplayName  = strptr(PercorsoScelto)
BInfo.pszDisplayName  = PercorsoScelto
'BInfo.lpszTitle = strptr(title)
BInfo.lpszTitle = *title
'BInfo.ulFlags   = BIF_USENEWUI
BInfo.ulFlags   = 3
BInfo.lParam   = 0
BInfo.iImage   = 0

PercorsoAllocato = SHBrowseForFolder(BInfo)
print percorsoallocato
'PercorsoScelto = Space 512
CartellaScelta = SHGetPathFromIDList(PercorsoAllocato, PercorsoScelto)
If CartellaScelta Then
  SfogliaCartelle = Left(PercorsoScelto, InStr(PercorsoScelto, Chr(0)) - 1)
  'CoTaskMemFree PercorsoAllocato
  frees PercorsoAllocato
Else
  SfogliaCartelle = ""
End If
End Function


print SfogliaCartelle(0)



'https://www.vbforums.com/showthread.php?179025-treeview-sendmessage

[Nicola]

I've fixed it, it seems to work fine... Take a look


if that's okay, you could put them in your SYSUTIL. INC?

Code Select Expand

#compact
'#COMPILE EXE
'#DIM ALL
#INCLUDE ONCE .\Windows\Shell.inc
#INCLUDE ONCE .\Windows\user.inc
'#INCLUDE ONCE "shlobj.inc"

%MAX_PATH              260
%BIF_RETURNONLYFSDIRS  1
%BIF_USENEWUI          &H40
%BFFM_SETSELECTION     &H466 
%BFFM_INITIALIZED      1
%S_OK                  0

/*
typedef struct _browseinfoA {
  HWND              hwndOwner; 'Handle per la finestra del proprietario della finestra di dialogo
  PCIDLIST_ABSOLUTE pidlRoot;  'PIDL che specifica il percorso della cartella principale da cui iniziare l'esplorazione.
                               'può essere NUL
  LPSTR             pszDisplayName;  'Puntatore a un buffer per ricevere il nome visualizzato della cartella
                                     'selezionata dall'utente. Si presuppone che la dimensione di questo
                                     'buffer sia di MAX_PATH caratteri.
  LPCSTR            lpszTitle; 'Puntatore a una stringa con terminazione null visualizzata sopra il controllo
                               'visualizzazione struttura ad albero nella finestra di dialogo. Questa stringa
                               'può essere utilizzata per specificare le istruzioni per l'utente
  UINT              ulFlags;
  BFFCALLBACK       lpfn;  'Puntatore a una funzione definita dall'applicazione chiamata dalla finestra di dialogo
                           'quando si verifica un evento. Per ulteriori informazioni, vedere la funzione
                           'BrowseCallbackProc. Questo membro può essere NULL.
  LPARAM            lParam; 'Valore definito dall'applicazione che la finestra di dialogo passa alla funzione
                            'di callback, se specificata in lpfn.
  int               iImage; 'Valore intero che riceve l'indice dell'immagine associata alla cartella selezionata,
                            'memorizzata nell'elenco delle immagini di sistema.
} BROWSEINFOA, *PBROWSEINFOA, *LPBROWSEINFOA;
*/
 string null=nuls 1

type Browseinfo
  sys       hOwner
  sys    pidlRoot
  sys    pszDisplayName
  sys    lpszTitle
  sys       ulFlags
  sys       lpfn
  sys       lParam
  int       iImage
end type


Function SfogliaCartelle(ByVal hwnd As sys) As String
Dim BInfo As BROWSEINFO
sys CartellaScelta
sys PercorsoAllocato
string PercorsoScelto= space 260
'redim PercorsoScelto[max_path] as char
string title="Scegli una cartella:"
string root="C:\temp"

BInfo.hOwner    = GetActiveWindow()
'BInfo.pidlRoot  = "C:\temp"
BInfo.pidlRoot  = root
'BInfo.pszDisplayName  = strptr(PercorsoScelto)
BInfo.pszDisplayName  = *PercorsoScelto
'BInfo.lpszTitle = strptr(title)
BInfo.lpszTitle = *title
BInfo.ulFlags   = BIF_USENEWUI
'BInfo.ulFlags   = 1
BInfo.lParam   = 0
BInfo.iImage   = 0

PercorsoAllocato = SHBrowseForFolder(BInfo)
'print "Percorso allocato: " percorsoallocato
'PercorsoScelto = Space 512
CartellaScelta = SHGetPathFromIDList(PercorsoAllocato, PercorsoScelto)
If CartellaScelta Then
  return Left(PercorsoScelto, InStr(PercorsoScelto, Chr(0)) - 1)
  'CoTaskMemFree PercorsoAllocato
  'frees PercorsoAllocato
Else
  return ""
End If

End Function


print "Selected Dir: " SfogliaCartelle(0)



'https://www.vbforums.com/showthread.php?179025-treeview-sendmessage

[Charles Pegge]

Well done.

I see that the callbacks are entirely unnecessary.

This is my own effort, which needs to be stripped back to the bare essentials.

Note that only corewin is used

Code Select Expand

==================
'OXYGENBASIC
==================
#compact
uses corewin
'Used for BrowseForDir
% BIF_RETURNONLYFSDIRS = 1
% BIF_EDITBOX = &H10
% MAX_PATH = 260

'! SHBrowseForFolder Lib "shell32" (BrowseInfo *lpbi) as sys
'! SHGetPathFromIDList Lib "shell32" (sys pidList, sys lpBuffer) As sys
'! lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 as String) As Long
'! Function SendMessage Lib "user32" Alias "SendMessageA" (sys hwnd, wMsg, wParam, lParam) as int
'
Type BrowseInfo
  sys hWndOwner
  sys pIDLRoot
  sys pszDisplayName
  sys lpszTitle
  int ulFlags
  sys lpfnCallback
  sys lParam
  int  iImage
End Type
'
string strCallBackInitPath=""
 
function BrowseCallbackProc(sys hwnd, int uMsg, sys lParam, sys lpData) as int, callback
========================================================================================
'***CALLBACK FUNCTION***
'Used with the BrowseForFolder function to select a default folder
'On Error Resume Next
  long rret
  % BFFM_ENABLEOK       0x465
  % BFFM_SETSELECTION   0x466
  % BFFM_SETSTATUSTEXT  0x464
  % BFFM_INITIALIZED    1
  % BFFM_SELCHANGED     2
  % BFFM_VALIDATEFAILED 3
 
  'print hex umsg

  if uMsg = BFFM_INITIALIZED
    rret = SendMessage(hwnd, BFFM_SETSELECTION, uMsg, strptr(strCallBackInitPath) )
  endif
  return 0  ' the function should always return 0
end function
 
===================================================
function BrowseForDir(sys frmOwner, 'as Form
  string strTitle = "Please choose a directory",
  string strInitDir="\") As string
'Displays the OS browse for folder dialog.
'frmOwner is the owner form for the dialog, if blank, then the form has no owner
'strTitle is the caption that will display on the dialog, if none is supplied then
'the default is used.
'strInitDir specifies the directory that will be selected by default when the dialog
'is displayed. If none is specified then "My Computer" is selected.
'******NOTE LAST BIT HASN'T BEEN DONE YET**************
'On Error GoTo ErrorHandler
   
  sys lpIDList
  string sBuffer
  BrowseInfo tBrowseInfo
   
  tBrowseInfo.hWndOwner = frmowner 'frmOwner.hwnd
  tBrowseInfo.lpszTitle = strptr(strTitle)
  tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
  'tBrowseInfo.lpfnCallback = @BrowseCallbackProc
   
  'set initial directory
  if len(strInitDir) = 0
    strCallBackInitPath = "\" 'App.Path 'default
  else
    strCallBackInitPath = strInitDir
  endif
  'print strInitDir   
  lpIDList = SHBrowseForFolder(@tBrowseInfo)
       
  if lpIDList
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = left(sBuffer, instr(sBuffer, chr(0) ) - 1)
    return sBuffer
  endif
 
  int err=GetLastError()
  if not err
    exit function
  endif
  '
  ErrorHandler:
  mbox str(Err) ",  BrowseForDir, Module, NmodFile"
end function
 
'USAGE:
'browse for a directory, C:\Windows\Desktop being the default selected directory
sys hWnd=0
string strDir = BrowseForDir(hWnd,"Select a Folder","c:\")
print strDir

====
'END
====


[Zlatko Vid]

wow i see AurelEdit07 folder 
very good example guys 

[Nicola]

Great Charles. You are a master.

What do you think of my solution?

[Charles Pegge]

Hi Nicola,

I've reduced it down to the essentials and added it to inc\FileDialog.inc (next update)

As you can see, it is much simpler, and there are still 5 redundant lines:

Code Select Expand

uses corewin

type BrowseInfo
  sys hWndOwner
  sys pIDLRoot
  sys pszDisplayName
  sys lpszTitle
  int ulFlags
  sys lpfnCallback
  sys lParam
  int iImage
end type
'
function BrowseForDir(sys hWnd,  string strTitle="", strInitDir="\" ) as string
===============================================================================
 '% BIF_RETURNONLYFSDIRS = 1
 '% BIF_EDITBOX = &H10
  % MAX_PATH = 260
  '
  BrowseInfo tBrowseInfo
  tBrowseInfo.hWndOwner = hwnd
  tBrowseInfo.lpszTitle = strptr(strTitle)
 'tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
 'tBrowseInfo.lpfnCallback = @BrowseCallbackProc
 'strCallBackInitPath = strInitDir
  sys lpIDList = SHBrowseForFolder(@tBrowseInfo)
  if lpIDList
    char sBuffer[MAX_PATH]
    SHGetPathFromIDList(lpIDList, sBuffer)
    return sBuffer
  endif
end function

'USAGE:
'sys hWnd=0
'print strDir = BrowseForDir(hWnd,"Select a Folder","c:\cevp\")

PS:
The callback is necessary if you want to define an initial directory, so I have restored it.
Also unscramble the CallBack lParam, and reduced symbol verbosity for easier reading.

Code Select Expand

uses corewin

function BrowseCallbackProc(sys hwnd, int uMsg, sys wParam, lParam) as int, callback
====================================================================================
'Used with the BrowseForFolder function to select a default folder
  % BFFM_ENABLEOK       0x465
  % BFFM_SETSELECTION   0x466
  % BFFM_SETSTATUSTEXT  0x464
  % BFFM_INITIALIZED    1
  % BFFM_SELCHANGED     2
  % BFFM_VALIDATEFAILED 3
  '
  if uMsg = BFFM_INITIALIZED
    SendMessage(hwnd, BFFM_SETSELECTION, uMsg, lParam )
  endif
  return 0  ' the function should always return 0
end function


type BrowseInfo
  sys hWndOwner
  sys pIDLRoot
  sys pszDisplayName
  sys lpszTitle
  int ulFlags
  sys lpfnCallback
  sys lParam
  int iImage
end type
'
function BrowseForDir(sys hWnd,  string strTitle="", strInitDir="\" ) as string
===============================================================================
 '% BIF_RETURNONLYFSDIRS = 1
 '% BIF_EDITBOX = &H10
  % MAX_PATH = 260
  '
  BrowseInfo tbi
  tbi.hWndOwner = hwnd
  tbi.lpszTitle = strptr(strTitle)
 'tbi.ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
  tbi.lpfnCallback = @BrowseCallbackProc
  tbi.lParam = strptr(strInitDir)
  sys h = SHBrowseForFolder(@tbi)
  if h
    char s[MAX_PATH]
    SHGetPathFromIDList(h, s)
    return s
  endif
end function

'USAGE:
'sys hWnd=0
'print strDir = BrowseForDir(hWnd,"Select a Folder","c:\users")


[Nicola]

Charles,
In fact, without the CallBack, it always starts at the root. 
Anyway the routine you did seems ok.
Good Job.

[Nicola]

Hi Charles,
I made a small change to the program with the BuildDirList function. You select the down by double-clicking on the selected dir... It feels more natural.
I'm ashamed to say it, but I can't get the text out in the ed1ID textbox.

What do you think?
Cheers

Code Select Expand

#compact
uses sysutil
uses dialogs


indexbase 1
% ID_Listbox      = 100
% ID_Info1        = 101
% ID_Info2        = 102
% ID_Info3        = 103
% LBN_DBLCLICK    = 2
% ed1ID           = 200

long  controlID, notifyCode
int dmax=0
redim string dat[dmax]  'This definition must be out of function
string Result


Function SetText(sys hwnd1, string s)
=====================================
   SendMessage hwnd1,WM_SETTEXT,len(s),strptr(s)
     'SetDlgItemText( hwnd1, 0, s )
   'print "il risultato è: " s
   End Function



'supports names that contain spaces
'
procedure BuildDirList(string filter, *dat[], int dmax, *count, dirq=0)
=======================================================================
  '
  indexbase 1
  WIN32_FIND_DATA f
  int    a,e,fi
  sys    h
  'string cr=chr(13,10)
  '
  h=FindFirstFile filter, @f
  count=0
  if h then
    do
      a=0
      if f.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY
        if dirq then a=1
        byte b at @f.cFileName
        if b=46 then  a=0 '.' ' ..'
      else 'NOT A DIRECTORY
        if not dirq then a=1
      end if
      if a then
        count++
        if count>=dmax
          dmax+=256
          redim string dat[dmax]
        endif
        dat[count]=f.cFileName
      end if
      e=FindNextFile h, @f
      if e=0 then
        e=GetLastError() 'should be 18 when no more files
        exit do
      end if
    end do
    FindClose h
  end if
  '
end procedure


/*
procedure SplitIntoLines(string s, *d[], int max, *n)
=====================================================
'**
  @param s is the data string to be split
  @param d is the array for the split data
  @param max is the max number of elements in d
  @param n is the count of elements split
'**
  indexbase 1
  int i = 1
  int a
  string w
  n=0
  do
    a=instr(i,s,cr)
    if a=0 then exit do
    if n>=max then exit do
    if dmax<=n
      dmax+=1000
      redim string d[dmax]
    endif
    w=mid(s,i,a-i)
    i=a+2
    n++
    d[n]=w 'unquote(w)
    'exit do
  end do
end procedure
*/

function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as int callback
===============================================================================
  static string dirname
  static sys hList
  static sys count, c
  int i,h
 
  select case uMsg
 
    case WM_INITDIALOG
       hlist=GetDlgItem(hDlg, ID_Listbox)
       dirname="\*.*"
       BuildDirList(dirname,dat[],dmax,count,1)
       for i=1 to count
         SendMessage(hList, LB_ADDSTRING, null, dat[i])
       next
       'print DlgDirSelectex(hDlg,filter,count,hList)
       return true

    case WM_COMMAND
       zstring buffer[80]
       int index

       '++++  nicola  +++++
    controlID = LoWord(wParam) 'get control ID
    notifyCode = HiWord(wParam) 'get notification message
       Select controlID
         Case ID_Listbox
           'doubleClick listbox item -> go in subDir
     IF notifycode = LBN_DBLCLICK  'DOPPIO CLICK
       'get index of List, zero-based
             index = SendMessage(hList, LB_GETCURSEL, 0, 0)
             'get Text
             'int TxtLen = SendMessage(hList,LB_GETTEXTLEN, index, 0)                                        
             SendMessage(hList, LB_GETTEXT, index, @buffer)
             'get count of items
             count = SendMessage(hList, LB_GETCOUNT, 0, 0)
           if buffer
             c=count
             string b=dirname
             i=len(b)-3
             dirname=left(b,i)+buffer+"\*.*"
             'print dirname
             'SetCurrentDirectory dirname
             BuildDirList(dirname,dat[],dmax,count,1)
             if count
               'print "count del " c cr count cr lista
               for i=c to 1 step -1
                 SendMessage hlist,LB_DELETESTRING,i-1,0
               next
               for i=1 to count
                 SendMessage(hList, LB_ADDSTRING, null, dat[i])
               next
               'print  ">>>" dirname
             else 'count=0
               'revert
               'SetCurrentDirectory b
               dirname=b
               count=c
               'print "<<<" b
             endif
           endif
           'mbox Result
           endif
        End Select
       '---- end nicola -----------

       select case loword(wParam)
    
         case IDCANCEL
            EndDialog( hDlg, null )

         case ID_Info1 'UP
           'SetCurrentDirectory ".."
           'i=instrev(-1,dirname,"\")
           i=len(dirname)-4
           if i>3
             i=instrev(i,dirname,"\")
             if i>0
               dirname=left(dirname,i)+"*.*"
               'print dirname cr count
               for i=count to 1 step -1
                 SendMessage hlist,LB_DELETESTRING,i-1,0
               next
               BuildDirList(dirname,dat[],dmax,c,1)
               for i=1 to c
                 SendMessage(hList, LB_ADDSTRING, null, dat[i])
               next
               count=c
               'SetTExt(ed1ID, dirname)
             endif
           endif

         case ID_Info3 'SELECT
           index = SendMessage(hList, LB_GETCURSEL, 0, 0)
           SendMessage(hList, LB_GETTEXT, index, @buffer)
           i=instrev(-1,dirname,"\")
           if i>0
             if buffer
               Result=left(dirname,i)+buffer+"\*.*"
               SetText(ed1ID, Result)  'non funziona
               'SetWindowText(ed1ID, Result)  'non funziona
               'SendMessage ed1ID,WM_SETTEXT,len(Result),strptr(Result)  'nonfunziona
               'SendMessage(ed1ID, ED_ADDSTRING, null, Result) ' non va
               'SendMessage ed1ID,WM_SETTEXT,Result  'non va
               print Result
             endif
           endif

        
       end select
 
    case WM_CLOSE
       EndDialog( hDlg, null )

  end select

  return 0
end function


sub winmain()
====================================================
  Dialog( 0, 0, 220, 150, "Select dir",
          WS_OVERLAPPED or WS_SYSMENU or DS_CENTER )

   ListBox( "", ID_Listbox, 20, 10, 180, 90 )
   PushButton( "up", ID_Info1     , 2, 10, 16, 12 )
  'PushButton( "down", ID_Info2,   10, 100, 30, 12 )
   PushButton( "select", ID_Info3, 20, 118, 30, 12 )
   Edittext("--",ed1ID, 20,103,180,12)
 
  CreateModalDialog( null, @DialogProc, 0 )
'print Result   'funziona alla chiusura del programma. stampa la dir selezionata
end sub

winmain()

[Charles Pegge]

Hi Nicola,

You need the handle to your edit box, not the identity.

'https://learn.microsoft.com/en-us/windows/win32/winmsg/wm-settext

Code Select Expand

SendMessage ed1ID,WM_SETTEXT,0, strptr(Result)  'non va

Note the third param is null.