DlgDirSelectEx

[Nicola]

Okay, now it looks like it's fine. 
It makes a nice navigation effect in the dirs.
Thanks

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]  'questa definizione dev'essere fuori la funzione
string Result
sys ed1hndl


Function SetText(sys hwnd1, string s)
=====================================
   SendMessage hwnd1,WM_SETTEXT,len(s),strptr(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)
       ed1hndl=GetDlgItem(hDlg, ed1ID)
       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
           SetText(ed1hndl, dirname)
           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(ed1hndl, 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(ed1hndl, Result)
               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()