SUB main()' demo code for FormAnalyse - needs 3.2 or later REM test UtilFRM2- needs 3.2 or later CLOSE ALL ERASE "homedir$" DIM homedir$ homedir$ = DIRECTORY a%% = 1 WHILE a%% <> 0 p$ = "*.sbv" REQUEST "Select Directory to Collect FormProcs from","",28,a%%,d$ IF a%% = 0 THEN END WHILE DIRECTORY d$ SET ERROR OFF 205 ERASE "plist$" SET ERROR ON 205 GLOBAL plist$(250)' current limit on number of forms in any one directory - increase if necessary (and the loop below) FILLARRAY plist$,5,"*.sbv" FOR i%% = 0 TO 250 IF plist$(i%%) <> "" THEN p$ = plist$(i%%) CALL SBFormAnalyse(p$) ELSE i%% = 32001 END IF NEXT i%% WEND DIRECTORY homedir$ ERASE "plist$" SET STATUS "" END SUB ' Analyse forms or reports for details - Written John Barrs Superbase Developers plc. March 1998 ' Opens the form or report and analyses its controls and formcontrols ' ' Input f$ is the disk name of a form or report (eg "myform.sbv") ' Output in file "zzzzForm" consists of form, formtype(F or R) ' ProcName ' ProcSource (eg TextBox) and ProcType (eg OnUnload) ' ********** the form or report must be openable (ie all it files must be available) ' ********** the form or report (especially report) must have the same Name and FileName ' (but see the bit around ERROR 500 ' (this renames the report and carries on ' ' Uses Functions SaveForm$ and SaveProc$ ----- provided ' ' zzzzform will be created if it doesn't already exist in the running directory which is where the forms are ' program will goto the directory where the form is, operate there ' ' For future use, a few variables are used to keep the particular information ' these internal variables are declared local ' To avoid building up open files, and becasue you can't load one report while another is open ' the proc does CLOSE ALL at the end SUB SBFormAnalyse(f$) SET ERROR OFF 211' catch missing procs not loaded DIM fv AS Form,fc AS FormControl DIM a$,ftype$,z%%,i%%,fname$'local variables DIM otype$,oname$,opage$,ocaption$,ocontrsc$,odetbname$,imname$'formControl properties which are not saved anywhere - you could add them to a file if you wanted fname$ = FN root(f$) IF NOT OPEN ("zzzzform") THEN IF NOT EXISTS ("zzzzform.sbf") THEN CREATE "zzzzform" ADD "FormName;txt ixd;8;" ADD "Formtype;txt;8;" ADD "ProcName;txt ixd;16;" ADD "ProcType;txt ixd; 16; ADD "ProcSource;txt;16;" ADD "FormTProcName;txt clc ixd;26;","FormName.zzzzform + ~.~ + FormType.zzzzform + ~.~ + ProcName.zzzzform" MAKE "zzzzform" END IF OPEN FILE "zzzzform.sbf" END IF SET STATUS "Analysing " + fname$ SET ERROR OFF 52,254' 52 is Missing file (probably an SBF) and 254 is becasue one can't load Form a report sbv CLEAR ERRNO ftype$ = "F" LOAD FORM fname$ IF ERRNO = 52 THEN ' file missing - probably sbf... an old form REQUEST f$ + " Cannot be opened - probably a missing data file","Delete this form",1,a%% IF a%% THEN DELETE f$ CLEAR ERRNO ELSE IF ERRNO = 254 THEN ' probably a report form CLEAR ERRNO SET ERROR ON ALL LOAD REPORT fname$ ftype$ = "R" SET ERROR OFF 500 EXECUTE "SET fv = Superbase." + fname$ IF ERRNO = 500 THEN 'probably filename and name do not match - change it so's they do CLEAR ERRNO SET ERROR ON 500 SET fv = Superbase.Forms(1) fv.Name = fname$ SAVE REPORT fname$ EXECUTE "SET fv = Superbase." + fname$ END IF z%% = fv.Controls.Count ELSE SET fv = Superbase.Form z%% = fv.Count END IF SET STATUS "Analysing " + IF (ftype$ = "R","REPORT ","FORM ") + fname$ REM Form Procs IF ftype$ LIKE "f" THEN a$ = SaveForm$(fname$,ftype$) a$ = SaveProc$(fv.OnClick,fname$,ftype$,"FORM","OnClick") a$ = SaveProc$(fv.OnDblClick,fname$,ftype$,"FORM","OnDblClick") a$ = SaveProc$(fv.OnMiddleClick,fname$,ftype$,"FORM","OnMiddleClick") a$ = SaveProc$(fv.OnMiddleDblClick,fname$,ftype$,"FORM","OnMiddleDblClick") a$ = SaveProc$(fv.OnRightClick,fname$,ftype$,"FORM","OnRightClick") a$ = SaveProc$(fv.OnRightDblClick,fname$,ftype$,"FORM","OnRightDblClick") a$ = SaveProc$(fv.OnKeyDown,fname$,ftype$,"FORM","OnKeyDown") a$ = SaveProc$(fv.OnKeyPress,fname$,ftype$,"FORM","OnKeyPress") a$ = SaveProc$(fv.OnKeyUp,fname$,ftype$,"FORM","OnKeyUp") a$ = SaveProc$(fv.OnLoad,fname$,ftype$,"FORM","OnLoad") a$ = SaveProc$(fv.OnUnLoad,fname$,ftype$,"FORM","OnUnload") ELSE a$ = SaveForm$(fname$,ftype$) END IF REM Moot point here: it is extremely unlikely (although not impossible) REM that any ReportForm controls will have procs - so maybe miss this loop out if only want procs FOR i%% = 1 TO z%% SET fc = fv.Controls(i%%) otype$ = fc.Type oname$ = fc.Name odetnname$ = "":ocontrsc$ = "":ocaption$ = "":imname$ = "" opage$ = STR$ (fc.Page,".")' if you look in props dialog it looks like a string!! IF NOT (fc.type LIKE "Detail*" OR fc.Type LIKE "Line" OR fc.Type LIKE "Rect*" OR fc.Type LIKE "Ellipse" OR fc.type LIKE "Image" OR fc.Type LIKE "Label") THEN IF NOT IS (fc.DetailBlock, NOTHING ) THEN odetbname$ = fc.DetailBlock' could get row etc here or go get detailblock and get info like rows and columns etc END IF END IF IF fc.Type LIKE "Text*" OR fc.Type LIKE "Option*" OR fc.Type LIKE "Check*" OR fc.Type LIKE "Command*" THEN ocontrsc$ = fc.ControlSource IF fc.Type LIKE "Label*" OR fc.Type LIKE "Option*" OR fc.Type LIKE "Check*" OR fc.Type LIKE "Command*" THEN ocaption$ = fc.Caption IF fc.Type LIKE "Image" THEN imname$ = fc.ImageName SELECT CASE fc.Type CASE "CheckBox","CommandButton","OptionButton" a$ = SaveProc$(fc.OnClick,fname$,ftype$,otype$,"OnClick") a$ = SaveProc$(fc.OnMiddleClick,fname$,ftype$,otype$,"OnMiddleClick") a$ = SaveProc$(fc.OnMiddleDblClick,fname$,ftype$,otype$,"OnMiddleDblClick") a$ = SaveProc$(fc.OnRightClick,fname$,ftype$,otype$,"OnRightClick") a$ = SaveProc$(fc.OnRightDblClick,fname$,ftype$,otype$,"OnRightDbleClick") a$ = SaveProc$(fc.OnGotFocus,fname$,ftype$,otype$,"OnGotFocus") a$ = SaveProc$(fc.OnLostFocus,fname$,ftype$,otype$,"OnLostFocus") IF fc.Type LIKE "OptionButton" THEN a$ = SaveProc$(fc.OnDblClick,fname$,ftype$,otype$,"onDblClick") END IF CASE "ComboBox","ListBox","TextBox" a$ = SaveProc$(fc.OnClick,fname$,ftype$,otype$,"OnClick") a$ = SaveProc$(fc.OnGotFocus,fname$,ftype$,otype$,"OnGotFocus") a$ = SaveProc$(fc.OnLostFocus,fname$,ftype$,otype$,"OnLostFocus") a$ = SaveProc$(fc.OnDblClick,fname$,ftype$,otype$,"OnDbleClick") a$ = SaveProc$(fc.OnMiddleClick,fname$,ftype$,otype$,"OnMiddleClick") a$ = SaveProc$(fc.OnMiddleDblClick,fname$,ftype$,otype$,"OnMiddleDbleClick") a$ = SaveProc$(fc.OnRightClick,fname$,ftype$,otype$,"OnRightClick") a$ = SaveProc$(fc.OnRightDblClick,fname$,ftype$,otype$,"OnRightDblClick") IF NOT (fc.Type LIKE "TextBox") THEN a$ = SaveProc$(fc.OnSelChange,fname$,ftype$,otype$,"OnSelChange") END IF IF fc.Type LIKE "ComboBox" OR fc.Type LIKE "TextBox" THEN a$ = SaveProc$(fc.OnKeyDown,fname$,ftype$,otype$,"OnKeyDown") a$ = SaveProc$(fc.OnKeyPress,fname$,ftype$,otype$,"OnKeyPress") a$ = SaveProc$(fc.OnKeyUp,fname$,ftype$,otype$,"OnKeyUp") END IF CASE "Elipse","Image","Label","Line","Rectangle" a$ = SaveProc$(fc.OnClick,fname$,ftype$,otype$,"OnClick") a$ = SaveProc$(fc.OnDblClick,fname$,ftype$,otype$,"OnDbleClick") a$ = SaveProc$(fc.OnMiddleClick,fname$,ftype$,otype$,"OnMiddleClick") a$ = SaveProc$(fc.OnMiddleDblClick,fname$,ftype$,otype$,"OnMiddleDbleClick") a$ = SaveProc$(fc.OnRightClick,fname$,ftype$,otype$,"OnRightClick") a$ = SaveProc$(fc.OnRightDblClick,fname$,ftype$,otype$,"OnRightDbleClick") END CASE NEXT i%% END IF CLOSE ALL SET ERROR ON 52,211 END SUB FUNCTION SaveForm$(fm$,ft$) IF NOT EXISTS (fm$,FormName.zzzzform) THEN BLANK FILE "zzzzForm" FormName.ZZZZFORM = fm$ FormType.ZZZZFORM = ft$ FormTProcName = FormName.zzzzform + "." + FormType.zzzzform + "." + ProcName.zzzzform STORE FILE "ZZZZFORM" END IF END FUNCTION FUNCTION SaveProc$(proc AS object,fm$,ft$,os$,ot$)' note, not only exists but check case by selectkey and check = DIM ok%%,ftp$ ok%% = IF ( LEN ( TRIM$ (proc)) > 0, - 1,0) IF ok%% THEN ftp$ = fm$ + "." + ft$ + "." + proc IF EXISTS (ftp$,FormTProcName.zzzzform) THEN SELECT KEY TRIM$ (ftp$) FILE "zzzzform" INDEX FormTProcname.zzzzform IF TRIM$ (ftp$) = TRIM$ (FormTProcName.zzzzform) THEN ok%% = 0 END IF IF ok%% THEN FILE "zzzzform" BLANK FILE "zzzzform" FormName.zzzzform = fm$ FormType.zzzzform = ft$ ProcName.zzzzform = proc ProcType.zzzzform = ot$ ProcSource.zzzzform = os$ FormTProcName.zzzzform = ftp$ STORE FILE "zzzzform" VIEW END IF END IF SaveProc$ = proc END FUNCTION