Replace VFP Native dialogs with your own

Article
10/17/2005

I wrote a sample while developing the MENUHIT feature that shows how to replace a native VFP dialog. The code below replaces the Add Property dialog, adding such features as preserving user CaSe for properties and adding to the Favorites tab using the _MEMBERDATA pseudo property.

Run the code below, which creates a sample form, then activates the new Add Property dialog. Type in a new property, such as cNewProperty and close the dialog. Note how the property CaSe is preserved and it’s added to the Favorites tab.

CLOSE DATABASES ALL

ERASE xx.scx

*To remove thishook, change REMOVEHOOK:

#define REMOVEHOOK .f.

ACTIVATE WINDOW properties

USE (_foxcode) AGAIN SHARED ORDER 1 ALIAS foxcode

IF !SEEK("SMENUHIT")

INSERT INTO foxcode (type,abbrev) VALUES ('S',"MENUHIT")

ENDIF

TEXT TO myvar NOSHOW

LPARAMETERS oParm

LOCAL fRetval

?"Menu option chosen: ",oParm.UserTyped,oParm.menuitem

TRY

LOCAL ox

DO CASE

CASE oParm.menuitem="New Method" OR oParm.menuitem="New Property"

ox=CREATEOBJECT("MyNewMethodform",oParm.menuitem,oParm.UserTyped)

ox.show(1)

oParm.valuetype='V'

ENDCASE

fRetval = .f.

CATCH TO oErr

MESSAGEBOX("err caught "+oErr.UserValue+' '+oErr.message+' '+oErr.details+' Line '+TRANSFORM(oErr.lineno))

fRetval= .f.

ENDTRY

RETURN fRetval

DEFINE CLASS MyNewMethodform as Form

left=300

width=320

height=300

autocenter=.t.

allowoutput=.f.

fIsProperty=.t.

fIsClass=.f.

ADD OBJECT lblName as label WITH caption="\<Name",top=10,left=5

ADD OBJECT txtName as textbox WITH top=10,left=50,width=180,SelectOnEntry=.t.

ADD OBJECT cmdAdd as commandbutton WITH caption="\<Add",top=10,left=250,width=70,height=25,default=.t.

ADD OBJECT cmdClose as commandbutton WITH caption="\<Close",top=40,left=250,width=70,height=25,cancel=.t.

ADD OBJECT lblVisibility as label WITH caption="\<Visibility",top=45,left=15

ADD OBJECT cboVisibility as combobox WITH top=40,left=80,width=130,style=2,;

RowSourceType= 1,RowSource="Public,Protected,Hidden",Value="Public",SelectOnEntry=.t.

ADD OBJECT chkAccess as Checkbox WITH caption="Acces\<s Method",top=70,left=20

ADD OBJECT chkAssign as Checkbox WITH caption="Assign \<Method",top=70,left=140

ADD OBJECT chkFavorite as Checkbox WITH caption="\<Favorite",top=100,left=20,value=1

ADD OBJECT lblDefault as label WITH caption="Defaul\<t Value:",top=120,left=20

ADD OBJECT edtDefault as editbox WITH top=140,left=20,height=60,width=280

ADD OBJECT lblDescription as label WITH caption="\<Description:",top=210,left=20

ADD OBJECT edtDescription as editbox WITH top=230,left=20,height=60,width=280

PROCEDURE init(sMenuItem as String,sMenuName as String)

thisform.Caption=sMenuItem

IF sMenuName="Class"

thisform.fIsClass =.t.

ELSE

thisform.cboVisibility.enabled=.f.

ENDIF

IF sMenuItem!="New Property"

thisform.fIsProperty=.f.

thisform.chkAccess.enabled=.f.

thisform.chkAssign.enabled=.f.

thisform.edtDefault.enabled=.f.

ENDIF

PROCEDURE cmdClose.click

thisform.release

PROCEDURE AddXml(oForm as Form,cName as String, cType as string)

LOCAL oxml as msxml2.domdocument.3.0

LOCAL mnode as MICROSOFT.IXMLDOMElement

LOCAL oNewNode as MICROSOFT.IXMLDOMElement

oxml=NEWOBJECT("msxml2.domdocument.3.0")

oxml.async=.f.

IF oxml.loadxml(oForm._memberdata)

mnode=m.oxml.childNodes(1).childNodes(1)

oNewNode=mnode.CloneNode(.f.)

oNewNode.setAttribute("name",LOWER(cName))

oNewNode.setAttribute("type",cType)

oNewNode.setAttribute("display",cName)

oNewNode.setAttribute("favorites",IIF(thisform.chkFavorite.Value !=0,"True","False"))

cc="INPUTBOX('New Value for "+cName+"','"+cName+"')"

oNewNode.setAttribute("script",cc)

mnode.parentNode.AppendChild(m.onewnode)

oForm._memberdata=oxml.xml

ELSE

throw("err ereading xml")

ENDIF

PROCEDURE cmdAdd.click

LOCAL oForm as Form, cName as String,fDoXML as Logical

IF !EMPTY(thisform.txtName.value)

ASELOBJ(aa,1)

oForm=aa[1]

cName=ALLTRIM(thisform.txtName.value)

IF TYPE("oForm.&cname")!= 'U'

MESSAGEBOX(cName+" Already exsists")

ELSE

IF thisform.fIsProperty

oForm.addproperty(cName,thisform.edtDefault.value,thisform.cboVisibility.ListItemId,thisform.edtDescription.value)

ELSE

oForm.WriteMethod(cName,"",.t.,thisform.cboVisibility.ListItemId,thisform.edtDescription.value)

ENDIF

IF thisform.chkFavorite.Value != 0 OR LOWER(cName) != cName

fDoXML = .t.

thisform.AddXML(oForm,cName,IIF(thisform.fIsProperty,"property","method"))

ENDIF

IF thisform.chkAccess.value>0

oForm.WriteMethod(cName+"_Access","*To do: Modify for the Access Method"+CHR(13)+"return this."+cname,.t.)

IF fDoXML

thisform.AddXML(oForm,cName+"_Access","method")

ENDIF

IF thisform.chkAssign.value>0

oForm.WriteMethod(cName+"_Assign","LPARAMETERS vNewVal"+CHR(13)+"*To do: Modify for the Assign Method"+CHR(13)+"this."+cName+" = m.vNewVal",.t.)

IF fDoXML

thisform.AddXML(oForm,cName+"_Assign","method")

ENDIF

thisform.txtName.setfocus()

* thisform.release

ENDDEFINE

ENDTEXT

IF REMOVEHOOK

REPLACE data WITH ""

ELSE

REPLACE data WITH myvar

ENDIF

IF !SEEK("E_GETMEMBERDATA")

INSERT INTO foxcode (type,abbrev) VALUES ('E',"_GETMEMBERDATA")

ENDIF

TEXT TO myvar NOSHOW

LPARAMETER oFoxcode

LOCAL cret

cret=GetMemberDataDoit(oFoxCode)

RETURN cret

PROCEDURE GetMemberDataDoit(oFoxcode)

LOCAL aa[1],n,ox,mytemp

n=ASELOBJ(AA)

ox = aa[1] && currently selected obj

IF VARTYPE(ox)!='O'

n=ASELOBJ(aa,1)

IF n>0

ox=aa[1]

ENDIF

IF VARTYPE(ox) != 'O'

RETURN ""

ENDIF

IF TYPE("ox._memberdata")!='U'

RETURN ""

ENDIF

xxxxTEXT TO mytemp NOSHOW textmerge

<?xml version="1.0" encoding="Windows-1252" standalone="yes" ?>

<memberdata name="xxyyox.name>>" type="property" display="xxyyox.name>>" favorites="True"/>

</VFPData>

xxxxENDTEXT

ox.addproperty("_memberdata",mytemp)

RETURN ""

ENDTEXT

myvar=STRTRAN(myvar,"xxxx","") && allow textmerge of textmerge

myvar=STRTRAN(myvar,"xxyy","<<") && so textmerge doesn't happen til 2nd level

REPLACE data WITH myvar

IF .t.

MODIFY FORM xx nowait

KEYBOARD '{ALT+m}p'

ELSE

CREATE CLASS xx OF xx as form nowait

KEYBOARD '{ALT+c}p'

ENDIF

RETURN

Replace VFP Native dialogs with your own

Additional resources