Hans de Groot

Syntax checking on e-mail addresses

2009-05-17T11:24:00.003+02:00

You can use the following code to validate e-mail addresses in your Foxpro applications.

* Procedure validatemail([emailaddress])

PARAMETERS pEmail

LOCAL cDomains, cPiece, cMessage, cNum, lDomain, lemailname

pEmail = LOWER(ALLTRIM(pEmail))
cMessage = ""
lDomain = .t.
lEmailname = .t.

IF !EMPTY(pEmail)

cdomains = '"aero", "asia", "biz", "cat", "com", "coop", ' +;
'"edu", "gov", "info", "int", "jobs", "mil", "mobi", "museum", ' +;
'"name", "net", "org", "pro", "tel", "travel"'

* some extra checks which are not tackled below
IF ".." $ pemail OR "@." $ pemail OR ".@" $ pemail && missing pieces between dots and pigtail
lEmailname = .f.
ENDIF
IF NOT "@" $ pEmail && no pigtail
lEmailname = .f.
ENDIF
IF OCCURS("@", pemail) > 1 && multiple pigtails
lEmailname = .f.
ENDIF

* check the emailname
cPiece = LEFT(pEmail, AT("@", pEmail)-1)
IF EMPTY(cPiece)
lEmailname = .f.
ELSE
FOR i = 1 TO LEN(cPiece)
cNum = ASC(SUBSTR(cPiece,i,1))
* A to Z, 0 to 9, ! to /
IF between(cNum, 97,122) OR;
between(cNum, 48,57) OR;
between(cNum, 33,47)
ELSE
lEmailname = .f.
ENDIF
ENDFOR
ENDIF

* check the domain name
cPiece = SUBSTR(pEmail, RAT("@", pEmail)+1)
IF EMPTY(cPiece) && empty
lDomain = .f.
ELSE
IF LEN(cPiece) < 4 && domain name to short
lDomain = .f.
ENDIF

cPiece = SUBSTR(pEmail, RAT(".", pEmail)+1)
IF LEN(cPiece) < 2 && part after the last dot to short
lDomain = .f.
ENDIF
IF LEFT(pEmail,1) $ "." && begins with a dot
lDomain = .f.
ENDIF

FOR i = 1 TO LEN(cPiece)
cNum = ASC(SUBSTR(cPiece,i,1))
* A to Z, 0 to 9, ! to /
IF between(cNum, 97,122) OR;
between(cNum, 48,57) OR;
between(cNum, 33,47)
ELSE
lDomain = .f.
ENDIF
ENDFOR

IF LEN(cPiece) > 2 && top level domain
IF NOT '"' + cPiece + '"' $ cdomains && no top level domain
lDomain = .f.
ENDIF
ELSE
* If you have a list with all the country codes, you could check them here...
ENDIF
ENDIF
ENDIF

RETURN (lEmailname = .T. AND lDomain = .T.)

An application-wide hourglass

2009-03-07T08:04:00.006+01:00

When your users are waiting for your application to complete some task, it's nice to show them the hourglass mousepointer as an indication. You can easily set the mousepointer property of the active form, but when the user moves the mouse outside of it, the mousepointer changes to the arrowhead again and that's not how it should be.
The following code changes the mousepointer for all the forms in your application.
Put the code in a .PRG file and (very important!) name it MAUSER, because that was what Richard and I named it originally.
The reason for that is, that at the moment we were thinking about how to name this function, our friend Maurits walked in the room and 'Maus' is what we call him for short. Also 'maus' is the German word for mouse.

Activating and deactivating the hourglass is as simple as putting =MAUSER(.T.) and =MAUSER(.F.) around the piece of code that takes a while to execute.

PARAMETERS lZetAan

LOCAL nFormTeller

FOR nFormTeller = 1 TO _Screen.FormCount
_Screen.Forms(nFormTeller).SetAll("MousePointer",IIF(lZetAan,11,0))
_Screen.Forms(nFormTeller).MousePointer = IIF(lZetAan,11,0)
NEXT
_Screen.SetAll("MousePointer",IIF(lZetAan,11,0))

_Screen.MousePointer = IIF(lZetAan,11,0)
IF TYPE("_Screen.Activeform.Name") = "C"
_Screen.Activeform.SetAll("MousePointer",IIF(lZetAan,11,0))
ENDIF

Can you put a file in the desired location?

2008-08-07T08:10:00.007+02:00

When you want to put a file in a certain location, you may want to check if it is possible to write to that location. You might not have write permission, the location might not exist or a file with the same name allready exists and cannot be overwritten because it is in use. With the code below, you can check this out:

* FUNCTION FILEOVERWRITE()

PARAMETERS cGo

fhandle =FCREATE(cGo)
IF fhandle > -1
=FCLOSE(fhandle)
DELE FILE (cGo)
RETURN .T.
ELSE
RETURN .F.
ENDIF

Function that returns a part of a comma-separated string

2008-08-01T17:41:00.003+02:00

Whenever you need to to handle comma-separated string, you might want to check the function below, which makes use of VFP's ALINES() function to return a certain value in the string.

* Parameters: String (character) , which part (numeric), delimiter (character)
PARAMETERS cCsv, nPart, pdelimiter

IF PCOUNT() < 3
pDelimiter = ","
ENDIF

cCsv = STRTRAN(cCsv, pDelimiter, " "+CHR(13) )

ALINES(aCsv, cCsv , .T.)

* When array element 1 = .False. => return ""
* When the number of array elements < nPart => return ""
* Otherwise, return the piece of the string

RETURN IIF( TYPE( "aCsv[1]" ) = "L" , "", IIF( ALEN(aCsv,1) < nPart , "", aCsv[nPart] ) )

Resize or reposition a desktop form to fit the Windows desktop

2008-07-28T21:11:00.010+02:00

In your VFP application, you want your users to have the application form re-appear as it was left behind the last time. So, you store the screen coordinates (in your apps mechanism that saves the application settings) and restore the form to the saved coordinates, the next time it is run.
But in the mean time, the user may have altered the screen resolution, changed to a p.c. with a different screen resolution or moved/resized the Windows startbar.

I these scenario's, your application form may not fit in the Windows desktop anymore.
Below, you find the code of SETFORMSIZE.PRG, which repositions the form to fit the desktop again.

To test it:
- create a form with the desktop property to .True.
- Put this code in the load method of the form:
This.Top = -100
This.Left = -100
This.Width = 100000
This.Height = 100000
DO SETFORMSIZE WITH This
- Run the form

************************************************************************
* SETFORMSIZE.PRG *
************************************************************************
PARAMETERS oForm

LOCAL nWinHeight, nWinWidth, nCorrection

* Width en height of screenspace minus space occuped by the startmenu bar
* wherever that is placed or whatever size it is
nWinHeight = SYSMETRIC(22)
nWinWidth = SYSMETRIC(21)
nCorrection = sysmetric(3)*2

* First: check if the form is off screen above and to the left
IF oForm.Left < 0
oForm.Left = 0
ENDIF
IF oForm.Top < 0
oForm.Top = 0
ENDIF

* Next: check if the form is to high or wide to fit in the screen
IF (oForm.Top + oForm.Height) > nWinHeight && Oh Oh, Formheight beyond screen
nHowMuch = (oForm.Top + oForm.Height ) - nWinHeight
IF nHowMuch > oForm.Top && Oh oh, form does not fit in the screen
IF oForm.MinHeight >= (nWinHeight - oForm.Height )
oForm.Height = nWinHeight - nCorrection
ENDIF

nNewTop = 0
ELSE
nNewTop = (oForm.Top - nHowMuch) - nCorrection
ENDIF
ELSE
nNewTop = oForm.Top
ENDIF
IF (oForm.Left + oForm.Width) > nWinWidth && Oh Oh, Formwidth beyond screen
nHowMuch = (oForm.Left + oForm.Width ) - nWinWidth
IF nHowMuch > oForm.Left && Oh oh, form does not fit in the screen
IF oForm.MinWidth >= (nWinWidth - oForm.Width )
oForm.Width = nWinWidth - nCorrection
ENDIF
nNewLeft = 0
ELSE
nNewLeft = (oForm.Left - nHowMuch) - nCorrection
ENDIF
ELSE
nNewLeft = oForm.Left
ENDIF

oForm.Left = nNewLeft
oForm.Top = nNewTop

Is MS Office installed on a computer?

2007-07-26T07:43:00.001+02:00

There are more ways to detect if MS Excel, Outlook or Word is installed on a computer. One way is, to look it up in the Window registry.
The following code does exactly that.

* Code that shows if Outlook, Word and Excel are installed:

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\outlook.exe"
OutlookExists = readregstring(-2147483646, ckey, "path")

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\winword.exe"
WinWordExists = readregstring(-2147483646, ckey, "path")

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\excel.exe"
ExcelExists = readregstring(-2147483646, ckey, "path")

? !EMPTY(NVL(OutlookExists,""))
? !EMPTY(NVL(WinWordExists,""))
? !EMPTY(NVL(ExcelExists,""))

The code makes use of a function called 'readregstring' That function is:

***----------------------------------------------------------------------
*** Function: Reads a string value from the registry.
*** Pass: tnHKEY - HKEY value (in CGIServ.h)
*** tcSubkey - The Registry subkey value
*** tcEntry - The actual Key to retrieve
*** Return: Registry String or .NULL. on error
***----------------------------------------------------------------------
LPARAMETERS tnHKey, tcSubkey, tcEntry
LOCAL lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType

tnHKey=IIF(type("tnHKey")="N",tnHKey,This.HKEY_LOCAL_MACHINE)

lnRegHandle=0

DO DeclareInit && Declare WinAPI function. You only have to do this once.

*** Open the registry key
lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult # 0
RETURN .NULL.
ENDIF

*** Need to define here specifically for Return Type
*** for lpdData parameter or VFP will choke.
*** Here it's STRING.
DECLARE INTEGER RegQueryValueEx ;
IN Win32API AS RegQueryString;
INTEGER nHKey,;
STRING lpszValueName,;
INTEGER dwReserved,;
INTEGER @lpdwType,;
STRING @lpbData,;
INTEGER @lpcbData

*** Return buffer to receive value
lcDataBuffer=space(256)
lnSize=LEN(lcDataBuffer)
lnType=0

lnResult=RegQueryString(lnRegHandle,tcEntry,0,@lnType,;
@lcDataBuffer,@lnSize)

=RegCloseKey(lnRegHandle)

IF lnResult # 0
RETURN .NULL.
ENDIF

IF lnSize<2
RETURN ""
ENDIF

*** Return string based on length returned
RETURN SUBSTR(lcDataBuffer,1,lnSize-1)

And the DeclareInit function that is called:

*** Open a registry key
DECLARE INTEGER RegOpenKey ;
IN Win32API ;
INTEGER nHKey,;
STRING cSubKey,;
INTEGER @nHandle

*** Close an open registry key
DECLARE Integer RegCloseKey ;
IN Win32API ;
INTEGER nHKey

Importing an Excel spreadsheet in VFP using Excel

2007-06-29T11:39:00.000+02:00

De native IMPORT function of Visual Foxpro doesn't allways do a good yob. For example, sometimes it converts numbers to date values (01-01-1900).
The code below uses office automation to let Excel itself export the spreadsheet to dBase format. Also, you don't have to know in which version of Excel the spreadsheet is created, like you have to with the IMPORT function.

The code does not work with Excel 2007, because Microsoft decided to say bye bye to the dBase export filters.

Run the .PRG file like:

DO XLS2DBF WITH 'MySpreadsheet.xls', 'MyTable.dbf'

* XLS2DBF.PRG
*
* Function accepts 2 parameters
* 1) cSheet is the Excel sheet that is to be exported
* 2) cExportFile is the filename of the exportfile

PARAMETERS cSheet, cExportFile

IF PCOUNT() = 1
* Create a temp export file
cExportFile = SYS(2023) + "\" + SYS(3) + ".tmp"
ENDIF

LOCAL lErrorCatched, oExcelWorkbook, nFileFormat

nFileFormat = 11 && Excel Saveas constant for dBase IV format. Not available in Excel 2007 though...
lErrorCatched = .F.

* Can we get to Excel or what?
TRY
oExcelObject = CREATEOBJECT('Excel.Application')
CATCH
lErrorCatched=.T.
ENDTRY

IF lErrorCatched
RETURN .F.
ELSE

oExcelWorkbook = oExcelObject.Application.Workbooks.Open(cSheet)

* When columns in Excel are to small to show all the data, Excel also cuts them off when exporting!
* The code below formats the columns to be wide enough...
oExcelObject.Cells.Select
oExcelObject.Selection.Font.Size = 11 && dBase IV
oExcelObject.Selection.Columns.AutoFit
oExcelObject.Selection.Font.Size = 8

oExcelObject.cells(1).select && makes sure the whole sheet is exported and not some selected range (or whatever goes wrong with that from time to time...)
oExcelObject.DisplayAlerts = .F. && prevents overwrite message
oExcelWorkbook.SaveAs(cExportFile, nFileFormat)
oExcelWorkbook.close

* When opening a .DBF file created by Excel, there is no codepage
* VFP opens up the codepage dialog in order to choose a codepage, but we don't want that
* SET CPDIALOG OFF won;t help, because then there stil is no codepage for the .DBF file
* Luckily, VFP provides CPZERO.PRG, with can update a .DBF with a codepage
* You could do: DO CPZERO WITH cExportFile, 850
* But instead, the code below is a little piece of the CPZERO code that does the job, so we don't
* have to include CPZERO.PRG itself.
LOCAL varcpbyte, varfp_in, varbuf
varcpbyte = 2
varfp_in = FOPEN(cExportFile,2)
IF varfp_in > 0
* First check that we have a FoxPro table...
varbuf=FREAD(varfp_in,32)
IF (SUBSTR(varbuf,1,1) = CHR(139) OR SUBSTR(varbuf,1,1) = CHR(203);
OR SUBSTR(varbuf,31,1) != CHR(0) OR SUBSTR(varbuf,32,1) != CHR(0))
=fclose(varfp_in)
RETURN .F.
ELSE
* now poke the codepage id into byte 29
=FSEEK(varfp_in,29)
=FWRITE(varfp_in,CHR(varcpbyte))
=FCLOSE(varfp_in)
ENDIF
ELSE
RETURN .F.
ENDIF

* If no exportfile is specified, open the data as a temporary table to undertake further action
IF PCOUNT() = 1
cAlias = "C"+SYS(3)
USE (cExportFile) IN 0 ALIAS (cAlias)
* BROWSE NORMAL NOWAIT && if you want
ENDIF

* clean up Excel object
oExcelObject = .NULL.
RELEASE oExcelObject

Listgrid - update 3

2006-10-01T20:09:00.000+02:00

In this third update of the listgrid control, it is possible to change the grid's record source at run time. There is a new 'Open file' button in the example form that shows how.

Further, to solve the second issue in the post of july 30th, the width of the rightmost column in the grid is now changed to span the gap that normally appears when the total with of the visible columns are smaller than the grid's width. There is a new method Setrightmostcolumnwidth that takes care of this.

An updated download is available here (ZIP compressed file, 45 kb).

For more info about the Listgrid control, see the original post of July 16.

A resize grip on a Foxpro form

2006-09-29T18:47:00.000+02:00

As a visual clue that a form can be resized, many forms have a 'resize grip' in the lower right corner. Visual Foxpro does not have native support for showing a resize grip on a form. But that won't stop us, we can make our own!

Over here you can download a zip file containing a resizer class. It's based on a container class and constructs it's own grip shape (Windows XP style). Just drop the class on a form and add This.resizer1.resize to the forms resize method. An example form is also included, which looks like this:

Images in a VFP grid class

2006-09-02T10:56:00.000+02:00

In the listgrid class in this blog, it is possible to have different images in the cells of the same column in a grid. This is done using the DynamicCurrentControl feature and works great if there are only a few images.
When you have a lot of images to show, it seems like a bad idea to add even so much image controls to the grid column.
Luckily, there is another way to do the same. I found out about this here while working on the listgrid class. It works by creating a container class which is used as the control for the column. In the container class itself, you create an access method for the backstyle property of the container (open the class, go to the Class pad in the Foxpro menu, select Edit property/method and check the Access Method for the backstyle.
Then, in the access_method itself, you put code like This.picture = Mytable.Image, where Image is a text field in Mytable used as the grid recordsource. The text field contains the names of the images to use, which can be found on disk along the VFP path.

You can download an example here as a zip compressed file (9.6 Kb). Run the example form and look at the code in the example class. This is how it looks:

Listgrid - update 2

2006-07-30T08:16:00.000+02:00

When using the vertical scroll bar to move through the grid, there where problems with the screen painting. Screen painting issues are also mentioned in VFP's help about the Scrolled event. However, it's now solved by changing some code in the Scrolled event of the grid.

I also found two new issues to think about:
1) You can select/deselect the current record with Ctrl+mouse click. However, when you move away from the this record by using the down or up arrow keys, the previous or next record is selected, but keeps the selected/deselected state of the previous record.
2) When there are multiple records selected and you move to the right most column in the grid, there is allways some space at the right. You can see there that the inverted color of the current record continues in this 'empty column', but the other selected records don't.

An updated download is available here (ZIP compressed file, 44 kb).

For more info about the Listgrid control, see the original post of July 16.

Listgrid - update

2006-07-17T08:02:00.000+02:00

The listgrid control stopped responding, when you kept the Shift+Dn or Shift+Up keys pressed for a little while (in order to select multiple records). A 'thisform.draw' in the keypress event of the grid seems the solution to that problem.
An updated download is available here (ZIP compressed file, 44 kb).

Listgrid - a grid acting like a listview

2006-07-16T12:20:00.000+02:00

A few month back, I decided to follow up on some ideas to make the VFP grid control act like a multi-select listview. In my applications I often use the MS listview control for this, but since MS stopped development on their core OCX controls, the listview control is beginning to show it's age with Windows 2000 style column headers in a XP world. The objective is to copy as much of the functionality of the MS listview. I just want to try how far this goes. If it doesn't work out, I'll switch to another third party OCX control. Here it is as it looks now:

Features
The class has the following features:

Multiselect option (set multiselect to .T.), using standard Windows keys (Shift, Ctrl combinations).
Sorting columns.
Have Pictures in columns.
Save and restore reordered columns, column widths and the column which was last sorted.
Export to Excel.

Quick start

Drop the class on a form.
Resize the container of the class to the desired size. The grid inside it will automatically size accordingly.
Set the recordsource property to the desired table/view/cursor.
Put code like this in the init method of the form:
IF !USED("CUSTOMER")
USE CUSTOMER IN 0
SELECT CUSTOMER
ENDIF
This.lGrid1.Multiselect = .T. && multiselect if desired
This.lGrid1.RecordSource = ALIAS()
This.lGrid1.initialise()
Run the form.

Listgrid table
There is a table called Listgrid, which contains column information for every recordsource used in the Listgrid class.
The table is created if it does not allready exists and updated automatically with default column
information for each recordsource opened by the class.
In the supplied Listgrid table, there is allready information about the example Customer table.
You can alter the data in the table, so you can have calculated fields and pictures in the grid.

Table: contains the same name for all records belonging to a certain recordsource
Controlsrc: you can see there are options to create a controlsource expression for every column
Fieldtype: data type of the column. You can use a 'P' for pictures
Fieldwidth: width of the field, not used by the listgrid class itself
Decimals: decimals of the field, not used by the listgrid class itself
Descript: shows up in the column header
Alignment: alignment of the header. 0 = left, 1 = right
Disporder: set the order in which the columns are shown
Visible: .False. for columns that must not show up
Colwidth: column width in pixels
DispinXLS: the column shows up in the Export2Excel option of the class
Images: list of images used for FieldType = "P"

Pictures
You can do the following to create a column with pictures in it:

In the field images in the listgrid table, create a comma separated list of the images to use in the column. Just the filename is enough, as long as the images themselves are along the VFP path.
In the field Controlsrc create an expression which returns a text 'Image1', 'Image2' , 'Image3' , etc. for the image you want to show up. For example:

IIF(MyField = "Man", "Image1", IIF(MyField = "Woman", "Image2", "Image3"))

Whenever the text in the field is "Man", the first image in the list shows up, for "Woman" the second, otherwise the third image.

Export to excel
To demonstrate the multiselect feature, there is a ExportToExcel method in the class to show the data of selected records in an Excel sheet. In the Example form, only the selected records show up in Excel with the optional where clause parameter.

Save/restore column widths
The class has a Savesettings method to save information about reordered columns and changed column widths. See the Init and Destroy methods of the example form for a way to save and restore these settings.

Column sorting
You can sort on a column by clicking it's header. This only works if it is possible to create an index. So in READ ONLY or EXCLUSIVE OFF situations, columns sorting does not work.

Issues
This version of the class you can actually use. There are however still some issues.

Selecting records with Shift+Dn and Shift+Up eventually 'hangs' the grid control for a while, when you keep these keys pressed. I think there is something wrong with the DOSCROLL method.
Pressing Ctrl+A to select all records in the grid is handled through an ON KEY LABEL. This is, because the Ctrl+A key combination isn't handled by the Keypress event of the grid. The ON KEY LABEL is activated/deactivated in the WHEN and VALID events of the grid. However, when you click on de form itself and than return to the grid, the WHEN event is not triggeredand Ctrl+A isn't (re-)activated.
The dotted outline of the selected row is a VFP shape that does not look like 'the real thing', which has smaller dots. Maybe there is another solution with the use of GDI...
Scrolling records with the vertical scroll bar messes up the screen painting in the grid control.

Visual Foxpro version
The Listgrid class makes use of the AllowSelection property which is introduced in VFP8, so VFP8 or higher is needed.

Download
You can use this class every way you like, but for your own responsibility.
Any positive comments and ideas are welcome at http://hdegroot.blogspot.com/

A download as a ZIP compressed file (44 kb.) is available here.