Partager via

Replace VFP Native dialogs with your own

  • Article

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

                        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

Comments