Session E-FUN
Having fun with OOP
Calvin Hsia
Microsoft Corp.
INTRODUCTION
When developing your Visual Foxpro applications, never use the VFP baseclasses directly. Subclass all the baseclassses, and use those subclasses. Eventually, you may want to add some new capability to your applications. For example, you might have an application already deployed, and you just learned how to make all your forms dynamically resizable by the end-user. All you need to do is modify your subclass, and all your applications will inherit the new capability. You can add your Visual Class Library (VCX) with all your subclassed controls into the Project Manager, and when you're designing your forms, you can drag and drop the controls from the project right onto the form.
MAKING RESIZABLE FORMS
Here's your newly discovered way to make dynamically resizable forms:
Add two properties to your Application form subclass: nLastWidth and nLastHeight. Set their values to be =Thisform.Width and =Thisform.Height. When the user resizes the form, the resize event will trigger and can store/retrieve the original size from these properties.
Add another couple properties called nMinWidth and nMinHeight and set these to the desired minimum values.
Add this to your baseclass FORM RESIZE event:
*Appfrm.Resize
THISFORM.LockScreen = .t.
*limit the minimum size the user can choose
IF this.Width < this.nMinWidth
this.width = this.nMinWidth
ENDIF
IF this.Height < this.nMinHeight
this.Height = this.nMinHeight
ENDIF
LOCAL m.i,m.j,m.k,rx,ry,m.temp,oRef
oRef = THISFORM
*Calculate the x and y resize ratios
rx = oRef.Width / oRef.nLastWidth
ry = oRef.Height / oRef.nLastHeight
*only do Resizing of the BASE_CLASS classes
#define BASE_CLASS "Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe"
*Loop through every control on the form
FOR m.i = 1 TO oRef.ControlCount
IF oRef.Controls[m.i].Baseclass$BASE_CLASS
this.DoSize(oRef.Controls[m.i],m.rx,m.ry)
ENDIF
*A pageframe can contain only pages
IF oRef.Controls[m.i].Baseclass$"Pageframe"
*Loop through each page of the pageframe
FOR m.j = 1 TO oRef.Controls[m.i].PageCount
WITH oRef.Controls[m.i].pages[m.j]
*loop through all the controls on the page
FOR m.k = 1 TO .ControlCount
IF .Controls[m.k].Baseclass$BASE_CLASS
this.DoSize(.Controls[m.k],m.rx,m.ry)
ENDIF
ENDFOR
ENDWITH
ENDFOR
ENDIF
ENDFOR
*set the old values to the current values
oRef.nLastHeight = oRef.Height
oRef.nLastWidth = oRef.Width
THISFORM.LockScreen = .f.
Create a custom method called Dosize:
*Appfrm.Dosize
LPARAMETERS oRef,rx,ry
oRef.Height = oRef.Height * m.ry
oRef.Width = oRef.Width * m.rx
oRef.Top = oRef.Top * m.ry
oRef.Left = oRef.Left * m.rx
IF oRef.Baseclass = "Commandbutton"
IF TXTWIDTH(oRef.caption) > oRef.width
oRef.FontSize = 8
ELSE
oRef.FontSize = 10
ENDIF
ENDIF
Note the special code to change the fontsize if the baseclass is a commandbutton.
The code takes advantage of the control array method of referring to container objects. ControlCount is a property of a container, and each individual control can be referenced with Control[n], where n ranges from 1 to ControlCount. For PageFrames, there is a PageCount property, and a page can be referenced with Pages[n]
Now when you create a new form based on this class, all objects on the form will resize proportionately to the form resizing:
SET CLASSLIB TO app && your classlib
OX = CreateObject("myform")
OX.Visible = .t.
READ EVENTS
DEFINE CLASS myform AS appfrm &&the name of the form base class
ADD OBJECT cmdQuit AS CommandButton WITH ;
Caption = "Quit",Cancel = .t.
PROCEDURE cmdQuit.Click
THISFORM.Release
CLEAR EVENTS
ENDDEFINE
ERROR HANDLING
There are two important kinds of object hierarchies to understand in Visual Foxpro. The Inheritance hierarchy is the lineage of a control. Every class along this hierarchy has the same baseclass. A commandbutton is always a commandbutton. An object has a propery called BaseClass and one called ParentClass.
The Containership hierarchy is very similar to a computer file system with subdirectories. An object's full name is indicated by the container hierarchy separated by periods, just as a full path for a filename is indicated by a series of directory names separated with a backslash. For exmample, Myform.Pageframe1.Page2.Command1 indicates the command button on Page2 of PageFrame1 on form Myform.
When an error occurs in your program code for an object, Visual Foxpro will invoke that object's error handler. If there isn't one for that object, VFP will look to see if it has inherited an Error method. If not, the ON ERROR handler is next in line followed by the default VFP error handler. For example, if you have a form with several objects on it, and an error occurs in one of those objects, the inheritance hierarchy is checked for the error handler, and not the containership hierarchy.
Often, you will want the FORM's error event to be invoked when an error occurs anywhere on the form. Add a new property to each baseclass control: lRetry. Add the following code to the ERROR event of all your subclassed VFP base class controls:
*Error method for controls
LPARAMETERS nError, cMethod, nLine
local oTopmost,m.cMessage
m.cMessage = message()
m.oTopmost = this
*Get an object reference for the topmost parent container
do while type('m.oTopmost.Parent') = 'O'
m.oTopmost = m.oTopmost.Parent
enddo
oTopmost.Error(m.nError, m.cMethod, m.nLine, m.cMessage)
Add two properties to your baseclass FORM
lSetErrorOff Defaults to .f. Logical that turns on/off the error handler
nHadError Set this to 0. Numeric that indicates the error
In your baseclass FORM's error method, add the following code:
LPARAMETERS nError, cMethod, nLine,m.cMessage
LOCAL lnTemp
IF thisform.lSetErrorOff
this.nHadError = m.nError
RETURN
ENDIF
IF TYPE("m.cMessage") # 'C'
m.cMessage = Message()
ENDIF
*Here you can trap and handle special errors
IF m.nError = 1585
=TableRevert(.t.)
=MessageBox("Update error: changes reverted")
RETURN
ENDIF
lnTemp=MessageBox("Error "+Padr(m.nError,5) + m.cMessage +;
chr(13) + Message(1) + chr(13) + m.cMethod + ;
" Line #" + STR(m.nLine,5),18)
DO CASE
CASE lnTemp = 4
ACTIVATE WINDOW DEBUG
set step on
retry
CASE lnTemp = 3
Cancel
CASE lnTemp = 5
RETURN
ENDCASE
If you would like to trap a particular kind of error in a button's click event, you can set THISFORM.lSetErrorOff=.t. When the error handler sees this property is true, it just sets nHadError to .f.
THISFORM.lSetErrorOff = .t. && turn off error handling
USE mydata
THISFORM.lSetErrorOff = .f. &&turn error handling back on
IF THISFORM.nHadError > 0
THISFORM.nHadError = 0
wait window "Special error handling"
ENDIF
REMEMBER FORM POSITION AND SIZE
When your user closes and reopens a form, wouldn't it be nice if your app remembered the last form size/position? Add the following two lines to your baseclass form's INIT Method.
this.Pref("restore",thisform,"My Application",THISFORM.Caption)
THISFORM.Resize
In the Moved and Resize method, add the line:
this.Pref("save",thisform,"My Application",THISFORM.caption)
and add a Pref method:
LPARAMETERS cMode,oRef,cID,cName &&mode = save/restore
thisform.lSetErrorOff = .t.
USE SYS(2005) AGAIN IN 0 ALIAS reso
thisform.lSetErrorOff = .f.
IF thisform.nHadError # 0
thisform.nHadError = 0
RETURN
ENDIF
SELECT reso
LOCATE FOR id = PADR(m.cID,LEN(id)) AND name = PADR(m.cName,LEN(name))
IF UPPER(LEFT(cMode,1)) = 'S'
IF oRef.Windowstate = 0 AND !ISREADONLY() &¬ maximized
IF !FOUND()
INSERT INTO reso (type,id,name,readonly,updated) VALUES ;
("PREFW",m.cID,m.cName,.f.,date())
ENDIF
IF !ReadOnly
REPLACE data WITH str(oRef.height,10,3)+str(oRef.width,10,3) + ;
STR(oRef.top,10,3) + str(oRef.left,10,3), ;
ckval WITH VAL(SYS(2007,data))
ENDIF
ENDIF
ELSE
IF FOUND() AND ckval = VAL(SYS(2007,data))
oRef.height = val(substr(data,1,10))
oRef.width = val(substr(data,11,10))
oRef.top = val(substr(data,21,10))
oRef.Left = val(substr(data,31,10))
ENDIF
ENDIF
USE IN reso
ALWAYSONTOP
Another form behavior that your end users might find useful is the AlwaysOnTop pin that you find on the property sheet. With so many forms and limited form real estate, the end user can benefit from being able to set some forms to be AlwaysOnTop.
Create a new form, add a checkbox, and put in the single line of code:
Thisform.AlwaysOnTop = ! Thisform.AlwaysOnTop
Delete the Caption property, change the Style property to Graphical, and change the Picture and DownPicture properties to point to the pushpin BMPs that are in your VFP\samples\graphics directory. Run the form to test it. When you have it working, add it to your VCX by choosing SaveAsClass from the Form Designer. You can drag/drop this class from the Project manager onto any form in the form designer. If you want this to be in your base form class, you can add it to there so that all your forms will inherit this behavior.
TESTABILITY
The new MOUSE command allows you to programatically move the mouse and click. This makes it easy to create automatic testing scripts to test your applications. In the CLICK event of your subclassed VFP controls, add the following code:
#IF .t.
LOCAL m.cName,m.oObj
IF !USED("testlog")
IF !FILE("testlog.dbf")
CREATE TABLE testlog (object c(40),form c(20))
ELSE
USE testlog IN 0 ALIAS testlog
ENDIF
ELSE
SELECT testlog
ENDIF
cName = this.name
oObj = this
DO WHILE TYPE("oObj.Parent") = 'O'
IF TYPE("oObj.Parent.Parent") != 'O'
EXIT
ELSE
m.cName = oObj.Parent.name + '.' + m.cName
oObj = oObj.Parent
ENDIF
ENDDO
INSERT INTO testlog (object,form) VALUES (m.cName,thisform.name)
#ENDIF
Do something simple and visible to demonstrate auto testing
IF this.fontsize = 10
this.fontsize = 8
this.forecolor = 255
ELSE
this.fontsize = 10
this.forecolor = 0
ENDIF
The #IF...#ENDIF surrounds the DEBUG code that enables the logging of events. A simple table is used to keep track of the name of the object that was clicked. The full name is used, such as Pageframe1.Page1.Appcmd2.
Run your application with this code enabled, and the output log will record your test actions. Write another program that invokes your application and runs the test script:
close data
set safety off
if file("testlog.dbf")
use testlog excl
zap
use
endif
First, run the form and record the script
do form t
the last click is the Quit button which does a CLEAR EVENTS and
thisform.release
read events
now run the form and click where the script says to click.
do form t
SELECT testlog
SCAN
DO Clickit WITH "t." + object,form
ENDSCAN
PROC clickit(lObj,cForm)
LOCAL x,y,oRef
oRef = EVAL(lObj)
WITH oRef
y = .Top + .Height /2
x = .Left + .Width / 2
ENDWITH
DO FixPixels WITH Oref, x, y
mouse click at y,x pixels window &cForm
RETURN
PROC FixPixels(oObj,x,y)
*loop through the container hierarchy, adding x,y offsets.
DO WHILE oObj.PARENT.BASECLASS != 'Form'
*Add some pixels if it's a pageframe
IF oObj.parent.baseclass == 'Pageframe' AND oObj.parent.tabs
y=y + 25
ENDIF
IF !oObj.PARENT.BASECLASS == 'Page'
y=y + oObj.PARENT.TOP
x=x + oObj.PARENT.LEFT
ENDIF
oObj=oObj.PARENT
ENDDO
RETURN
These several techniques are easy to add to your subclasses of the VFP baseclass controls, so that all your applications inherit new capability. Thus, don't use the VFP baseclasses directly when developing your applications.