Hi
How can I use the DlgDirSelectEx function in the easiest way?
DlgDirSelectExA function (winuser.h) - Win32 apps | Microsoft Learn (https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-dlgdirselectexa)
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
Found this:
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;
}
}
Hi Nicola,
You can use GetFileList to return subdirectory lists instead of files:
'list of directories
uses sysutil
sys count
print GetFileList("\*.*", count, 1) '1 for filtering directories
would this help?
Hi Charles,
With GetFilelist I was able to do this.
'====================================================================
' 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()
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 (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://learn.microsoft.com/en-us/windows/win32/api/shlobj_core/nf-shlobj_core-shbrowseforfoldera)
'https://www.vbforums.com/showthread.php?179025-treeview-sendmessage (http://forum.it-berater.org/'https://www.vbforums.com/showthread.php?179025-treeview-sendmessage)
https://www.arclab.com/en/kb/cppmfc/select-folder-shbrowseforfolder.html (https://www.arclab.com/en/kb/cppmfc/select-folder-shbrowseforfolder.html) (C example)
Hi Nicola,
QuoteWith 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.
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:
#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()
nice job Charls, thanks
I tried to translate into o2 an example I found... It goes, but there's something wrong...
#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
I've fixed it, it seems to work fine... Take a look
if that's okay, you could put them in your SYSUTIL. INC?
#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
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
==================
'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
====
wow i see AurelEdit07 folder :D
very good example guys ;)
Great Charles. You are a master.
What do you think of my solution?
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:
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.
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")
Charles,
In fact, without the CallBack, it always starts at the root.
Anyway the routine you did seems ok.
Good Job.
:)
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
#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()
Hi Nicola,
You need the handle to your edit box, not the identity.
'https://learn.microsoft.com/en-us/windows/win32/winmsg/wm-settext
SendMessage ed1ID,WM_SETTEXT,0, strptr(Result) 'non va
Note the third param is null.
:o
Okay, now it looks like it's fine.
It makes a nice navigation effect in the dirs.
Thanks
#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()