Scott Scovell on Visual FoxPro

Decorating with This_Access

2006-01-06T23:43:00.000+11:00

Lately I have been busy coding VFP Solution Explorer, but I thought I would take a short break (don't tell Craig) to share this with you.

I had a situation(s) where I needed to sub-class a non-sub-classable(?) object, like a COM object. I naturally started to implement a decorator pattern but was faced with a mountain of tedious coding to implement the COM objects' interface (properties, events, and methods) even using the object browser to generate the basic class definition.

Having never really used the This_Access method in anger before, I decided to have a second look. This saved me loads of time as it relived the need to implement all those PEMs I was not really interested in.

Here is a simplified example of how I used the This_Access method as a shortcut for my decorator class.

* Set this constant to an existing project you have somewhere

#Define PROJECT_FILE "MyProjectFile.pjx"

Local oMyProject As MyProject

* Create an instance of our project class passing the project file to the Init method.

oMyProject = NewObject("MyProject", "", "", PROJECT_FILE)

* Display some project properties to the desktop

? oMyProject.HomeDir

? oMyProject.Files.Count

* Call our Close method so we can execute our code before and after the project closes.

oMyProject.Close()

Return

Define Class MyProject As Custom

IFoxProject = Null

Function Init(lpcProjectFile As String)

* Check if project is open

If Type([Application.Projects("] + lpcProjectFile + [")]) = "U"

* Open project

Modify Project (lpcProjectFile) NoWait Save NoShow

EndIf

* Set a reference to the project object

This.IFoxProject = Application.Projects(lpcProjectFile)

EndFunc

Function This_Access(lpcMemberName As String)

* Check if we wish to handle this or just pass it on to the IFoxProject object

If Not InList(lpcMemberName, "ifoxproject", "build", "close")

* Check we have a reference to the project object

If Not IsNull(This.IFoxProject)

Return This.IFoxProject

EndIf

* Return the reference to this class

Return This

EndFunc

Function Close()

*** Write code or raise a before close event here ***

This.IFoxProject.Close()

*** Write code or raise an after close event here ***

EndFunc

Function Build( lpcOutputName As String, lpnBuildAction As Integer,;

lpbRebuildAll As Boolean, lpbShowErrors As Boolean,;

lpbBuildNewGUIDs As Boolean)

*** Write code or raise a before build event here ***

This.IFoxProject.Build( lpcOutputName As String, lpnBuildAction As Integer,;

lpbRebuildAll As Boolean, lpbShowErrors As Boolean,;

lpbBuildNewGUIDs As Boolean)

*** Write code or raise an after build event here ***

EndFunc

EndDefine

As you can see from the code, I have defined my project decorator class with only those members I need to extend (the Close and Build methods in the example). In the This_Access method, I check at runtime what member is being accessed (or assigned) and "switch" between returning my object instance and returning the object instance I am decorating.

The attractiveness of this approach is the amount of code required when only a few PEMs need to be sub-classed. When new requirements present, new PEMs can be added to your class and those member names added to the list in This_Access. (you could even use PEMSTATUS() to test if the member name parameter is defined on your class and never have to touch the This_Access again).

Further benefits to this design allows the interface your decorating (sub-classing) to extend with out breaking your code (excluding member name conflicts and changes to the existing interface, but those are current sub-classing issues as well aren't they). That is, if the implemented class adds a new property, your class will inherit the property as if you sub-classed.

On the down side, the caller is somewhat blind to the PEMs'. That is, by using the This_Access method, the PEMs' are only made available "just in time". Try using PEMSTATUS() or AMEMBERS() on the oMyProject object and see what is returned?

I will let you know how this design holds up in the VFP Solution Explorer project.

Powered By Qumana

AMEMBERS Gotcha

2005-12-01T21:45:00.000+11:00

Again, here I hope to save a few fellow tax payers some time and possibly hardware. I have just spent two to three hours on this one and my head is still spinning. I'm joking about the hardware, I have a strict "three strikes and out" policy towards cruelty to IO devices.

I was unit testing some code I was writing for VFP Solution Explorer. The code was doing some type discovery of sorts on some user defined class instances based on the Empty class. In particular, I was using AMEMBERS() to place the properties of the passed object into an array.

I had similar code in a number of places and it was working in all but one. After a lengthy process of elimination, it turned out the only difference was the code that was failing was inside a FOR EACH...NEXT loop.

The following sample code demonstrates this

Local oCollection As Collection, oUser As Object, lnIndex As Integer

* Create an instance of a collection class so we can iterate

* through the collection using For Each..Next and For..Next

oCollection = NewObject("Collection")

* Add a couple user defined objects to the collection

For lnIndex = 1 to 3

* Create an user defined object with a couple of properties

oUser = NewObject("Empty")

AddProperty(oUser, "Property1", "Value1")

AddProperty(oUser, "Property2", "Value2")

* Add to collection

oCollection.Add(oUser)

* Output the number of properties returned by AMembers() when

* passed our user defined object in different ways

Clear

? "* First item of collection" + Chr(9), "Properties found: ", AMembers(laAtttributes, oCollection(1), 0)

* Using a For Each...Next loop

For Each oUser In oCollection

? "* For Each loop" + Chr(9) + Chr(9), "Properties found: ", AMembers(laAtttributes, oUser, 0)

Exit

* Using a For...Next loop

For lnIndex = 1 To oCollection.Count

oUser = oCollection.Item(lnIndex)

? "* For Next loop" + Chr(9) + Chr(9), "Properties found: ", AMembers(laAtttributes, oUser, 0)

Exit

Notice, when inside a FOR EACH..NEXT loop, AMEMBERS() fails to retrieve any property information from the user defined object.

I favour using FOR EACH...NEXT loops over FOR...NEXT loops as I like to work with collections over arrays. But even when using arrays, Fox allows me to keep consistent and use FOR EACH...NEXT loops when iterating through arrays...perhaps not?

Powered By Qumana

BindEvent() and Compile

2005-11-23T23:54:00.000+11:00

Recently I have been working on a Fox IDE tool called FoxTabs. FoxTabs utilises my favourite feature of VFP 9.0, binding to Windows message events. The design approach is to hook into window events within the Fox IDE and manage multiple editing windows via tab controls on a toolbar. We, Craig and I, have just posted a beta version for all to check out. However there is one issue preventing me from getting some well earned sleep. (issue posted by Alan Stevens on the forum)

When running FoxTabs, if an error occurs during compiling your source code, VFP crashes. I admit, its only a minor issue. I mean, who writes code with bugs in it right? :-P

So what's happening? We have event bindings to all WM_CREATE events received by Fox. When a window is created, we interrogate its properties to see if it is an IDE window we want to manage via a toolbar tab. When the compile error occurs, Fox will create a dialog box to display the error. It is when we process the WM_CREATE event of this dialog box we get the fatal crash.

Here is some simplified code to demonstrate this:

* Window messaging constants

#define GWL_WNDPROC (-4)

#define WM_CREATE 0x0001

#define WM_DESTROY 0x0002

#define WM_SETTEXT 0x000C

* Create an instance of the wnHandler class

Public wmHandler As wmHandler

wmHandler = NewObject("wmHandler")

* Bind to all window create notifications

BindEvent(0, WM_CREATE, wmHandler, "wmEventHandler")

Return

* Define Windows messages event handler class

Define Class wmHandler As Custom

PrevWndFunc = 0

IgnoreEvents = .F.

Function wmEventHandler(hWnd As Integer, Msg As Integer, wParam As Integer, lParam As Integer)

Local lnReturn As Integer

Do Case

Case This.IgnoreEvents

? "Ignoring WM events"

Case Msg = WM_CREATE

? Transform(hWnd, "@0x"), "WM_CREATE", Transform(wParam, "@0x"), Transform(lParam, "@0x")

* Bind to the WM_SETTEXT messages received by this window

BindEvent(hWnd, WM_SETTEXT, wmHandler, "wmEventHandler")

Case Msg = WM_SETTEXT

? Transform(hWnd, "@0x"), "WM_SETTEXT", Transform(wParam, "@0x"), Transform(lParam, "@0x")

Case Msg = WM_DESTROY

* Remove all WM event bindings to this window

UnBindEvents(hWnd)

EndCase

* Pass the WM event to the intended Window procedure

lnReturn = CallWindowProc(This.PrevWndFunc, hWnd, Msg, wParam, lParam)

Return lnReturn

EndFunc

Function Init()

* Declare Win32 API functions

Declare Integer CallWindowProc In Win32API Integer lpPrevWndFunc, Integer hWnd, Integer Msg, Integer wParam, Integer lParam

Declare Integer GetWindowLong In Win32API Integer hWnd, Integer nIndex

* Store handle for use in CallWindowProc

This.PrevWndFunc = GetWindowLong(_Vfp.hWnd, GWL_WNDPROC)

EndFunc

Function Destroy()

* Remove all WM event bindings

UnBindEvents(0)

EndFunc

EndDefine

Copy the code into a PRG and run. Open some IDE editing windows and observe the text outputted to the desktop. To reproduce the crash, open a new PRG and enter some junk (anything that will generate a compilation error). Compile the PRG...Bugger!

Now run the test again, only this time before you compile the PRG, go the command window and type

wmHandler.IgnoreEvents = .T.

Compile the PRG and notice the sky does not fall in.

So it would seem that the solution may be to implement some sort of BeforeCompile() event hook and disable my Windows message event processing. But how can I determine whether Fox is in the middle of compiling some code? I have tried the call stack but no luck there.

I have no choice, I am going to have to use the emergency red phone (the Fox phone) and contact Calvin. After all, it was Calvin who coded all this great functionality. If he can not help me, I am truly Wallaby Ted's brother Roo!

Powered By Qumana

COM Servers shutting down

2005-11-20T20:01:00.000+11:00

I've been working with COM servers in Fox for some time now and I am still finding new tips and functions that help me solve issues. I thought I might share one issue and its solution with the hope it may save you a few precious hours, perhaps days.

The issue arose when a business object I was exposing as web service would suddenly shutdown and stop responding to requests. The object was written in 8.0 and compiled as a multi-threaded dll. I then installed the component into a COM+ application and exposed it as a web service.

The business object would query a Fox database, transform the resultant dataset into xml, and pass the xml document string back down the wire to the caller. This solution tested well in development and I deployed to the client's production environment where it ran successfully. Another satisfied client...or so I thought.

A few days went by when the client contacted me and reported the web service had just stopped responding. I was able to confirm this from my location and decided to log onto their server and check the logs. After establishing the remote desktop connection, I found no logs reporting component failure or trouble with the IIS service. So I test again locally, and hey it works. Further tests from my remote location are also successful.

So what we had was a web service that would suddenly stop responding and the act of logging onto the IIS server seem to fix the problem. It took a number of days, and many shutdowns, to identify the cause of the issue. We found that Fox was responding to the log off event of the console account and shutting down.

After much research, I had one of those great Fox moments. I came across an obscure SYS function that completely solved my problem.

SYS(2340 [,0 | 1 ])
This function intercepts Windows logoff messages (WM_QUERYENDSESSION and WM_ENDSESSION) to Visual FoxPro and specifies whether to keep Visual FoxPro COM Server instances running or to shut them down. A Visual FoxPro application will terminate when the current user logs off Windows. If the application is a Windows Service, then that service will terminate. Enabling support for NT service will make it possible for Visual FoxPro applications to continue even if the current user logs off Windows.

I added one line of code to the Init() of my business object

* Enable NT support
SYS(2340, 1)

re-compiled and deployed to the client. Now my Fox component, exposed as a web service via COM+, ignores the Windows log off notifications preventing the service from shutting down.

Powered By Qumana

Class name during Init()

2005-11-03T12:32:00.000+11:00

While working on an enhancement to my label base class control Istumbled across a real gotcha with the way VFP instanicates objects

While working on an enhancement to my label base class control I stumbled across a real gotcha with the way VFP instantiates objects.

Craig had showed me some great code he had implemented on his label base class to allow user defined captions. On the Init() of the label control, a check would be made for a stored user defined caption in a table. If one is found, the caption property is set to the user defined value otherwise the default caption isused. The user was able to change the caption by right clicking on the control.I used the label object’s hierarchy, SYS(1272), as the key on my lookup table.

What I found was, during object instantiation the value returned by SYS(1272) differed to the returned value after the object was instantiated. This can be demonstrated with the following code example:

Local oLabel As Label

Clear

? "*** On Init ***"

_Screen.NewObject("NewInstance", "SubContainer")

? "*** After Init ***"

For Each oLabel In _Screen.NewInstance.Controls

oLabel.Init()

_Screen.NewInstance.Init()

* All done

_Screen.RemoveObject("NewInstance")

Return

Define Class SubContainer As BaseContainer

* Try commenting out this line

Name = "SubContainer"

Add Object lblSubLabel As BaseLabel

EndDefine

Define Class BaseContainer As Container

* Try commenting out this line

Name = "BaseContainer"

Function Init()

? "BaseContainer.Init: " + Sys(1272, This)

EndFunc

Add Object lblBaseLabel As BaseLabel

EndDefine

Define Class BaseLabel As Label

Name = "BaseLabel"

Function Init()

? "BaseLabel.Init: " + Sys(1272, This)

EndFunc

EndDefine

After executing this code, you will notice the object name changes when the object's Init() method executes. Try commenting out the Name properties on each of the class definitions. Notice that the object name remains consistent during instantiation.

So the answer is simple, do not explicitly set object names when defining objects.Well, that’s fine in this example, but this is what VFP actually does within the VCX. Try browsing the VCX table and see for yourself what’s going on under the hood.

Binding to objects in a collection

2005-10-31T22:35:00.000+11:00

When event binding native objects in VFP, one thing I am always conscience of is scope. That is, keeping both my event source and event handler references in scope. If the event source goes out of scope, the event binding is released. If the event handler goes out of scope, the delegate is never called.

So for a long time I avoided event binding to objects I was managing in a collection. I guess it did not click that once I add the object reference to the collection, the object inherits the scope of the collection object. If any event bindings existed on/to the object I was adding to my collection, the bindings would remain intact.

Here is a cute example of this:

Local oThunderBirds As ThunderBirds

* Launch the thunderbirds !

oThunderBirds = NewObject("ThunderBirds")

oThunderBirds.AreGo()

* Uncomment to show event bindings

*!* AEvents(laEvents, oThunderBirds)

*!* Display Memory Like laEvents

Return

* Collection class

Define Class ThunderBirds As Collection

Function Init()

* Add Thunderbirds to collection

This.AddThunderbird("Scott")

This.AddThunderbird("John")

This.AddThunderbird("Virgil")

This.AddThunderbird("Gordon")

This.AddThunderbird("Alan")

EndFunc

Function AddThunderbird(lpcThunderbird As String)

Local oThunderbird As Custom

oThunderbird = NewObject("ThunderBird")

oThunderbird.Son = lpcThunderbird

* Setup event bindings before adding the object to the collection

BindEvent(This, "AreGo", oThunderbird, "OnGoEvent", 1)

This.Add(oThunderbird, lpcThunderbird)

EndFunc

Function AreGo()

Clear

? "Mr Tracy: Thunderbirds are go !"

EndFunc

EndDefine

Define Class ThunderBird As Custom

Son = ""

Function OnGoEvent()

? This.Son + ": FAB dad!"

EndFunc

EndDefine