Category: Programming

Posted on

VFP: Create header files

Header files (.H) contain declarations and sometimes code. Software uses codes for specific actions or settings, but these codes are illegible for most humans. The header file for Microsoft Word 2016 contains more than 4.500 lines. It starts like this:

* WdMailSystem
#DEFINE wdNoMailSystem 0
#DEFINE wdMAPI 1
#DEFINE wdPowerTalk 2
#DEFINE wdMAPIandPowerTalk 3

* WdTemplateType
#DEFINE wdNormalTemplate 0
#DEFINE wdGlobalTemplate 1
#DEFINE wdAttachedTemplate 2

The header files are not included in the distributions, so you have to search for them yourself or create them if possible.

This program originates from an old Microsoft article. It creates a dialog where you can locate an .OLB file (Object Library). It then extracts all constants and gives you the ability to save them to your header file.

* Bron: https://web.archive.org/web/20110808014156/http://support.microsoft.com/kb/285396

****************START CODE****************
PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.SHOW
RETURN


****************FORM CODE****************
DEFINE CLASS form1 AS FORM

	HEIGHT = 445
	WIDTH = 567
	DOCREATE = .T.
	AUTOCENTER = .T.
	BORDERSTYLE = 1
	CAPTION = ".OLB Constants Extractor"
	MAXBUTTON = .F.
	MINBUTTON = .F.
	NAME = "Form1"

	ADD OBJECT txtolbfile AS TEXTBOX WITH ;
		HEIGHT = 27, ;
		LEFT = 65, ;
		READONLY = .T., ;
		TABINDEX = 2, ;
		TOP = 6, ;
		WIDTH = 458, ;
		NAME = "txtOLBFILE"

	ADD OBJECT label1 AS LABEL WITH ;
		AUTOSIZE = .T., ;
		CAPTION = ".\<OLB File:", ;
		HEIGHT = 17, ;
		LEFT = 4, ;
		TOP = 11, ;
		WIDTH = 55, ;
		TABINDEX = 1, ;
		NAME = "Label1"

	ADD OBJECT cmdsave AS COMMANDBUTTON WITH ;
		TOP = 411, ;
		LEFT = 394, ;
		HEIGHT = 27, ;
		WIDTH = 84, ;
		CAPTION = "\<Save to .h", ;
		ENABLED = .F., ;
		TABINDEX = 6, ;
		NAME = "cmdSAVE"

	ADD OBJECT cmdquit AS COMMANDBUTTON WITH ;
		TOP = 411, ;
		LEFT = 480, ;
		HEIGHT = 27, ;
		WIDTH = 84, ;
		CAPTION = "\<Quit", ;
		TABINDEX = 7, ;
		NAME = "cmdQUIT"

	ADD OBJECT edtconstants AS EDITBOX WITH ;
		HEIGHT = 347, ;
		LEFT = 6, ;
		READONLY = .T., ;
		TABINDEX = 4, ;
		TOP = 52, ;
		WIDTH = 558, ;
		NAME = "edtConstants"

	ADD OBJECT cmdgetfile AS COMMANDBUTTON WITH ;
		TOP = 6, ;
		LEFT = 533, ;
		HEIGHT = 27, ;
		WIDTH = 26, ;
		CAPTION = "...", ;
		TABINDEX = 3, ;
		NAME = "cmdGETFILE"

	ADD OBJECT cmdextract AS COMMANDBUTTON WITH ;
		TOP = 411, ;
		LEFT = 280, ;
		HEIGHT = 27, ;
		WIDTH = 110, ;
		CAPTION = "\<Extract Constants", ;
		ENABLED = .F., ;
		TABINDEX = 5, ;
		NAME = "cmdEXTRACT"


	PROCEDURE cmdsave.CLICK
		STRTOFILE(THISFORM.edtconstants.VALUE,PUTFILE([Header File], ;
			JUSTSTEM(THISFORM.txtolbfile.VALUE) + [.h],[.h]))
	ENDPROC


	PROCEDURE cmdquit.CLICK
		THISFORM.RELEASE
	ENDPROC


	PROCEDURE cmdgetfile.CLICK
		LOCAL lcOLBFile

		lcOLBFile = GETFILE([OLB],[OLB File],[Open])
		IF EMPTY(lcOLBFile)
			RETURN .F.
		ENDIF
		
		IF UPPER(RIGHT(lcOLBFile,3)) # [OLB]
			MESSAGEBOX([Invalid File],0,[])
			RETURN .F.
		ENDIF

		THISFORM.txtolbfile.VALUE = lcOLBFile
		THISFORM.cmdextract.ENABLED= .T.
	ENDPROC


	PROCEDURE cmdextract.CLICK
		WAIT WINDOW [Processing...] NOCLEAR NOWAIT
		LOCAL oTLB_INFO, oConstants, lcConstantsStr, Obj, member
		#DEFINE CRLF CHR(13) + CHR(10)

		oTLB_INFO = CREATEOBJECT([tli.typelibinfo])
		oTLB_INFO.ContainingFile = (THISFORM.txtolbfile.VALUE)

		oConstants = oTLB_INFO.Constants

		lcConstantsStr = []
		FOR EACH Obj IN oTLB_INFO.Constants
                        lcConstantsStr = lcConstantsStr + CRLF + "* " + Obj.Name + CRLF   
                        FOR EACH member IN Obj.Members
                            lcConstantsStr = lcConstantsStr + [#DEFINE ] + ;
                            member.NAME + [ ] + ;
                            TRANSFORM(member.VALUE) + CRLF
                        NEXT member
		NEXT Obj

		THISFORM.edtconstants.VALUE=lcConstantsStr
		THISFORM.cmdsave.ENABLED= .T.
		WAIT CLEAR
		WAIT WINDOW [Complete!] TIMEOUT 2
	ENDPROC

ENDDEFINE
****************END CODE****************

Posted on

VFP: Check already running (NL)

Draait een programma al?

Door jasperdg op 16 Jul 2007

Het is soms niet handig als je een programma start terwijl dit al draait. Vooral bij programma’s die bewerkingen uitvoeren op databases is dit zeer ongewenst (indexeer programma’s etc). Hier een geschikte module die met Win32Api functies de actieve vensters uitleest en kijkt of een specifiek programma in de actieve titels voorkomt…

Met dank aan FoxStuff.

Programma IsRunning.prg :

 (0 als niet gevonden, anders het handle nummer)


* Generic routine to check if a given 
* application is running on the user's system.
* Parameter is all or part of the window's title.
LPARAMETERS tcTitle

DECLARE INTEGER GetActiveWindow IN Win32API
DECLARE INTEGER GetWindow IN Win32API ;
  INTEGER hWnd, INTEGER nType
DECLARE INTEGER GetWindowText IN Win32API ;
  INTEGER hWnd, STRING @cText, INTEGER nType

lhNext = GetActiveWindow() && current app's window
* iterate through the open windows
DO WHILE lhNext#0
 lcText = REPLICATE(CHR(0),80)
 GetWindowText(lhNext,@lcText,80) && get window title
 IF UPPER(ALLTRIM(tcTitle)) $ UPPER(lcText)
  * parameter text is present in window title
  RETURN lhNext
 ENDIF
 lhNext = GetWindow(lhNext,2) && next window
ENDDO
* required window not found
RETURN 0

Posted on

VFP: Execute latest (NL)

Foxpro nieuwste versie programma starten

Door jasperdg op 14 Feb 2008

In Visual Foxpro compileer je een programma naar een executable (.exe). Als echter het programma reeds in gebruik is (vele netwerk gebruikers), dan kan de nieuwe executable niet worden overschreven. Ik vind dat niet logisch, want alle gebruikers hebben het programma immers al in hun werkgeheugen staan, maar wie ben ik?

Mijn oplossing is om de executable te kopiëeren en deze kopie uit te laten voeren. Uiteraard moet dit wel automatisch en transparant voor de gebruiker gebeuren. Dit is een verademing als je moet ontwikkelen in een netwerk omgeving.
Mocht een nieuwe release niet goed werken, dan kan je terug naar een werkende release door de desbetreffende versiekopie te kopieëren naar de standaard executable.

* Gstarter: Starten van software 

 LPARAMETERS tcRelatie,tcTijd,tcPostcode,tcPlaats,tcPad
 IF VARTYPE(tcRelatie)<>[C] 
  tcRelatie = []
 ENDIF 
 lcProgramma = [q:\programmeren\vfp\synplan2007\synplan.exe]
 AGETFILEVERSION(laVersie, lcProgramma)
 lcVersie = laVersie(11)
 lcDoel = ADDBS(JUSTPATH(lcProgramma))+JUSTSTEM(lcProgramma)+lcVersie+[.]+JUSTEXT(lcProgramma)
 IF !FILE(lcDoel)
  COPY FILE (lcProgramma) TO (lcDoel)
 ENDIF 
 DO (lcDoel) WITH tcRelatie, lcVersie

Dit voorbeeld is iets ingewikkelder omdat er parameters moeten worden doorgegeven. Het programma heet “synplan.exe” en een kopie heet bijvoorbeeld “synplan1.0.3.exe”

Posted on

VFP: Create Datetime

Foxpro convert date and time to DateTime variable

By jasperdg on Mar 13, 2008

On the net some silly, unusable answers have been posted where programmers just concatenate DTOC() and DATE(). This is wrong! The DTOC() function depends on local date settings, thus resulting string of characters can not be predicted.

That’s why I had to create this little function:

FUNCTION DTtoDateTime(ldDate,lcTime)
 RETURN DATETIME(YEAR(ldDate),MONTH(ldDate),DAY(ldDate),;
        VAL(LEFT(lcTime,2)),VAL(RIGHT(lcTime,2)))
ENDFUNC

This function is independent to local date and time settings.

Posted on

VFP: Hide mouse cursor

Hide Mouse Cursor in Visual Foxpro

Today I needed to hide the mouse cursor for a presentation program. Objects in VFP have a MousePointer property with which you can select the appearance of the cursor. 0 for default Windows behaviour, 1 to 17 for specific shapes like arrow (1) or hourglass (11) and 99 for Custom design. There is no “Hidden” appearance, No “MouseVisible” property. Shame.

What to do?

  1. Download the blank cursor.
  2. Next you select the forementioned 99 (custom) MousePointer value and
  3. last place the filename (Null.cur) in the MouseIcon field.

Posted on

VFP: Correct week number

Calculate Week number correctly in Visual Foxpro

Silly Week() function in Foxpro doesn’t work like it should! The year 2009 was very long… So it had a week 53. I think here in Holland we use the method that the larger part of the week should be in the new year to call it week number one. (Silly me looked over the 3rd parameter. See the easy solution below under Update).

So according to the help on the Week() function we select nFirstWeek 2 (The larger half (four days) of the first week is in the current year.).

Foxpro Week(Date(2009,12,31),2) returns week 52! That is absolutely wrong. A search on the Internet brought me a solution that works for me. It was found on Fox Wiki. This is the very impressive code:

FUNCTION GetWeekNo
 LPARAMETERS ldDate
 lnJulian = VAL(SYS(11,ldDate))+1
 lnDay4 = MOD(MOD(MOD((lnJulian+31741 - MOD(lnJulian,7)),146097),36524),1461)
 lnLeap = INT(lnDay4/1460)
 lnDay1 = MOD(lnDay4-lnLeap,365) + lnLeap
 RETURN INT(lnDay1/7)+1
ENDFUNC

Thanks go to theRambler who proposed this on TekTips.

UPDATE

I stand corrected… Nard van Gentevoort emailed me to explain the VFP Week() function wil give me the right week number. But first I have tot tell it what day the week starts on. Silly Americans start the week on Sunday “at the seventh day he relaxed and saw all was good”.. doesn’t ring a bell? So because we do things right and start off our week at Monday, the full function call in the Netherlands should be: Week(date,2,2). Tested WEEK(DATE(2009,12,31),2,2) and it gives 53 like I expect it to. Thanks Nard !

Posted on

VFP: Webpage to file

Read web content to a file

A Visual Foxpro function to read a web page’s content into a (cached) file.

UrlToFile.prg

LPARAMETERS tcRemote
 * URL reader from Fox Wiki site: http://fox.wikis.com/wc.dll?Wiki~ReadUrl~VFP
 * Accept URL
 * Return cached filename
 * Note: file gets deleted after first contact. So do filetostr() first! After file() it will be gone.
 LOCAL lnResult, lcTargetFile
 lcTargetFile = REPLICATE(CHR(0), 250)
 DECLARE INTEGER URLDownloadToCacheFile IN urlmon;
 INTEGER lpUnkcaller, STRING szURL, STRING @szFileName,;
 INTEGER dwBufLength, INTEGER dwReserved, INTEGER pBSC
 WAIT WINDOW NOWAIT "Downloading remote file..."
 lnResult = URLDownloadToCacheFile(0, tcRemote, @lcTargetFile,LEN(lcTargetFile), 0,0)
 WAIT CLEAR
 RETURN STRTRAN(lcTargetFile, Chr(0), "")

And wrapper UrlToStr.prg:

LPARAMETERS tcRemote
 * Wrapper for UrlToFile to read web content into a string
 LOCAL lcFile,lcResult
 lcFile = UrlToFile(tcRemote)
 lcResult = FILETOSTR( lcFile)
 RETURN lcResult

Posted on

VFP: Fetch XML feed

Interpreting XML Feed in Visual Foxpro

Looking for ways to interpret XML files I stumbled on this article at the foxite.com forum. This was still way too difficult in my opinion. So I used the methods and created some lean code that does what I want in far less code.

This piece of program retrieves a feed from the Dutch public-services network and lists all items:

lcFeed = [http://feeds.livep2000.nl/]
lcFile = UrlToFile(lcFeed)

oXML = CREATEOBJECT("MSXML2.DOMDocument")
oXML.load(lcFile)
oItems = oXML.getElementsByTagName([item])
FOR EACH oItem IN oItems
 FOR EACH oLine IN oItem.childNodes
  ? oLine.nodeName+[: ]+oLine.text
 ENDFOR 
ENDFOR

Posted on

VFP: Progress bar

VFP Progress bar using foundation class

Using the foundation class you can have a progress bar in no time. Hardest part is to locate the FFC folder, but most of the times it’s just beneath the vfp install program folder found with SYS(2004).

Half this code is for slowing down the demo:

* Progressbar with VFP Foundation Classes
* Source: https://degraafonline.com
* Free after Carl Warner's article at http://www.vfug.org/Newsletters/ThermometerBar.htm 

 lnPause = 2 && seconds between steps
 lcLibraryLocation = SYS(2004)+[FFC\]
 loTherm = NewObject([_thermometer],lcLibraryLocation+[_therm],[],[Progress Example])
 loTherm.Show
 =INKEY(lnPause,[HM])
 loTherm.Update(10) && just set the progress bar
 =INKEY(lnPause,[HM])
 loTherm.Update(20,[80 percent to go]) && set progress bar and show a subtitle
 =INKEY(lnPause,[HM])
 loTherm.Update(50,[half way])
 =INKEY(lnPause,[HM])
 loTherm.Complete([Ready])
 =INKEY(lnPause,[HM])
 loTherm.Release