/***********************************************************************/ /* This program is meant to run as an object. */ /* It is a simple program to demonstrate: */ /* -- "Private" attributes available to it */ /* -- "Public" methods available to other programs. */ /* -- A good template for future objects with Constructor and */ /* Destructor routines. */ /***********************************************************************/ FUNCTION cGetAttr RETURNS CHARACTER (INPUT cAttrName AS CHARACTER) FORWARD. /* ----------------------- Begin Attributes List ----------------------*/ /* Example attribute specific to the object */ /* Used for object management */ DEFINE VARIABLE cgObjName as character NO-UNDO. /* ------------------------- End Attributes List ----------------------*/ /* -------------------------- Begin Methods List ----------------------*/ /***********************************************************************/ /* This is the "destructor" for the routine. It should be called be */ /* fore deleting the handle to the instance of this object. */ /***********************************************************************/ PROCEDURE Destroy: END. /***********************************************************************/ /* If other "constructors" are needed, they can be put in. This one */ /* is called Init. Unlike C++, it will need to be run manually. */ /* If you are using ObjMgr.i, it will be run automatically. */ /* If you need to make other Inits, place them here and name beginning */ /* "Init" : InitByRowID or InitBySalesOrderNumber. */ /***********************************************************************/ PROCEDURE Init: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. ASSIGN cgObjName = cName. RUN SetError IN THIS-PROCEDURE ("000", "Init"). END. /***********************************************************************/ /* All procedures need a way to describe their errors back to the cal- */ /* ler. */ /***********************************************************************/ PROCEDURE GetError: DEFINE OUTPUT PARAMETER cErrCode AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cErrMsg AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cErrMethod AS CHARACTER NO-UNDO. ASSIGN cErrCode = cGetAttr("ErrCode") cErrMsg = cGetAttr("ErrMsg") cErrMethod = cGetAttr("ErrMethod"). END. /* PROCEDURE GetError */ /***********************************************************************/ /* This is the central point where internal procedures can communicate */ /* their problems to the procedure as a whole. */ /* It's main purpose is to convert codes into human readable form in */ /* cgObjErrMsg as well as populate the procedures globally available */ /* vars. */ /***********************************************************************/ PROCEDURE SetError: DEFINE INPUT PARAMETER cErrorCode AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cMethodName AS CHARACTER NO-UNDO. CASE cErrorCode: WHEN "000" THEN DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", "No Error"). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. OTHERWISE DO: RUN SetAttr IN THIS-PROCEDURE ("ErrCode", cErrorCode). RUN SetAttr IN THIS-PROCEDURE ("ErrMsg", ?). RUN SetAttr IN THIS-PROCEDURE ("ErrMethod", cMethodName). END. END. /* CASE */ END. /* PROCEDURE SetError */ /***********************************************************************/ /* These are methods to perform activities on the data controlled by */ /* the object. */ /* Attributes are actually stored in a temp-table, that way we can add */ /* new ones easily, and not need to create more Set/Get routines for */ /* for each attribute. The bad news is, we need to cast to and from */ /* character for the data to pass back and fourth. If this is a pron- */ /* lem, then create some Set/Get routines for those values. */ /***********************************************************************/ DEFINE TEMP-TABLE ttAttributes FIELD AttrName AS CHARACTER FIELD AttrValue AS CHARACTER INDEX key1 AttrName ASCENDING. /***********************************************************************/ /* We don't make this a function, because we need to FORWARD declare */ /* in the code using this object, and this name is going to be pret- */ /* ty popular causing conflict with other objects with a GetAttr. */ /***********************************************************************/ PROCEDURE GetAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER cValue AS CHARACTER NO-UNDO. FIND ttAttributes NO-LOCK WHERE ttAttributes.AttrName = cName NO-ERROR. IF NOT AVAILABLE ttAttributes THEN DO: /*********************************************************/ /* Note that sometimes it is OK for an attribute to be ? */ /* so be sure to remember to check the error if the at- */ /* tribute wasn't found or really is ?. Sometimes it */ /* it works out it does not matter, sometimes it does */ /* matter. */ /*********************************************************/ RUN SetError IN THIS-PROCEDURE ("001", "GetAttr"). ASSIGN cValue = ?. RETURN. END. /* IF NOT AVAILABLE ttAttributes */ ASSIGN cValue = ttAttributes.AttrValue. END. /* PROCEDURE GetAttr */ /***********************************************************************/ /* However it IS useful to have a GetAttr function for use in THIS- */ /* PROCEDURE within the internal procedures available. */ /***********************************************************************/ FUNCTION cGetAttr RETURNS CHARACTER (INPUT cAttrName AS CHARACTER): DEFINE VARIABLE cAttrValue AS CHARACTER NO-UNDO. RUN GetAttr IN THIS-PROCEDURE (INPUT cAttrName, OUTPUT cAttrValue). RETURN cAttrValue. END. /* FUNCTION cGetAttr() */ /***********************************************************************/ /* If the attribute already exists, we overwrite, not error out... */ /***********************************************************************/ PROCEDURE SetAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cValue AS CHARACTER NO-UNDO. FIND ttAttributes NO-LOCK WHERE ttAttributes.AttrName = cName NO-ERROR. IF NOT AVAILABLE ttAttributes THEN CREATE ttAttributes. ASSIGN ttAttributes.AttrName = cName ttAttributes.AttrValue = cValue. /* Some attributes are dependent on other attributes, handle those */ /* here. */ RUN DependentAttr (cName, cValue). END. /* PROCEDURE SetAttr */ /***********************************************************************/ /* Some attributes are dependent on the values of other attributes. */ /* We keep them in sync with this code here. */ /***********************************************************************/ PROCEDURE DependentAttr: DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cValue AS CHARACTER NO-UNDO. END. /* PROCEDURE DependentAttr */ /***********************************************************************/ /* This is a way to quickly transfer record information into attri- */ /* butes. The attribute name is tablename_fieldname. */ /* Example Use: */ /* FIND FIRST Person NO-LOCK. */ /* ASSIGN hBuffer = BUFFER Person:Handle. */ /* RUN Record2Attr (hBuffer). */ /***********************************************************************/ PROCEDURE Record2Attr: DEFINE INPUT PARAMETER hBuffer AS HANDLE NO-UNDO. DEFINE VARIABLE hField AS HANDLE NO-UNDO. DEFINE VARIABLE i AS INTEGER NO-UNDO. DO i = 1 TO hBuffer:Num-Fields: ASSIGN hField = hBuffer:Buffer-Field(i). RUN SetAttr IN THIS-PROCEDURE (hBuffer:Name + "_" + hField:Name, hField:String-Value). END. END. /***********************************************************************/ /* Scan the attributes table for entries beginning with the table name */ /* and apply their values to the field named in the second part of the */ /* attribute name. */ /* Note this doesn't manage multiple buffers of the same name very */ /* well. If you need n records from the same table, name the buffers */ /* seperately. */ /***********************************************************************/ PROCEDURE Attr2Record: DEFINE INPUT PARAMETER hBuffer AS HANDLE NO-UNDO. DEFINE VARIABLE hField AS HANDLE NO-UNDO. DEFINE VARIABLE cFieldName AS CHARACTER NO-UNDO. FOR EACH ttAttributes NO-LOCK WHERE ttAttributes.Name BEGINS hBuffer:Name + "_": /*****************************************************************/ /* Luckily, it appears that buffer-value types automatically... */ /* It will puke on bad data sent - such as text for an int, etc. */ /*****************************************************************/ ASSIGN hfield = hBuffer:Buffer-Field(ENTRY(2, ttAttributes.Name, "_")) hfield:Buffer-Value = ttAttributes.Value. END. /* FOR EACH ttAttributes */ END. /* PROCEDURE Attr2Record */ /***********************************************************************/ /* Useful for debugging. Note we output to a file so we don't get any */ /* wrong display device type errors when the r-code is shared between */ /* different interfaces. */ /***********************************************************************/ PROCEDURE AttrDebug: DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO. OUTPUT TO VALUE(cFileName). FOR EACH ttAttributes NO-LOCK: PUT UNFORMATTED ttAttributes.AttrName "=" ttAttributes.AttrValue SKIP. END. /* FOR EACH ttAttributes */ OUTPUT CLOSE. END. /* PROCEDURE AttrDebug */ /***********************************************************************/ /* Clear out all attributes that have been set. It is better to set */ /* an attribute to ? and code for that; but sometimes one needs this. */ /***********************************************************************/ PROCEDURE ClearAttr: FOR EACH ttAttributes: DELETE ttAttributes. END. /* FOR EACH ttAttributes */ END. /* PROCEDURE ClearAttr */ /***********************************************************************/ /* This is a special set of routines that allow the object's user to */ /* reach the tables directly. Convenient for ASSIGNS and the like so */ /* one is not continously calling a Set* routine for each and every */ /* field. */ /* WARNING: This CAN BE ABUSED. */ /* WARNING: Sets of Like records may be a problem. */ /* ATTN: Buffers can go both ways. This can be good. This can be */ /* bad. */ /***********************************************************************/ PROCEDURE GetBuffers: DEFINE PARAMETER BUFFER YourRecord FOR YourTable. BUFFER-COPY ObjBuffer YourRecord. END. /* PROCEDURE GetBuffers */ PROCEDURE SetBuffers: DEFINE PARAMETER BUFFER YourRecord FOR YourTable. BUFFER-COPY YourRecord ObjBuffer. END. /* -------------------------- End Methods List ------------------------*/