Working with common dialogs Part2
this is the continuation of chapter dialogs as presented in the previous post
http://yousfi.over-blog.com/2016/01/working-with-common-dialogs-part1.html
*Important:*the codes follow are tested on visual foxpro 9 sp2-under windows 10 pro
Click on code to select [then copy] -click outside to deselect
*1*
*this code returns all constants used in the Microsoft ComDlg library
*Procedure to apply :
*run the object browser from vfp menu/tool
*load commonDlg library on the object browser and go to constants
*drag this item on the vfp command window and you have this list below of all constants used in this library, individually better commented.
*with each comDlg object created you can add a property .Flags=....and make one or more constants added with + operator as "or"."this modify the behaviour of the dialog box (for ex in the showOpen dialog :its by default selects one file but if you add before the multiselect flag constant the user can select multi files)...
*these constants can skin the commonDialog box as showOpen,ShowSave,ShowColor,ShowPrint..and so.
#DEFINE cdlPDAllPages 0 && Sets or returns state of All Pages option button.
#DEFINE cdlPDCollate 16 && Sets or returns state of Collate check box.
#DEFINE cdlPDDisablePrintToFile 524288 && Disables the Print to File check box.
#DEFINE cdlPDHidePrintToFile 1048576 && The Print to File check box is not displayed.
#DEFINE cdlPDNoPageNums 8 && Sets or returns the state of the Pages option button
#DEFINE cdlPDNoSelection 4 && Disables the Selection option button.
#DEFINE cdlPDNoWarning 128 && Prevents a warning message when there is no default printer.
#DEFINE cdlPDPageNums 2 && Sets or returns the state of the Pages option button.
#DEFINE cdlPDPrintSetup 64 && Displays the Print Setup dialog box rather than the Print dialog box.
#DEFINE cdlPDPrintToFile 32 && Sets or returns the state of the Print to File check box.
#DEFINE cdlPDReturnDC 256 && Returns a device context for the printer selection.
#DEFINE cdlPDReturnDefault 1024 && Returns default printer name.
#DEFINE cdlPDReturnIC 512 && Returns an information context for the printer selection.
#DEFINE cdlPDSelection 1 && Sets or returns the state of the Selection option button.
#DEFINE cdlPDHelpButton 2048 && Dialog box displays the Help button.
#DEFINE cdlPDUseDevModeCopies 262144 && Sets support for multiple copies.
#DEFINE cdlCCRGBInit 1 && Sets initial color value for the dialog box.
#DEFINE cdlCCFullOpen 2 && Entire dialog box is displayed, including the Define Custom Colors section.
#DEFINE cdlCCPreventFullOpen 4 && Disables the Define Custom Colors section of the dialog box.
#DEFINE cdlCCHelpButton 8 && Dialog box displays a Help button.
#DEFINE cdlOFNReadOnly 1 && Checks Read Only check box for Open and Save As dialog boxes.
#DEFINE cdlOFNOverwritePrompt 2 && Generates a message box if the selected file already exists.
#DEFINE cdlOFNHideReadOnly 4 && Hides the Read Only check box.
#DEFINE cdlOFNNoChangeDir 8 && Sets the current directory to what it was when the dialog box was invoked.
#DEFINE cdlOFNHelpButton 16 && Causes the dialog box to display the Help button.
#DEFINE cdlOFNNoValidate 256 && Allows invalid characters in the returned file name.
#DEFINE cdlOFNAllowMultiselect 512 && Allows the File Name list box to have multiple selections.
#DEFINE cdlOFNExtensionDifferent 1024 && Extension of returned file name is different from the one set by DefaultExt.
#DEFINE cdlOFNPathMustExist 2048 && User can enter only valid path names.
#DEFINE cdlOFNFileMustExist 4096 && User can enter only names of existing files.
#DEFINE cdlOFNCreatePrompt 8192 && Asks if the user wants to create a file that does not currently exist.
#DEFINE cdlOFNShareAware 16384 && Sharing violation errors will be ignored.
#DEFINE cdlOFNNoReadOnlyReturn 32768 && The returned file will not have the Read Only attribute set.
#DEFINE cdlOFNNoLongNames 262144 && No long filenames.
#DEFINE cdlOFNExplorer 524288 && Windows 95 Open A File dialog box template.
#DEFINE cdlOFNNoDereferenceLinks 1048576 && No shortcuts.
#DEFINE cdlOFNLongNames 2097152 && Long filenames.
#DEFINE cdlCFScreenFonts 1 && Dialog box lists only screen fonts supported by the system.
#DEFINE cdlCFPrinterFonts 2 && Dialog box lists only fonts supported by the printer.
#DEFINE cdlCFBoth 3 && Dialog box lists available screen and printer fonts.
#DEFINE cdlCFHelpButton 4 && Dialog box displays a Help button.
#DEFINE cdlCFEffects 256 && Dialog enables strikeout, underline, and color effects.
#DEFINE cdlCFApply 512 && Dialog box enables the Apply button.
#DEFINE cdlCFANSIOnly 1024 && Dialog box allows only fonts that use the Windows character set.
#DEFINE cdlCFNoVectorFonts 2048 && Dialog box should not allow vector-font selections.
#DEFINE cdlCFNoSimulations 4096 && Dialog box should not allow graphic device interface (GDI) font simulations.
#DEFINE cdlCFLimitSize 8192 && Selects font sizes within the range specified by Min and Max properties.
#DEFINE cdlCFFixedPitchOnly 16384 && Dialog box should select only fixed-pitch fonts.
#DEFINE cdlCFWYSIWYG 32768 && Allows only the selection of fonts available to both the screen and printer.
#DEFINE cdlCFForceFontExist 65536 && Displays an error if a user selects a font or style that doesn't exist.
#DEFINE cdlCFScalableOnly 131072 && Dialog box should allow only the selection of scaleable fonts.
#DEFINE cdlCFTTOnly 262144 && Dialog box should allow only the selection of True Type fonts.
#DEFINE cdlCFNoFaceSel 524288 && No font name selected.
#DEFINE cdlCFNoStyleSel 1048576 && No font style selected.
#DEFINE cdlCFNoSizeSel 2097152 && No font size selected.
#DEFINE cdlInvalidPropertyValue 380 && Invalid property value
#DEFINE cdlGetNotSupported 394 && Property is write-only
#DEFINE cdlSetNotSupported 383 && Property is read-only
#DEFINE cdlAlloc 32752 && Couldn't allocate memory for FileName or Filter.
#DEFINE cdlCancel 32755 && Cancel was selected.
#DEFINE cdlDialogFailure -32768 && Failed to show the common dialog.
#DEFINE cdlFindResFailure 32761 && The function failed to load a specified resource.
#DEFINE cdlHelp 32751 && Call to Windows Help failed.
#DEFINE cdlInitialization 32765 && The function failed during initialization.
#DEFINE cdlLoadResFailure 32760 && The function failed to load a specified resource.
#DEFINE cdlLoadStrFailure 32762 && The function failed to load a specified string.
#DEFINE cdlLockResFailure 32759 && The function failed to lock a specified resource.
#DEFINE cdlMemAllocFailure 32758 && The function was unable to allocate memory for internal data structures.
#DEFINE cdlMemLockFailure 32757 && The function was unable to lock the memory associated with a handle.
#DEFINE cdlNoFonts 24574 && No fonts exist.
#DEFINE cdlBufferTooSmall 20476 && The buffer at which the member LpstrFile points is too small.
#DEFINE cdlInvalidFileName 20477 && File name is invalid.
#DEFINE cdlSubclassFailure 20478 && An attempt to subclass a listbox failed due to insufficient memory.
#DEFINE cdlCreateICFailure 28661 && The PrintDlg function failed when creating an information context.
#DEFINE cdlDndmMismatch 28662 && DevMode and DevNames data structures describe two different printers.
#DEFINE cdlGetDevModeFail 28666 && The printer-device driver failed to initialize a DEVMODE data structure.
#DEFINE cdlInitFailure 28665 && The PrintDlg function failed during initialization.
#DEFINE cdlLoadDrvFailure 28667 && The PrintDlg function failed to load the specified printer's device driver.
#DEFINE cdlNoDefaultPrn 28663 && A default printer does not exist.
#DEFINE cdlNoDevices 28664 && No printer device-drivers were found.
#DEFINE cdlParseFailure 28669 && The Common Dialog function failed to parse the strings in WIN.INI.
#DEFINE cdlPrinterCodes 28671 && The printer device driver failed to initialize a DevMode data structure.
#DEFINE cdlPrinterNotFound 28660 && The [devices] section of WIN.INI does not contain an entry for the printer.
#DEFINE cdlRetDefFailure 28668 && The PDReturnDefault flag was set, but a field was nonzero.
#DEFINE cdlSetupFailure 28670 && Setup failed
#DEFINE cdlNoTemplate 32764 && No template provided by the application.
#DEFINE cdlNoInstance 32763 && Application did not provide an instance handle.
#DEFINE cdlInvalidSafeModeProcCall 680 && Invalid procedure call in safe mode
#DEFINE cdlHelpContext 1 && Displays Help for a particular topic.
#DEFINE cdlHelpQuit 2 && Notifies the Help application that the specified Help file is no longer in use.
#DEFINE cdlHelpIndex 3 && Displays the index of the specified Help file.
#DEFINE cdlHelpContents 3 && Displays the contents topic in the current Help file.
#DEFINE cdlHelpHelpOnHelp 4 && Display Help for using the Help application itself.
#DEFINE cdlHelpSetIndex 5 && Set the current Index for multi-index Help.
#DEFINE cdlHelpSetContents 5 && Designates a specific topic as the contents topic.
#DEFINE cdlHelpContextPopup 8 && Displays a topic identified by a context number.
#DEFINE cdlHelpForceFile 9 && Creates a Help file that displays text in only one font.
#DEFINE cdlHelpKey 257 && Displays Help for a particular keyword.
#DEFINE cdlHelpCommandHelp 258 && Displays Help for a particular command.
#DEFINE cdlHelpPartialKey 261 && Call the search engine in Windows Help.
#DEFINE cdlPortrait 1 && Portrait printer paper orientation
#DEFINE cdlLandscape 2 && Landscape printer paper orientation
Click on code to select [then copy] -click outside to deselect
*2*
*this fires one of 6 commonDialog dialog boxes
Local m.x
m.x=Inputbox("Select a dialog box:1-2-3-4-5-6","","1")
If !Inlist(m.x,"1","2","3","4","5","6")
Return .F.
Endi
m.x=Int(Val(m.x))
Local comDLG
* create Dialog object of the Windows-Shell
comDLG = Createobject ("MSComDlg.CommonDialog")
With comDLG
*Set the dialog properties
.Filter = "All files (*.*)|*.*| " + "PRG (*.prg) |*.prg| " + "form (*.scx) |*.scx|"+ "DBF (*.dbf) |*.dbf| "
.FilterIndex = 2 && 2nd entry
.MaxFileSize = 260
.CancelError = .T. && Cancel enabled
.DialogTitle = "Select file"
.InitDir = "C:\" && Start folder
Do Case
Case m.x=1 &&ShowOpen
*Set the dialog properties
.Filter = "All files (*.*)|*.*| " + "PRG (*.prg) |*.prg| " + "form (*.scx) |*.scx|"+ "DBF (*.dbf) |*.dbf| "
.FilterIndex = 2 && 2nd entry
.MaxFileSize = 260
.CancelError = .T. && Cancel enabled
.DialogTitle = "Select file"
.InitDir = "C:\" && Start folder
Try
.ShowOpen() && show open dialog
* Show the result of the user's selection
Messagebox("Selected file: " + .Filename,0+32+4096)
Catch
Messagebox("cancelled!",0+32+4096,1200)
Endtry
Case m.x=2 &&ShowSave
*Set the dialog properties
.Filter = "All files (*.*)|*.*| " + "PRG (*.prg) |*.prg| " + "form (*.scx) |*.scx|"+ "DBF (*.dbf) |*.dbf| "
.FilterIndex = 2 && 2nd entry
.MaxFileSize = 260
.CancelError = .T. && Cancel enabled
.DialogTitle = "Save file"
.InitDir = "C:\" && Start folder
Try
.ShowSave () && show save as dialog
* Show the reslut of the user's selection
Messagebox("Save file: " + .Filename,0+32+4096)
Catch
Messagebox("cancelled!",0+32+4096,1200)
Endtry
Case m.x=3 &&showColor
#Define cdlCCFullOpen 0x2 &&Entire dialog box is displayed, including the Define Custom Colors section.
#Define cdlCCHelpButton 0x8 &&Causes the dialog box to display a Help button.
#Define cdlCCPreventFullOpen 0x4 &&Disables the Define Custom Colors command button and prevents the user from defining custom colors.
#Define cdlCCRGBInit 0x1 &&Sets the initial color value for the dialog box.
.CancelError = .T.
.Color = Rgb(255, 0, 0) &&set initial color
.Flags=cdlCCFullOpen+cdlCCRGBInit
*.flags=cdlCCPreventFullOpen+ cdlCCRGBInit
Try
.ShowColor () && show colors dialog
* Show the reslut of the user's selection
Messagebox("Selected color: ..."+Trans(.Color) ,0+32+4096,'',1200)
Catch
Messagebox("cancelled!",0+32+4096,1200)
Endtry
Case m.x=4 &&Showprinter
Try
.ShowPrinter() && show print dialog
Catch
Messagebox("cancelled!",0+32+4096,1200)
Endtry
Case m.x=5 &&ShowAbout
#Define cdlHelpForceFile 9
*.HelpCommand = cdlHelpForceFile &&Set the HelpCommand Property
.HelpFile ="C:\Program Files\Microsoft Visual FoxPro 9\DV_FOXHELP.CHM" && Specify the Help file.
Try
.ShowHelp() &&Display the Windows Help engine.
*this display the page MS support in navigator: https://support.microsoft.com/fr-fr/kb/917607
*in principe,runs Winhelp.EXE (if exists) and displays the Help file you specify
*run /n explorer "C:\Program Files\Microsoft Visual FoxPro 9\DV_FOXHELP.CHM" &&this work
Catch
Messagebox("cancelled!",0+32+4096,1200)
Endtry
Case m.x=6 &&aboutBox
.AboutBox()
Endcase
Endwith
comDLG =Null
Click on code to select [then copy] -click outside to deselect
*3*
*this code uses the native vfp9 class _dialog to show all types of dialogs(open , save, with many options as seen as a presentation
*can extract any of these codes from each case and use it.
*its a better and simple code than the vfp2c32 code presented in previous post.
Clea All
With _Screen
.Newobject("my","_ComDlg",Home(1)+"ffc\_system.vcx")
With .my
.nHwndOwner = .Parent.HWnd
.cTitlebarText ="my custom dialog getfile"
.cFileName = ""
.cDefaultExtension = "*.*"
.cInitialDirectory = "f:\"
.ClearFilters()
If !Empty(Alltrim("*.*"))
.AddFilter("VFP files (*.prg, etc.)", "*.PRG; *.mpr; *.VCX; *.PJX ; ")
.AddFilter("text files (*.txt, etc.)", "*.TXT; *.H")
.AddFilter("Images (*.bmp;*.jpg;*.gif)","*.bmp;*.jpg;*.gif")
Endi
Local m.message
For i=1 To 10
.aFileNames[1] = ""
Do Case
Case i=1
.lAllowMultiSelect = .F. &&mutiSelect
Message="1. lAllowMultiSelect = .f."
Case i=2
.lAllowMultiSelect = .T.
Message="2. lAllowMultiSelect = .t."
Case i=3
.lSaveDialog = .F. &&button save
Message="3. lSaveDialog = .f."
Case i=4
.lSaveDialog = .T.
Message="4. lSaveDialog = .t."
Case i=5
.lNoPlacesBar =.F. &&place bars
Message="5. lNoPlacesBar =.f."
Case i=6
.lNoPlacesBar =.T.
Message="6. lNoPlacesBar =.t."
Case i=7
.lHideReadonly = .F. &&add checkbox Readonly
Message="7. lHideReadonly = .f."
Case i=8
.lHideReadonly = .T.
Message="8. lHideReadonly = .t."
Case i=9
.lFileMustExist = .F. &&file must exists
Message="9. lFileMustExist = .f. "
Case i=10
.lFileMustExist =.T.
Message="10.llFileMustExist = .t. "
Endcase
Wait Window m.message Timeout 2
.ShowDialog()
If .lAllowMultiSelect = .F.
Messagebox(.aFileNames[1] ,0+32+4096,'',1200) &&if lAllowMultiSelect = .F.
Else
* Display the name(s) of the file(s) selected.
Local m.o
m.o=Trans(.nFilecount)+" selected"+Chr(13)
For j = 1 To .nFilecount
m.o=m.o+trans(j) +". File name: " + Trans(m.j) + ":"+ .aFileNames[m.j]+Chr(13)
Endfor
Messagebox(m.o,0+32+4096,'',2000)
.lAllowMultiSelect = .F.
Endi
Endfor
Endwith
Endwith
my=Null
Click on code to select [then copy] -click outside to deselect
*4*
*this code shows a font dialog with fontname,fontsize,fontstyle,color
#Define CF_SCREENFONTS 0x00000001
#Define CF_PRINTERFONTS 0x00000002
#Define CF_BOTH (CF_SCREENFONTS + CF_PRINTERFONTS)
#Define CF_SHOWHELP 0x00000004
#Define CF_USESTYLE 0x00000080
#Define CF_EFFECTS 0x00000100
ComDlg = Newobject("mscomdlg.commondialog" )
With ComDlg
* set flags
.Flags = CF_BOTH + CF_EFFECTS
* seed values with any initial font
.FontName = "Tahoma"
.FontSize = 14
.ShowFont()
* show results
Local m.myvar
TEXT to m.myvar textmerge noshow
Results:
---------
Fontname:<<.fontname>>
Fontsize:<<int(.fontsize)>>
Fontbold:<<.fontbold>>
FontItalic:<<.fontItalic>>
FontStrikeThru:<<.FontStrikeThru>>
FontUnderline:<<.FontUnderline>>
Color:<<.color>>
ENDTEXT
Endwith
_Cliptext=m.myvar
Messagebox(m.myvar,0+32+406,"Result in clipboard")
ComDlg=Null
Click on code to select [then copy] -click outside to deselect
*5* a simple code for showPrinter dialog
*can cusomize more with flags (see constants in code *2*)
*visual foxpro have the simplified dialogbox with
*GetPrinter()
*Sys(1037)
#DEFINE cdlPDAllPages 0 && Sets or returns state of All Pages option button.
#DEFINE cdlPDCollate 16 && Sets or returns state of Collate check box.
#DEFINE cdlPDDisablePrintToFile 524288 && Disables the Print to File check box.
#DEFINE cdlPDHidePrintToFile 1048576 && The Print to File check box is not displayed.
#DEFINE cdlPDNoPageNums 8 && Sets or returns the state of the Pages option button
#DEFINE cdlPDNoSelection 4 && Disables the Selection option button.
#DEFINE cdlPDNoWarning 128 && Prevents a warning message when there is no default printer.
#DEFINE cdlPDPageNums 2 && Sets or returns the state of the Pages option button.
#DEFINE cdlPDPrintSetup 64 && Displays the Print Setup dialog box rather than the Print dialog box.
#DEFINE cdlPDPrintToFile 32 && Sets or returns the state of the Print to File check box.
#DEFINE cdlPDReturnDC 256 && Returns a device context for the printer selection.
#DEFINE cdlPDReturnDefault 1024 && Returns default printer name.
#DEFINE cdlPDReturnIC 512 && Returns an information context for the printer selection.
#DEFINE cdlPDSelection 1 && Sets or returns the state of the Selection option button.
ComDlg = Newobject("mscomdlg.commondialog" )
with ComDlg
.PrinterDefault = .t.
.CancelError =.t.
* Set flags (see *1* for cdl* constants can concatenate flags as operator +:"or"))
.Flags = cdlPDReturnDC + cdlPDAllPages
.copies=3 &&see :this is set on print dialog box in the spinner(copies)
try
.ShowPrinter()
catch
endtry
local m.myvar
text to m.myvar textmerge noshow
hdc=<<.hdc>>
BeginPage = <<.FromPage>>
EndPage = <<.ToPage>>
NumCopies = <<.Copies>>
Orientation =<<.Orientation>>
printerdefault=<<.printerdefault>> && false if default printer is modified
ENDTEXT
messagebox(m.myvar,0+32,"showPrinter returns")
endwith
ComDlg=null
*6*
To select a folder with a dialog , the getdir() function is usefull.
GETDIR([cDirectory [, cText [, cCaption [, nFlags [, lRootOnly]]]]])
*see these particular behaviors of this function:
GETDIR("f:\", "Select a folder-navigation even out of f:\ ","getdir select a folder ", 16384 ,.f. )
GETDIR("f:\", "Select a folder-navigation only in f:\ ","getdir select a folder ", 16384 ,.t. )
*!*getdir() with more 2 parameters use this API to show dialog box
*!*set defa to ? && fires common dialog for select a folder
*!*messagebox(SET('DEFAULT')+curdir()) &&return the choosen folder (if cancel returns the old current folder)
DECLARE INTEGER SHBrowseForFolder IN shell32;
STRING @ lpbi
lpbi
[in, out] Pointer to a BROWSEINFO structure that contains information used to display the dialog box.
*and this is a very usefull an simple script function to select a folder and dont allow navigation out this folder.
local oshell
oShell = CREATEOBJECT("Shell.Application")
oFolder = oShell.Application.BrowseForFolder(_vfp.HWnd,;
"Select Folder", 1, "c:\Windows")
try
messagebox( oFolder.self.Path)
catch
endtry
Click on code to select [then copy] -click outside to deselect
*7*
*SHBrowseForFolder API
*Author: unKnown (code found in www.Foxite.com/forum)
pShellMalloc = ""
Declare Integer SHGetMalloc In SHELL32.Dll String @pShellMalloc
*-- SHBrowseForFolder returns a PIDL. Memory for the PIDL is
*-- allocated by the shell. This memory will need to be
*-- freed, so we need to get a pointer to the shell malloc.
NOERROR = 0
r = SHGetMalloc(@pShellMalloc)
If r = NOERROR
*-- Create the BROWSEINFO structure. I'm using all default
*-- values, so just make it the correct size
sBrowseInfo = Repl(Chr(0),32)
Declare Integer SHBrowseForFolder In SHELL32.Dll String @Browseinfo
*-- If the user selects a folder the return value
*-- will be a pointer to a folder, otherwise
*-- it will be NULL.
nPointerToFolder = SHBrowseForFolder(@sBrowseInfo)
*// Now get values from pointer *//
*-- Make sure buffer is large enough
MAX_PATH = 260
sBuffer = Repl(" ",MAX_PATH) &&// Will hold the path name
Declare Integer SHGetPathFromIDList In SHELL32.Dll ;
INTEGER nPointerToFolder,;
STRING @sBuffer
If nPointerToFolder > 0
= SHGetPathFromIDList(nPointerToFolder,@sBuffer)
Messagebox("Returned folder="+ Alltrim(sBuffer))
Endif
*-- Free the PIDL. .....
Release pShellMalloc
Endi
Click on code to select [then copy] -click outside to deselect
*8* the most simple code to work with shBrowseForFolder API
*retrieve the dialog box to select a folder
Declare integer SHBrowseForFolder in Shell32.DLL integer @
Declare integer SHGetPathFromIDList in Shell32.DLL integer, string @
buff=Space(200)
path=Replicate(Chr(0),255)
pidl=SHBrowseForFolder(0)
SHGetPathFromIDList(pidl,@path)
messagebox("returned folder="+ Left(path,Atc(Chr(0),path)-1))
Click on code to select [then copy] -click outside to deselect
*9*
*warning: i found there is a problem with the vfp9 _comdlg class.
*test dialog
local m.o
m.o=newObject("_comdlg",home(1)+"ffc\_system.vcx")
m.o.testDialog()
in the api_dialog.prg or _comdlg class
* Display the name(s) of the file(s) selected.
FOR i = 1 to this.nFileCount &&x fires error> >>>>>>>>>>>>>>>>>>>>>>>
? "File name: " + TRANS(m.i) + ":", THIS.aFileNames[m.i]
ENDFOR
to correct thus bug as pointed replace "x.nfilecount" by "this.nfilecount"
bug in home(1)+"ffc\_system.vcx" _comdlg class (to correct)
Click on code to select [then copy] -click outside to deselect
*10 * created on wednesday 07 of march 2018
*this is the _comdlg of home(1)+"ffc\_system.vcx" class translated as prg file
*there is 3 examples open dialog, save dialog and test dialog in this example.
*note that this _comdlg (and 'MSComDlg.CommonDialog' dialogs) preserve the original filenames syntaxes (contrary with native vfp getfile())
*also can simply call it with m.o=newObject("_comdlg",home(1)+"ffc\ system.vcx") of course you correct the bug pointed above.
Local m.o
m.o=Newobject("_comdlg")
For i=1 To 3
Do Case
Case i=1
m.o.LSAVEDialog=.F.
m.o.showDialog()
Case i=2
m.o.LSAVEDialog=.T.
m.o.showDialog()
Case i=3
m.o.testDialog()
Endcase
Endfor
Retu
*-- Class: _comdlg (c:\program files (x86)\microsoft visual foxpro 9\ffc\_system.vcx)
*-- ParentClass: _custom (c:\program files (x86)\microsoft visual foxpro 9\ffc\_base.vcx)
*-- BaseClass: custom
*-- Time Stamp: 02/10/01 06:33:05 PM
*
DEFINE CLASS _comdlg AS custom
*-- Name of file selected or initially set as default.
cfilename = ""
*-- Initial directory to show files from.
cinitialdirectory = ""
*-- Default file extension to display.
cdefaultextension = ""
*-- Specifies which of the filters the user selected from the dialog.
nfilterindex = 0
*-- Number of files selected from dialog.
nfilecount = 0
*-- Path that files were selected from.
cfilepath = ""
*-- Custom filter the user created while using dialog.
ccustomfilter = ""
*-- File title property of the selected file(s).
cfiletitle = ""
*-- Caption for dialog title bar.
ctitlebartext = ""
*-- Use new explorer user interface and features such as Places bar.
lnewexplorer = .T.
*-- Hides read-only files from list.
lhidereadonly = .T.
*-- For internal use only.
nhwndowner = 0
*-- For internal use only.
ninstance = 0
Name = "_comdlg"
*-- Whether to allow selection of multiple files.
lallowmultiselect = .F.
*-- Use Save dialog instead of Open one.
lsavedialog = .F.
*-- Allows only valid existing files to be entered.
lfilemustexist = .F.
*-- Do not include a network button in dialog.
lnonetworkbutton = .F.
*-- Don't allow initially displayed directory to be changed.
lnochangedir = .F.
lnovalidate = .F.
*-- Do not include Places bar in dialog.
lnoplacesbar = .F.
*-- Array of file extension filters passed to dialog.
DIMENSION afilterlist[1,2]
*-- Array of filenames returned from dialog.
DIMENSION afilenames[1]
PROTECTED PROCEDURE stringtointeger
LPARAMETERS cPDWORD, nBytes
LOCAL nCurByte, nRetVal
IF PCOUNT() < 2
nBytes = LEN(cPDWord)
ENDIF
nRetVal = 0
FOR nCurByte = 1 to nBytes
nRetVal = nRetVal + ASC(SUBSTR(cPDWord, nCurByte, 1))*(256^(nCurByte-1))
ENDFOR
RETURN nRetVal
ENDPROC
PROTECTED PROCEDURE integertostring
LPARAMETERS nInteger, nBytes
LOCAL cRetVal
IF pCount() < 2
nBytes = 4
ENDIF
cRetVal = ""
FOR nCurByte = 1 to nBytes
cRetVal = cRetVal + CHR(BITAND(BITRSHIFT(nInteger, 8 * (nCurByte -1) ), 255))
ENDFOR
RETURN cRetVal
ENDPROC
*-- Displays dialog with various options such as filters.
PROCEDURE showdialog
THIS.LoadDLLs()
THIS.DialogHandler()
THIS.ClearDLLs()
ENDPROC
*-- Sets file extension filters for use when displaying dialog.
PROCEDURE addfilter
LPARAMETERS cDescription, cSkeleton
LOCAL nNewRow
nNewRow = ALEN(THIS.aFilterList,1) + 1
DIMENSION THIS.aFilterList[nNewRow,2]
THIS.aFilterList[nNewRow,1] = cDescription
IF VARTYPE(cSkeleton)#"C" OR EMPTY(cSkeleton)
THIS.aFilterList[nNewRow,2] = "*.*"
ELSE
THIS.aFilterList[nNewRow,2] = cSkeleton
ENDIF
THIS.nFilterIndex = nNewRow
ENDPROC
PROTECTED PROCEDURE loaddlls
DECLARE INTEGER GetSaveFileNameA IN comdlg32.dll AS _FFC_SAVEFILENAME STRING @
DECLARE INTEGER GetOpenFileNameA IN comdlg32.dll AS _FFC_GETFILENAME STRING @
DECLARE INTEGER malloc IN msvcrt.dll AS _FFC_MALLOC INTEGER
DECLARE free in msvcrt.dll AS _FFC_FREEMEM INTEGER
ENDPROC
PROTECTED PROCEDURE cleardlls
CLEAR DLLS _FFC_SAVEFILENAME
CLEAR DLLS _FFC_GETFILENAME
CLEAR DLLS _FFC_MEMCPY
CLEAR DLLS _FFC_MEMCPY2
CLEAR DLLS _FFC_MALLOC
CLEAR DLLS _FFC_FREEMEM
ENDPROC
*-- Clears all file extension filters.
PROCEDURE clearfilters
LPARAMETERS lComplete
DIMENSION THIS.aFilterList[1,2]
IF lComplete
THIS.aFilterList= ""
ELSE
THIS.aFilterList[1,1] = "All files (*.*)"
THIS.aFilterList[1,2] = "*.*"
ENDIF
ENDPROC
*-- Test script for displaying a dialog.
PROCEDURE testdialog
LOCAL i
* This is a sample program to test dialog
THIS.AddFilter("My VFP files (*.prg, etc.)", "*.PRG;*.SCX;*.VCX;*.PJX")
THIS.AddFilter("My text files (*.txt, etc.)", "*.TXT; *.H")
* Dialog properties.
THIS.cTitlebarText = "This is a test dialog"
THIS.lAllowMultiselect = .T.
* Initial defaults.
THIS.cFileName = "test.prg"
THIS.cInitialDirectory = "c:\temp"
THIS.cDefaultExtension = "TXT"
* Display the dialog and get results.
THIS.showdialog()
* Display the name(s) of the file(s) selected.
FOR i = 1 to this.nFileCount &&x.nfilecount corrected here <<<<<<<<<<<<<<<<<<<<<
? "File name: " + TRANS(m.i) + ":", THIS.aFileNames[m.i]
ENDFOR
Local m.myvar
TEXT to m.myvar textmerge noshow
Files were chosen from:<< THIS.cFilePath>>
FileName property:<< THIS.cFileName>>
FileTitle property:<< THIS.cFileTitle>>
Custom filter that the user created:"<< THIS.cCustomFilter>>
Filter index (which of our filters the user selected):<< THIS.nFilterIndex>>
ENDTEXT
Messagebox(m.myvar)
THIS.clearfilters()
ENDPROC
PROTECTED PROCEDURE dialoghandler
#DEFINE OFN_READONLY 0x00000001
#DEFINE OFN_OVERWRITEPROMPT 0x00000002
#DEFINE OFN_HIDEREADONLY 0x00000004
#DEFINE OFN_NOCHANGEDIR 0x00000008
#DEFINE OFN_SHOWHELP 0x00000010
#DEFINE OFN_ENABLEHOOK 0x00000020
#DEFINE OFN_ENABLETEMPLATE 0x00000040
#DEFINE OFN_ENABLETEMPLATEHANDLE 0x00000080
#DEFINE OFN_NOVALIDATE 0x00000100
#DEFINE OFN_ALLOWMULTISELECT 0x00000200
#DEFINE OFN_EXTENSIONDIFFERENT 0x00000400
#DEFINE OFN_PATHMUSTEXIST 0x00000800
#DEFINE OFN_FILEMUSTEXIST 0x00001000
#DEFINE OFN_CREATEPROMPT 0x00002000
#DEFINE OFN_SHAREAWARE 0x00004000
#DEFINE OFN_NOREADONLYRETURN 0x00008000
#DEFINE OFN_NOTESTFILECREATE 0x00010000
#DEFINE OFN_NONETWORKBUTTON 0x00020000 && for old style dialog
#DEFINE OFN_NOLONGNAMES 0x00040000 && force no long names for 4.x modules
#DEFINE OFN_EXPLORER 0x00080000 && new look commdlg
#DEFINE OFN_NODEREFERENCELINKS 0x00100000
#DEFINE OFN_LONGNAMES 0x00200000 && force long names for 3.x modules
#DEFINE OFN_ENABLEINCLUDENOTIFY 0x00400000 && send include message to callback
#DEFINE OFN_ENABLESIZING 0x00800000
#DEFINE OFN_EX_NOPLACESBAR 0x00000001 && used for newer OS only (uses FlagsEx)
LOCAL lStructSize, hwndOwner, hInstance,;
cMyFilter, i, lpMyFilter,;
nMaxCustomFilter, cUserCustomFilter, lpUserCustomFilter,;
nMaxFileName, cFileName, lpFileName,;
nMaxFileTitle, cFileTitle, lpFileTitle
LOCAL lpInitialDirectory, lpTitlebarText, nFlags, nFlagsEx, ;
nFileOffset, nFileExtension, cDefExt,;
lpDefExt, lCustomData, lpHook, lpTemplateName,;
cMyStruct, nReturnVal, nFileNameOffset
LOCAL lcFileName, lcUserCustomFilter, lcFileTitle,;
nCurrentFilePos, nArraySize, nNextFilePos
hwndOwner = THIS.nHwndOwner
hInstance = THIS.nInstance
nFlags = 0
nFlags = OFN_ENABLEHOOK
nFlagsEx = 0
* Build the filter string.
cMyFilter = ""
FOR i = 1 TO ALEN(THIS.aFilterList, 1)
cMyFilter = cMyFilter + THIS.aFilterList[m.i,1] + CHR(0) + THIS.aFilterList[m.i,2] + CHR(0)
ENDFOR
cMyFilter = cMyFilter + + REPL(CHR(0),2)
lpMyFilter = _FFC_MALLOC(LEN(cMyFilter))
IF lpMyFilter = 0
* Couldn't allocate memory
RETURN ""
ENDIF
* Setup Flags
IF THIS.lNewExplorer
nFlags = nFlags + OFN_EXPLORER
ENDIF
IF THIS.lHideReadOnly
nFlags = nFlags + OFN_HIDEREADONLY
ENDIF
IF THIS.lFileMustExist
nFlags = nFlags + OFN_FILEMUSTEXIST
ENDIF
IF THIS.lNoNetworkButton
* Old style dialogs only
nFlags = nFlags + OFN_NONETWORKBUTTON
ENDIF
IF THIS.lNoChangeDir
nFlags = nFlags + OFN_NOCHANGEDIR
ENDIF
IF THIS.lNoValidate
nFlags = nFlags + OFN_NOVALIDATE
ENDIF
IF THIS.lAllowMultiSelect AND !THIS.lSaveDialog
nFlags = nFlags + OFN_ALLOWMULTISELECT
ENDIF
* Setup FlagsEx
IF THIS.lnoplacesbar
nFlagsEx = nFlagsEx + OFN_EX_NOPLACESBAR
ENDIF
DECLARE INTEGER memcpy IN msvcrt.dll AS _FFC_MEMCPY INTEGER , STRING @, INTEGER
_FFC_MEMCPY(lpMyFilter, @cMyFilter, len(cMyFilter))
* Prepare the custom filter string
nMaxCustomFilter = 1024
cUserCustomFilter = REPL(CHR(0), nMaxCustomFilter)
lpUserCustomFilter = _FFC_MALLOC(nMaxCustomFilter)
IF lpUserCustomFilter = 0
* Couldn't allocate memory
_FFC_FREEMEM(lpMyFilter)
RETURN ""
ENDIF
_FFC_MEMCPY(lpUserCustomFilter, @cUserCustomFilter, nMaxCustomFilter)
* Prepare the string for the selected filename(s)
nMaxFileName = 1024
cFileName = LEFT(THIS.cFileName, 1023) + REPL(CHR(0), nMaxFileName - MIN(LEN(THIS.cFileName),1023))
lpFileName = _FFC_MALLOC(nMaxFileName)
IF lpFileName = 0
_FFC_FREEMEM(lpMyFilter)
_FFC_FREEMEM(lpUserCustomFilter)
ENDIF
_FFC_MEMCPY(lpFileName, @cFileName, nMaxFileName)
* File Title
nMaxFileTitle = 300
cFileTitle = REPL(CHR(0), nMaxFileTitle)
lpFileTitle = _FFC_MALLOC(nMaxFileTitle)
IF lpFileTitle = 0
_FFC_FREEMEM(lpMyFilter)
_FFC_FREEMEM(lpUserCustomFilter)
_FFC_FREEMEM(lpFileName)
ENDIF
_FFC_MEMCPY(lpFileTitle, @cFileTitle, nMaxFileTitle)
* Initial Directory
lpInitialDirectory = _FFC_MALLOC(266)
IF lpInitialDirectory = 0
_FFC_FREEMEM(lpMyFilter)
_FFC_FREEMEM(lpUserCustomFilter)
_FFC_FREEMEM(lpFileName)
_FFC_FREEMEM(lpFileTitle)
ENDIF
_FFC_MEMCPY(lpInitialDirectory, THIS.cInitialDirectory + CHR(0), MIN(LEN(THIS.cInitialDirectory) + 1, 260))
* Title bar text
lpTitlebarText = _FFC_MALLOC(Len(THIS.cTitlebartext) + 2)
_FFC_MEMCPY(lpTitlebarText, THIS.cTitlebartext + CHR(0) + CHR(0), LEN(THIS.cTitlebarText) + 2)
nFileOffset = 0
nFileExtension = 0
* Default Extension
cDefExt = "TXT" + CHR(0) + CHR(0)
lpDefExt = _FFC_MALLOC(LEN(THIS.cDefaultExtension) + 1)
_FFC_MEMCPY(lpDefExt, THIS.cDefaultExtension + CHR(0), LEN(THIS.cDefaultExtension) + 1)
lCustomData = 0 && not used without a hook
lpHook = 0
lpTemplateName = 0
lStructSize = IIF(VAL(OS(3)) > 4, 22, 19) * 4
cMyStruct = THIS.IntegerToString(lStructSize,4) + ;
THIS.IntegerToString(hwndOwner,4) + ;
THIS.IntegerToString(hInstance,4) + ;
THIS.IntegerToString(lpMyFilter,4) + ;
THIS.IntegerToString(lpUserCustomFilter,4) + ;
THIS.IntegerToString(nMaxCustomFilter,4) + ;
THIS.IntegerToString(THIS.nFilterIndex,4) + ;
THIS.IntegerToString(lpFileName,4) + ;
THIS.IntegerToString(nMaxFileName,4) + ;
THIS.IntegerToString(lpFileTitle,4) + ;
THIS.IntegerToString(nMaxFileTitle,4) + ;
THIS.IntegerToString(lpInitialDirectory,4) + ;
THIS.IntegerToString(lpTitleBarText,4) + ;
THIS.IntegerToString(nFlags,4) + ;
THIS.IntegerToString(nFileOffset,2) + ;
THIS.IntegerToString(nFileExtension,2) + ;
THIS.IntegerToString(lpDefExt,4) + ;
THIS.IntegerToString(lCustomData,4) + ;
THIS.IntegerToString(lpHook,4) + ;
THIS.IntegerToString(lpTemplateName,4)
IF VAL(OS(3)) > 4
cMyStruct = cMyStruct + ;
THIS.IntegerToString(0,4) + ;
THIS.IntegerToString(0,4) + ;
THIS.IntegerToString(nFlagsEx,4)
ENDIF
* Call the dialog now
IF THIS.lsavedialog
nReturnVal = _FFC_SAVEFILENAME(@cMyStruct)
ELSE
nReturnVal = _FFC_GETFILENAME(@cMyStruct)
ENDIF
IF nReturnVal = 1
* Now retrieve info from allocated strings
* Retrieve Filename string
DECLARE INTEGER memcpy in msvcrt.dll AS _FFC_MEMCPY2 STRING @, INTEGER , INTEGER
lcFileName = REPL(CHR(0),nMaxFileName)
_FFC_MEMCPY2(@lcFileName, lpFileName, nMaxFileName)
nFileNameOffset = THIS.StringToInteger(SUBSTR(cMyStruct, 14*4+1, 2), 2)
* Check if user selected multiple files.
IF THIS.lAllowMultiSelect AND nFileNameOffset > 1 AND SUBSTR(lcFileName, nFileNameOffset, 1) = CHR(0)
*Now parse out to get multiple file names
nCurrentFilePos = AT(CHR(0), lcFileName) + 1
THIS.cFilePath = LEFT(lcFileName, nCurrentFilePos - 2)
nArraySize = 1
DO WHILE .T.
IF SUBSTR(lcFileName, nCurrentFilePos, 1) = CHR(0)
* end of list.
EXIT
ENDIF
DIMENSION THIS.aFileNames[nArraySize]
nNextFilePos = AT(CHR(0), lcFileName, nArraySize + 1) + 1
THIS.aFileNames[nArraySize] = SUBSTR(lcFileName, nCurrentFilePos, nNextFilePos - nCurrentFilePos - 1)
nArraySize = nArraySize + 1
nCurrentFilePos = nNextFilePos
ENDDO
THIS.nFileCount = nArraySize - 1
ELSE
* Didn't multiselect, so there's just one filename.
lcFileName = LEFT(lcFileName, AT(CHR(0), lcFileName) - 1)
THIS.cFilePath = JUSTPATH(lcFileName)
DIMENSION THIS.aFileNames[1]
THIS.aFileNames[1] = JUSTFNAME(lcFileName)
THIS.nFileCount = 1
ENDIF
THIS.cFileName = LEFT(lcFileName, AT(CHR(0), lcFileName) - 1)
lcUserCustomFilter= repl(chr(0), nMaxCustomFilter)
_FFC_MEMCPY2(@lcUserCustomFilter, lpUserCustomFilter, nMaxCustomFilter)
THIS.cCustomFilter= LEFT(lcUserCustomFilter, AT(CHR(0), lcUserCustomFilter) - 1)
lcFileTitle = repl(chr(0), nMaxFileTitle)
_FFC_MEMCPY2(@lcFileTitle, lpFileTitle, nMaxFileTitle)
THIS.cFileTitle = LEFT(lcFileTitle , AT(CHR(0), lcFileTitle ) - 1)
THIS.nFilterIndex = THIS.StringToInteger(SUBSTR(cMyStruct, 6*4+1, 4), 4)
ENDIF
_FFC_FREEMEM(lpMyFilter)
_FFC_FREEMEM(lpUserCustomFilter)
_FFC_FREEMEM(lpFileName)
_FFC_FREEMEM(lpFileTitle)
_FFC_FREEMEM(lpInitialDirectory)
_FFC_FREEMEM(lpTitleBarText)
_FFC_FREEMEM(lpDefExt)
RETURN nReturnVal
ENDPROC
PROCEDURE Init
THIS.aFilterList[1,1] = "All Files (*.*)"
THIS.aFilterList[1,2] = "*.*"
ENDPROC
ENDDEFINE
*
*-- EndDefine: _comdlg
**************************************************