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 this hook, 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

                        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

                        ENDIF

                   ENDIF

            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

ENDIF

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

      RETURN ""

ENDIF

 

xxxxTEXT TO mytemp NOSHOW textmerge

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

<VFPData>

<memberdata name="foomethod" type="method"     display="fooMethod"     favorites="True"/>

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

<memberdata name="_memberdata" type="property" display="_MemberData" favorites="True"/>

<memberdata name="baseclass" type="property" display="BaseClasS" favorites="True"/>

<memberdata name="error" type="method" display="eRRor" 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