Working with common dialogs Part1
the getfile() function displays the Open dialog box.
it returns the name of the file chosen in the Open dialog box or the empty string if the user closes the Open dialog box by pressing ESC, clicking Cancel or the Close button on the Open dialog box.
this is a usefull function even in vfp9 (very similar to the comDialog one) and its resizable.
its well documented in FoxHelp.
.it selects one item file at once.its available on a level top form even with screen=off.
this codes below in this first part present as follow
*1* an old method to work with a similar getfile() with a form &listbox (populated with rowsource=7 as files)
it have one view (as listbox offers) and its resizable.
*2* GetFileNameFromBrowse function
its a wrapper of another API (GETOPENFILENAME) but its simplified and easy to use.
*3* 6 open dialogs made with the vfp2C32 library (compiled as fll file).(see summary help when run code).
its very usefull and work with the APIs
-SHBROWSEFOLDER
-GETOPENFILENAME
the work is very simplified by this library.the dialogs are not resizable here.
can extract code for any of these 6 dialogs for use.Working with APIs is the better solution (no activeX and fully system speed).
Download the library prior at vfpX to make the code working.
*4* the commonDialog open dialog box with activeX installed on system.Very light and easy to use.
*5* and *6* demonstrates the getfile() capability to work with screen=off even in an exe file.
Click on code to select [then copy] -click outside to deselect
*1* An old method to build a getfile dialog box
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Return
*
Define Class asup As Form
Top = 0
Left = 0
Height = 107
Width = 363
ShowWindow = 2
Caption = "OPEN FILE DIAOG"
Name = "ymaster"
Add Object command1 As CommandButton With ;
Top = 8, ;
Left = 21, ;
Height = 25, ;
Width = 133, ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 0, ;
Caption = "getfile...", ;
MousePointer = 15, ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"
Add Object label1 As Label With ;
FontBold = .T., ;
FontSize = 10, ;
Anchor = 0, ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = "", ;
Height = 36, ;
Left = 12, ;
Top = 60, ;
Width = 337, ;
ForeColor = Rgb(128,0,64), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
Anchor = 0, ;
BackStyle = 0, ;
Caption = "Selected file:", ;
Height = 17, ;
Left = 14, ;
Top = 41, ;
Width = 75, ;
ForeColor = Rgb(255,128,0), ;
Name = "Label2"
Add Object yhelp1 As yhelp With ;
visible=.T. , ;
name="yhelp1"
Procedure Load
_Screen.WindowState=1
Endproc
Procedure Init
_Screen.AddProperty("yretval","")
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure command1.Click
Thisform.label1.Caption=""
*do form old_vfp_getfile
oo=Newobject("ygetfile")
oo.Show
Thisform.label1.Caption=_Screen.yretVAL
Endproc
Enddefine
*
*-- EndDefine: asup
*****************************
Define Class ygetfile As Form
Height = 246
Width = 375
Desktop = .T.
ShowWindow = 1
AutoCenter = .T.
Caption = "Open file"
WindowType = 1
retvalobj = ""
Name = "Form1"
Add Object lstfiles As ListBox With ;
FontBold = .T., ;
Anchor = 15, ;
RowSourceType = 7, ;
Height = 193, ;
Left = 8, ;
Top = 12, ;
Width = 360, ;
Name = "lstFiles"
Add Object yfilter As TextBox With ;
Anchor = 260, ;
Value = "*.*", ;
Height = 25, ;
Left = 24, ;
Top = 216, ;
Width = 85, ;
Name = "yFilter"
Add Object cmdcancel As CommandButton With ;
Top = 218, ;
Left = 204, ;
Height = 25, ;
Width = 73, ;
Anchor = 260, ;
Caption = "Cancel", ;
Name = "cmdCancel"
Add Object cmdopen As CommandButton With ;
Top = 218, ;
Left = 288, ;
Height = 25, ;
Width = 73, ;
Anchor = 260, ;
Caption = "Open", ;
Name = "cmdOpen"
Procedure Init
Lparameters loRetVal
Local loRetVal
loRetVal = Createobject('Empty')
AddProperty(loRetVal, 'FileName', '')
This.retvalobj=Null
Thisform.lstfiles.RowSource=Thisform.yfilter.Value
Thisform.retvalobj = loRetVal
Return
Endproc
Procedure Destroy
Return Thisform.retvalobj.FileName
Endproc
Procedure lstfiles.Valid
If This.ListIndex > 2
If Left(This.List[THIS.ListIndex], 1) <> '['
Thisform.cmdopen.Click
Endif
Endif
Endproc
Procedure lstfiles.When
If This.ListIndex > 2
If Left(This.List[THIS.ListIndex], 1) = '['
Thisform.cmdopen.Enabled = .F.
Else
Thisform.cmdopen.Enabled = .T.
Endif
Else
Thisform.cmdopen.Enabled = .F.
Endif
Endproc
Procedure yfilter.InteractiveChange
Thisform.lstfiles.RowSource=Thisform.yfilter.Value
Thisform.Refresh
Endproc
Procedure cmdcancel.Click
_Screen.yretVAL=""
Thisform.Release
Endproc
Procedure cmdopen.Click
Wait Window "Selected file: " + Thisform.lstfiles.ListItem[THISFORM.lstFiles.ListIndex] Timeout 0.5
Thisform.retvalobj.FileName = Thisform.lstfiles.ListItem[THISFORM.lstFiles.ListIndex]
_Screen.yretVAL=Thisform.retvalobj.FileName
Thisform.Release
Endproc
Enddefine
*
*-- EndDefine: ygetfile
Define Class yhelp As Label
AutoSize = .T.
FontSize = 18
BackStyle = 0
Caption = "?"
Height = 30
Left = 324
MousePointer = 15
Top = 0
Width = 15
ForeColor = Rgb(0,255,0)
Name = "yhelp"
Procedure Click
Local m.myvar
TEXT to m.myvar noshow
this code fires a dialog to open any file on system.
can populate a list box or combo box with the names of files from the current directory.
The list also contains options for you to choose a different drive and directory to display file names from.
The form dialog is modal and return a result to the master form as file chossen.
To populate the control with file names from a directory
Set RowSourceType to 7 (Files).
Set RowSource by specifying a file skeleton or mask, such as *.* or *.fileExt.(set it dynamically in textbox)
For example, the following lines of code set RowSourceType to 7 to indicate that the source type
is files and specifies a file skeleton for RowSource:
Form1.lstfiles.RowSourceType = 7
Form1.lstfiles.RowSource = "*.*"
Dialog form is resizable as wanted.
ENDTEXT
Messagebox(m.myvar,0+32+4096,"'Summary help")
Endproc
Enddefine
*
*-- EndDefine:yhelp
Click on code to select [then copy] -click outside to deselect
*2*
*An open dialog box with API GetFileNameFromBrowse function
*This function creates an Open dialog box that lets the user specify the drive, directory, and name of a file to open.
*can set a filter for files an box title.the filename dond exceed 255 chars.
*this dialog can work out of vfp screen even in an exe with Screen=off in config.fpw
*getfile() vfp function works inside vfp screen visible only and can block an exe if screen=off.
*!**GetFileNameFromBrowse function
*!* hwnd[in] Handle to the window that owns the dialog box.
*!* pszFilePath [in] A null-terminated Unicode string that contains a file name used to initialize the File Name edit control.
*!* cchFilePath [in] The number of characters in pszFilePath, including the terminating null character.
*!* pszWorkingDir [in] The fully-qualified file path of the initial directory.
*!* pszDefExt [in] A null-terminated Unicode string that contains the default file extension.
*!* pszFilters [in] A null-terminated Unicode string that defines the filter.
*!* szTitle [in] A null-terminated Unicode string that is placed in the title bar of the dialog box.
_screen.visible=.f.
Local m.cfilename,m.cpath,m.Ext,m.cFilter,m.ctitle,m.retVal,m.yrep
m.yrep=Addbs(Justpath(Sys(16,1))) &&starting prg folder
m.cfilename=Space(255)
m.cpath=ysetunicode(m.yrep)
m.cExt=ysetunicode("*.txt")
m.cFilter=ysetunicode("Text files (*.prg)"+Chr(0)+"*.prg"+Chr(0)+"All files (*.*)"+Chr(0)+"*.*"+Chr(0) )
*m.cFilter=ysetUnicode("")
m.ctitle=ysetunicode("GetFileNameFromBrowse API")
m.nBufsize=255
m.nretVAL=ygetfile(cfilename,cpath,cExt,cFilter,ctitle,nBufsize)
_cliptext=m.nretVal
Messagebox("returned:"+Chr(13)+m.nretVAL,0+32+4096,"Result in clipboard",1000)
_screen.visible=.t.
Function ygetfile()
Lparameters cfilename,cpath,cExt,cFilter,ctitle,bBufsize
Declare Integer GetFileNameFromBrowse In shell32;
INTEGER HWnd,;
STRING @ pszFilePath,;
LONG cchFilePath,;
STRING pszWorkingDir,;
STRING pszDefExt,;
STRING pszFilters,;
STRING szTitle
Declare Integer GetActiveWindow In user32
Local m.result
result=GetFileNameFromBrowse(GetActiveWindow(),;
@cfilename, nBufsize,;
cpath, cExt, cFilter, ctitle)
Clea Dlls 'GetFileNameFromBrowse','GetActiveWindow'
If m.result#0
Return Strconv(cfilename,6)
Else
Return "Cancel!"
Endi
Endfunc
Function ysetunicode
Lparameters ystr
Return Strconv(ystr+Chr(0),5)
Endfunc
Retu
Click on code to select [then copy] -click outside to deselect
*3* Working with vfp2C32 libray-example adapted from vfp2c32.
*can download it from vfp codeplex version (2.0.0.14 ) at https://vfpx.codeplex.com/releases/view/71594
*must have in this folder the library vfp2c32.fll and vfp2c32.h mandatory to make this code working
#INCLUDE vfp2c.h
clea all
publi m.yrep
m.yrep=addbs( justpath(sys(16,1)))
set defa to (yrep)
publi yform
yform=newObject("ydialogs")
yform.show
read events
retu
*
DEFINE CLASS ydialogs AS form
BorderStyle = 1
Top = 0
Left = 0
Height = 108
Width = 345
ShowWindow = 2
Caption = "6 dialogsboxes from vfp2C32"
AlwaysOnTop = .T.
Name = "Form1"
ADD OBJECT combo1 AS combobox WITH ;
Height = 36, ;
Left = 31, ;
Top = 29, ;
Width = 132, ;
Name = "Combo1"
ADD OBJECT image1 AS image WITH ;
Picture = home(1)+"graphics\icons\misc\face03.ico", ;
Height = 32, ;
Left = 300, ;
MousePointer = 15, ;
Top = 12, ;
Width = 32, ;
Name = "Image1"
PROCEDURE ybuild
Lparameters ydiag
If Pcount()=0 Or !Between(ydiag,1,6) &&&6 dialog boxes
Return .F.
Endi
#Define CDN_FIRST -601
#Define CDN_LAST -699
#Define CDN_INITDONE -601
#Define CDN_SELCHANGE -602
#Define CDN_FOLDERCHANGE -603
#Define CDN_SHAREVIOLATION -604
#Define CDN_HELP -605
#Define CDN_FILEOK -606
#Define CDN_TYPECHANGE -607
#Define CDN_INCLUDEITEM -608
#Define CDM_FIRST 0x464
#Define CDM_LAST 0x4C8
#Define CDM_GETSPEC 0x464
#Define CDM_GETFILEPATH 0x465
#Define CDM_GETFOLDERPATH 0x466
#Define CDM_GETFOLDERIDLIST 0x467
#Define CDM_SETCONTROLTEXT 0x468
#Define CDM_HIDECONTROL 0x469
#Define CDM_SETDEFEXT 0x470
#Define IDOK 1
#Define IDCANCEL 2
Local lcFolder
lcFolder=""
Do Case
Case ydiag=1
If SHBROWSEFOLDER('Choose a Folder',0,@lcFolder)
Messagebox("Folder"+ lcFolder,0+32+406,"",1200)
Else
Messagebox("Dialog aborted",0+32+406,"",1200)
Endif
Case ydiag=2
try &&sometime an error occurs as exception !
=SHBROWSEFOLDER('Choose a Folder',0,@lcFolder,"C:\Users")
catch
messagebox("An error was occured",16+4096,'',1000)
endtry
Case ydiag=3
=SHBROWSEFOLDER('Choose yet another Folder :)',0,@lcFolder,'','BrowseFolderCallback')
Case ydiag=4
&& like standard GETFILE, but without places bar
Local lcFile
lcFile = GETOPENFILENAME(0,"All Files" + Chr(0) + "*.*","","C:","Custom Title",OFN_EX_NOPLACESBAR)
Do Case
Case Vartype(lcFile) = 'C'
Messagebox( "File" + lcFile + " selected",0+32+4096,'',1200)
Case lcFile = 0
Messagebox( "Dialog box aborted",0+32+4096,'',1200)
Case lcFile = -1
Messagebox( "Error in dialog box.",0+32+4096,'',1200)
Endcase
Case ydiag=5
&& multiselect GETFILE, by passing an arrayname in the 7th parameter
&& always returns a numeric value !!
lnFiles = GETOPENFILENAME(0,"All Files" + Chr(0) + "*.*","","C:","Multiselect Example",0,"laFiles")
Do Case
Case lnFiles = -1
AERROREX('laError')
Display Memory Like laError
Case lnFiles = 0
Messagebox( "Dialog box aborted",0+32+4096,'',1200)
Otherwise
&& Path is in laFiles[1], all other elements contain a filename (without the path)
Display Memory Like laFiles
Endcase
Case ydiag=6
&& use of a callback function to respond to events inside the dialog
lnFiles = GETOPENFILENAME(0,"Special bat Files" + Chr(0) + "*.bat","","C:","",0,"","OpenFileCallback")
Do Case
Case Vartype(lnFiles) = 'C'
Messagebox( "File" + lnFiles + " selected",0+32+4096,'',1200)
Case lnFiles = 0
Messagebox( "Dialog box aborted",0+32+4096,'',1200)
Case lnFiles = -1
AERROREX('laError')
Display Memory Like laError
Endcase
Endcase
Retu
ENDPROC
PROCEDURE browsefoldercallback
lparameters lnHwnd, uMsg, lParam
messagebox(trans(lnHwnd)+chr(13)+ trans(uMsg)+chr(13)+ trans(lParam),0+32+406,'',1200)
ENDPROC
PROCEDURE openfilecallback
lparameters lnHwnd, lnControlID, lnCode
IF lnCode = CDN_INITDONE
&& in this event the appearance of the dialog can be customized
&& center the window in it's parent window
CenterWindowEx(lnHwnd)
&& change button captions
DECLARE INTEGER SendMessage IN user32.dll AS SendMessageString INTEGER, INTEGER, INTEGER, STRING
SendMessageString(lnHwnd,CDM_SETCONTROLTEXT,IDOK,"Choose")
SendMessageString(lnHwnd,CDM_SETCONTROLTEXT,IDCANCEL,"Cancel")
&& for more examples google for "GetOpenFileName" and you'll find a bunch of articles/examples.
&& Most of them for Visual Basic, but they can be easily translated to VFP.
ENDIF
RETURN 0 && the function must return an integer or logical value
ENDPROC
PROCEDURE Destroy
set library to
clea events
ENDPROC
PROCEDURE Init
SET LIBRARY TO locfile("vfp2c32.fll") ADDITIVE
*INITVFP2C32(VFP2C_INIT_ALL)
ENDPROC
PROCEDURE combo1.Init
with this
for i=1 to 6
.additem("Dialog"+trans(i))
endfor
.listindex=1
.value=1
.style=2
endwith
ENDPROC
PROCEDURE combo1.Click
thisform.ybuild(this.value)
ENDPROC
PROCEDURE image1.Click
local m.myvar
text to m.myvar noshow
VFP2C32 (acronym for "VFP to C 32 bit") is a bridge between Visual Foxpro and the C programming language.
Additionally it contains wrappers around many windows api functions.
With this library you're able to create any C datatype - structs, unions, arrays - from within VFP.
The creation of wrapper classes for C struct or union types is explained in the topic VFP2C32Front.
C arrays can be created with the classes in the vfp2carray.prg file.
The windows api wrappers allows you to use a wide range of functionality build into windows.
A registry api, querying printer information and controlling windows services
Note :these 6 dialogs are not resizable.
dialog position is not controlable
endtext
MESSAGEBOXEX(m.myvar, 0, 'Dialogs from vfp2C32 library 1-6', _VFP.hWnd, 102, VFP2CSYS(1))
ENDPROC
ENDDEFINE
*
*-- EndDefine: ydialogs
Click on code to select [then copy] -click outside to deselect
*4* a commondialog open with an (activeX) OCX "mscomdlg.commondialog" present in system library microsof commondialog SP6.
Local loComDialog, lcFileName
Try
loComDialog = Newobject( "mscomdlg.commondialog" )
Catch
Messagebox("mscomdlg.commondialog is not installed",16+4096)
Endtry
* Set filters example
loComDialog.Filter = "All Files (*.*)|*.*|Prg Files(*.PRG)| *.prg|Scx Files(*.scx)| *.scx|Text Files(*.txt)|*.txt|Batch Files (*.bat)|*.bat"
* Specify default filter
loComDialog.FilterIndex = 2
loComDialog.MaxFileSize = 260 && without this you get: OLE IDispatch exception code 0 from CommonDialog
* Display the Open dialog box
loComDialog.ShowOpen()
* Get File Name
lcFileName = loComDialog.FileName
If ! Empty(lcFileName)
Messagebox( lcFileName,0+32+4096,'',1200 )
Else
Messagebox( 'Canceled' ,0+32+4096,'',1200 )
Endi
Click on code to select [then copy] -click outside to deselect
*5* DEMONSTRATE THE GETFILE() DIALOG AVAILABLE ON A TOP LEVEL FORM AND SCREEN=OFF
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Return
*
Define Class asup As Form
Top = 28
Left = 142
Height = 75
Width = 354
ShowWindow = 2
Caption = "Form1"
Name = "Form1"
Add Object command1 As CommandButton With ;
AutoSize = .T., ;
Top = 12, ;
Left = 24, ;
Height = 34, ;
Width = 290, ;
FontSize = 12, ;
Caption = "Getfile with top level form & screen=off", ;
Name = "Command1"
Procedure Load
_Screen.Visible=.F.
Endproc
Procedure command1.Click
x=Getfile()
messagebox("choosen file:"+m.x,0+32+406,'',1200)
_Screen.Visible=.T.
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*6*
*getfile() works as well if the screen=off and even in an exe
_screen.visible=.f.
i=0
t0=seconds()
do while seconds()-t0<=4 &&preventive way!
if i=0
x=getfile()
i=i+1
endi
enddo
messagebox("Choosen file:"+chr(13)+m.x,0+32+4096,'',1200)
_screen.visible=.t.
return
