Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to subclass classses

Classes and Objects

How to subclass classses

by  Mike Gagnon  Posted    (Edited  )
This code will subclass all the classes locate in a given directory, for example:( Home()+"wizards" )

Code:
LOCAL lcSourcePath AS STRING , lcTargetPath AS STRING,lnVCXCount AS INTEGER
LOCAL ARRAY laVCX(1)

lcSourcePath = "C:\Program Files\Microsoft Visual FoxPro 7\WIZARDS"
lcTargetPath = "E:\VFP-Projects\A1-FD-Library\WIZARDS"
lcSourcePath = GETDIR(lcSourcePath, "", "Select the Class Librairies Input Directory")
lcTargetPath = GETDIR(lcTargetPath, "", "Select the Class Librairies Output Directory")

lnVCXCount = ADIR(laVCX, ADDBS(lcSourcePath) + "*.VCX")

FOR lnVCXNo = 1 TO  lnVCXCount
    ERASE (ADDBS(lcTargetPath) + JUSTSTEM(laVCX(lnVCXNo,1))+".vcx")
    ERASE (ADDBS(lcTargetPath) + JUSTSTEM(laVCX(lnVCXNo,1))+".vct)
    USE (ADDBS(lcSourcePath) + JUSTSTEM(laVCX(lnVCXNo,1))+".vcx") ALIAS VCX SHARED 
    && Shared required on USE to avoid a "file in use" error.
    SELECT * FROM VCX ;
        WHERE !EMPTY(TimeStamp) AND EMPTY(Parent) AND NOT EMPTY(ObjName) ;
        INTO CURSOR TEMP
    USE IN VCX
    EXTRACTCLASSES(ADDBS(lcSourcePath) +JUSTSTEM(laVCX(lnVCXNo,1))+".vcx", ;
                   ADDBS(lcTargetPath) + JUSTSTEM(laVCX(lnVCXNo,1))+".vcx")
    USE IN TEMP
ENDFOR


********************************************************
PROCEDURE EXTRACTCLASSES
    LPARAMETERS lcSourceClassLib, lcTargetClassLib
    SELECT TEMP
        SCAN  
        CREATE CLASS (ALLTRIM(TEMP.objname)) ;
            OF (lcTargetClassLib) ;
            AS (ALLTRIM(TEMP.objname)) ;
            FROM (lcSourceClassLib) ;
            NOWAIT
        IF WVISIBLE("Properties")
            RELEASE WINDOW ("Properties")
        ENDIF
        INKEY(.1)
        SYS(1500,"_mfi_save","_mfile")
        INKEY(.1)
        SYS(1500,"_mfi_close","_mfile")
        INKEY(.1)
        SET CLASSLIB TO
    ENDSCAN


Original code by Francois Dinel and modified by Mike Gagnon

Mike Gagnon

Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top