Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Cool Trick
Message
De
13/01/2015 09:23:03
 
 
À
Tous
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Titre:
Cool Trick
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Windows Server 2012
Network:
Windows 2008 Server
Database:
MS SQL Server
Application:
Web
Divers
Thread ID:
01613511
Message ID:
01613511
Vues:
122
J'aime (1)
Here is a cool trick I developed when writing my SysObj tool. This allow the instantiation of an object Only when it is needed, and not at startup.
*------------------------------------------------------------
*  Description.......: Generate object on demand.
*					 : objects are not instantiated until first accessed.
*  File..............: ObjAccess
*  Author............: Gregory L. Reichert
*------------------------------------------------------------
* Example:
* o = objaccess()
* ? o.storage.drive.cdDrive('open')
* ? o.storage.drive.cdDrive('close')
*------------------------------------------------------------
LOCAL toSystem AS vfpSystem
toSystem = CREATEOBJECT("VFPsystem")
RETURN toSystem

*******************************************

DEFINE CLASS VFPbase AS CUSTOM

    *------------------------------------------------------------
    * Description: returns the object referense for the parent method.
    * Parameters:  <para>, <req/opt>, D=<def>, <desc>
    * Return:
    * Use:
    *------------------------------------------------------------
    * Id Date		By		Description
    *  1 03/15/2010	GLR		Initial Creation
    *
    *------------------------------------------------------------
    PROCEDURE retObject()
        LOCAL laStack[1,6]
        LOCAL N AS INTEGER
        LOCAL c, o
        *-- get object name from property name
        N =ASTACKINFO(laStack)
        IF N>1 THEN
            c=STRTRAN(laStack(N-1,3),"_access","")
            c=SUBSTR(c,RAT(".",c)+1)
            IF ISNULL(EVALUATE("this."+c)) THEN
            	*-- create new
                o=CREATEOBJECT("vfp"+c)
                STORE o TO ("this."+c)
                RETURN o
            ELSE
            	*-- return existing
                RETURN EVALUATE("this."+c)
            ENDIF
        ENDIF
        RETURN .NULL.
    ENDPROC

ENDDEFINE

* GLR 01/13/2015 08:10:24 -------------------------
* sample classes for example
*--------------------------------------------------

*------------------------------------------------------------
* Description: Encapsulate the SYS() functions into a class with named mathods fro each function.
* Uses:			<Result> = System.<method>([<para>])
*------------------------------------------------------------
* Id Date        By         Description
*  1 02/24/2005  gregory.re Initial Creation
*
*------------------------------------------------------------

DEFINE CLASS vfpSystem AS VFPbase
    *-- Object - late-bonded
    Storage 		= .NULL.
    DISPLAY			= .NULL.
    KEYBOARD		= .NULL.
    MOUSE			= .NULL.

    PROCEDURE Storage_Access
        RETURN THIS.retObject()
    PROCEDURE Display_Access
        RETURN THIS.retObject()
    PROCEDURE Keyboard_Access
        RETURN THIS.retObject()
    PROCEDURE Mouse_Access
        RETURN THIS.retObject()

ENDDEFINE

**************************************************************************

DEFINE CLASS vfpStorage AS VFPbase

    DRIVE		= .NULL.
    Folder		= .NULL.
    FILE		= .NULL.
    PATH		= .NULL.

    PROCEDURE Drive_access
        RETURN THIS.retObject()
    PROCEDURE Folder_access
        RETURN THIS.retObject()
    PROCEDURE File_access
        RETURN THIS.retObject()
    PROCEDURE Path_access
        RETURN THIS.retObject()

ENDDEFINE

*============================================

DEFINE CLASS vfpDRIVE AS VFPbase

    PROCEDURE cdDrive( tcAction AS STRING )
        DECLARE LONG mciSendString IN winmm AS mciSendStringA STRING lpstrCommand, LONG lpstrReturnStr, LONG wReturnLenLong, LONG hCallBack
        LOCAL intReturn, nfilehandle
        DO CASE
        CASE LOWER(tcAction)="open"
            =mciSendStringA( "Set CDAudio Door Open Wait", 0, 0, 0)
        CASE LOWER(tcAction)="close"
            =mciSendStringA( "Set CDAudio Door Closed Wait", 0, 0, 0)
        ENDCASE
        CLEAR DLLS mciSendStringA
        RETURN .T.
    ENDPROC

ENDDEFINE
* Eof OBJACCESS.PRG
The full code to SysObj can be found at http://www.glrsoftware.com/download/download.asp?file=SysObj.zip, with well over 100s of methods to access both Windows and VFP functions.

Have fun.
Greg Reichert
Répondre
Fil
Voir

Click here to load this message in the networking platform