************************************************** ** 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"
Email This FAQ To A Friend