A form to compare two different versions of a form.

**************************************************
** Program : frmMatch.Prg
** Utility to compare two versions of a forms.
**************************************************
** Author : Ramani (Subramanian.G)
** FoxAcc Software / Winners Software
** www.winnersoft.coolfreepages.com
** Type : Freeware with reservation to Copyrights
** Warranty : Nothing implied or explicit
**************************************************
** How to Run : Copy the following code gsTool1
** from command window DO gsTool1
**************************************************
** PROCEDURE gsTool1
**
PUBLIC oform1

IF gsEdit()
oform1=NEWOBJECT("form1")
IF VARTYPE(oForm1) = "O"
oform1.Show
ENDIF
RELEASE cForm1, cForm2
ENDIF
RETURN
**************************************************
** End
**************************************************
PROCEDURE gsEdit

PRIVATE gsANSI, gsSafety, gsExact, gsoForm, gsPEM, gsPEM1, gsPEM2
PUBLIC cForm1, cForm2
**************************************************
** Close all tables and display a help message
gsANSI = SET("ANSI")
gsSAFETY = SET("SAFETY")
gsEXACT = SET("EXACT")

SET ANSI ON
SET SAFETY OFF
SET EXACT ON

CLOSE TABLES ALL
**************************************************
** Get the first form
cForm1 = getForm("Select the first form")
IF EMPTY(cForm1)
=MESSAGEBOX("No Form Selected")
RETURN .f.
ENDIF

** Get the second form
cForm2 = getForm("Select the second form")
DO WHILE cForm1 = cForm2
=MESSAGEBOX("The first and second form chosen are the same",0)
cForm2 = getForm("Select the second form")
IF EMPTY(cForm2)
EXIT
ENDIF
ENDDO
IF EMPTY(cForm2)
=MESSAGEBOX("No Form Selected for comparison")
RETURN .f.
ENDIF
**************************************************
** Collect form1 PEMS
MODIFY FORM (cForm1) NOWAIT
IF ASELOBJ(laForm,1) < 1
=MESSAGEBOX("Cannot open Form One Selected")
RETURN .f.
ENDIF
gsoForm = laForm(1)
DO gsEdit1 WITH gsoForm
SELECT * FROM gsPEM INTO DBF gsPEM1 ORDER BY 1
CLOSE ALL
**
** Collect form2 PEMS
MODIFY FORM (cForm2) NOWAIT
IF ASELOBJ(laForm,1) < 1
=MESSAGEBOX("Cannot open Form One Selected")
RETURN .f.
ENDIF
gsoForm = laForm(1)
DO gsEdit1 WITH gsoForm
SELECT * FROM gsPEM INTO DBF gsPEM2 ORDER BY 1
CLOSE ALL
**
SELECT NVL(a.obj_ref,b.obj_ref) AS obj_ref, ;
NVL(a.obj_pem,b.obj_pem) AS obj_pem, ;
NVL(a.obj_val,"") AS obj_val, ;
NVL(b.obj_val,"") AS obj_val2 ;
FROM gsPEM1 a FULL OUTER JOIN gsPEM2 b ;
ON a.obj_ref+a.obj_pem == b.obj_ref+b.obj_pem ;
ORDER BY 1,2 INTO CURSOR gsPem READWRITE
USE IN SELECT("gsPEM1")
USE IN SELECT("gsPEM2")
REPLACE ALL obj_ref WITH obj_ref-"."-obj_pem
LOCATE
**
SET ANSI &gsANSI
SET SAFETY &gsSAFETY
SET EXACT &gsEXACT
RELEASE ALL LIKE gs*
ERASE gsPem1.*
ERASE gsPem2.*
RETURN .t.
**************************************************
PROCEDURE gsEdit1
LPARAMETERS gsoForm

** Cursor to hold all the PEMs of objects
CREATE CURSOR gsPEM (obj_ref C(125), ;
obj_pem C(25), obj_type C(1), obj_val M)
SCATTER MEMVAR BLANK

** get the objects PEM in a table
gsoNowObject = gsoForm
gscNowObjectParent = ""
DO getPEMs2

** Create an array to hold the objects temporarily
DIMENSION gsaObject(32500,2)
gsaObject(1,1) = gsoForm
gsaObject(1,2) = gsoForm.Name

** get the sub objects PEM in the same table as above
gsnObject = 1
gsnNextObject = 2
DO WHILE .t.
LOCAL oPage, oColumn, oButton
FOR EACH m.oThis IN gsaObject(gsnObject,1).Controls
gscNowObjectParent = gsaObject(gsnObject,2)+"."
gsoNowObject = m.oThis
DO getPEMs1
DO CASE
CASE m.oThis.BaseClass == 'Pageframe'
LOCAL oPage
gscNowObjectParent = ;
gsaObject(gsnObject,2)+"."+oThis.Name+"."
FOR EACH oPage IN m.oThis.Pages
gsoNowObject = m.oPage
DO getPEMs1
ENDFOR
CASE m.oThis.BaseClass == 'Grid'
LOCAL oColumn
gscNowObjectParent = ;
gsaObject(gsnObject,2)+"."+oThis.Name+"."
FOR EACH oColumn IN m.oThis.Columns
gsoNowObject = m.oColumn
DO getPEMs1
ENDFOR
CASE m.oThis.BaseClass $ ;
'Commandgroup,Optiongroup'
LOCAL oButton
gscNowObjectParent = ;
gsaObject(gsnObject,2)+"."+oThis.Name+"."
FOR EACH oButton IN m.oThis.Buttons
gsoNowObject = m.oButton
DO getPEMs1
ENDFOR
ENDCASE
ENDFOR
gsnObject = gsnObject+1
IF gsnObject = gsnNextObject
EXIT
ENDIF
ENDDO
*
RETURN
**************************************************
PROCEDURE getPEMs1
** obtain contained objects for further probe
DO getPEMs2
LOCAL gscBclass
gscBclass = UPPER(gsoNowObject.BaseClass)
IF gscBclass == "COLUMN" oR gscBclass == "CONTAINER" ;
OR gscBclass == "FORM" OR gscBclass == "PAGE" ;
OR gscBclass == "TOOLBAR" ;
OR gscBclass == "CONTROL"
gsaObject(gsnNextObject,1) = gsoNowObject
gsaObject(gsnNextObject,2) = ;
gscNowObjectParent+gsoNowObject.Name
gsnNextObject = gsnNextObject+1
ENDIF
RETURN
**************************************************
PROCEDURE getPEMs2
** Get the objects members
=AMEMBERS(gsoArray,gsoNowObject,1,"C")

** Read the members and get them into a table
FOR gsnCount = 1 TO ALEN(gsoArray,1)
m.obj_ref = gscNowObjectParent+gsoNowObject.Name
m.obj_pem = gsoArray(gsnCount,1)
m.obj_type = LEFT(UPPER(gsoArray(gsnCount,2)),1)
** get the event/method code or propety value
DO CASE
CASE m.obj_type $ "EM"
m.obj_val = ;
GETPEM(gsoNowObject,gsoArray(gsnCount,1))
CASE m.obj_type = "P"
gsCode = ;
GETPEM(gsoNowObject,gsoArray(gsnCount,1))
IF TYPE("gsCode") = "C"
m.obj_val = ;
GETPEM(gsoNowObject,gsoArray(gsnCount,1))
ENDIF
IF TYPE("gsCode") $ "NY"
m.obj_val = ALLTRIM(STR(GETPEM( ;
gsoNowObject,gsoArray(gsnCount,1))))
ENDIF
IF TYPE("gsCode") $ "D"
m.obj_val = DTOC(GETPEM(gsoNowObject, ;
gsoArray(gsnCount,1)))
ENDIF
IF TYPE("gsCode") $ "T"
m.obj_val = TTOC(GETPEM(gsoNowObject, ;
gsoArray(gsnCount,1)))
ENDIF
IF TYPE("gsCode") $ "L"
IF gsCode = .t.
m.obj_val = ".t."
ELSE
m.obj_val = ".f."
ENDIF
ENDIF
ENDCASE
IF !EMPTY(m.obj_val)
INSERT INTO gsPEM FROM MEMVAR
ENDIF
ENDFOR
RETURN
**************************************************
PROCEDURE getform
LPARAMETERS tText
IF PCOUNT() < 1
tText = "Select a Form"
ENDIF
RETURN GETFILE("SCX",tText)
**************************************************
** EOF
**************************************************
DEFINE CLASS form1 AS form

Top = 0
Left = 0
Height = 435
Width = 552
DoCreate = .T.
Caption = "Form1"
Name = "form1"

ADD OBJECT cmdExit AS commandbutton WITH ;
Top = 12, ;
Left = 12, ;
Height = 27, ;
Width = 48, ;
Caption = "Exit", ;
Name = "cmdExit"

ADD OBJECT cmdFilter AS commandbutton WITH ;
Top = 12, ;
Left = 72, ;
Height = 27, ;
Width = 84, ;
Caption = "Filter", ;
Name = "cmdFilter"

ADD OBJECT grid1 AS grid WITH ;
Height = 192, ;
Left = 12, ;
Top = 48, ;
Width = 528, ;
Name = "Grid1"

ADD OBJECT label1 AS label WITH ;
Caption = m.cForm1, ;
Height = 18, ;
Left = 12, ;
Top = 246, ;
Width = 528, ;
Name = "Label1"

ADD OBJECT edtValue1 AS editbox WITH ;
Height = 72, ;
Left = 12, ;
Top = 264, ;
Width = 528, ;
ControlSource = "obj_val", ;
Name = "edtValue1"

ADD OBJECT label2 AS label WITH ;
Caption = m.cForm2, ;
Height = 18, ;
Left = 12, ;
Top = 342, ;
Width = 528, ;
Name = "Label2"

ADD OBJECT edtValue2 AS editbox WITH ;
Height = 72, ;
Left = 12, ;
Top = 360, ;
Width = 528, ;
ControlSource = "obj_val2", ;
Name = "edtValue2"

PROCEDURE Refresh
WITH ThisForm
IF obj_val == obj_val2
.edtValue1.BackColor = RGB(255,255,255)
.edtValue2.BackColor = RGB(255,255,255)
ELSE
.edtValue1.BackColor = RGB(255,192,128)
.edtValue2.BackColor = RGB(255,192,128)
ENDIF
ENDWITH
ENDPROC

PROCEDURE cmdFilter.Click
IF This.Caption = "Filter"
This.Caption = "Show All"
SET FILTER TO obj_val # obj_val2
LOCATE
ELSE
This.Caption = "Filter"
SET FILTER TO
LOCATE
ENDIF
ThisForm.Refresh()
ENDPROC

PROCEDURE cmdExit.Click
ThisForm.Release()
ENDPROC

PROCEDURE grid1.AfterRowColChange
LPARAMETERS nColIndex
ThisForm.Refresh()
ENDPROC

PROCEDURE grid1.Init
WITH This
.RecordSource = "gsPem"
.ColumnCount = 1
.DeleteMark = .f.
.ReadOnly = .t.
.SetAll("DynamicBackColor", ;
"IIF(obj_val==obj_val2,RGB(255,255,255), ;
RGB(255,192,124))","COLUMN")
ENDWITH
ENDPROC

ENDDEFINE
*-- EndDefine: form1
**************************************************
** EOF
**************************************************
** Ramani (Subramanian.G)
** www.winnersoft.coolfreepages.com
**************************************************