TMGWTBX1 ;TMG/kst/OO Text Box ;05/29/07 ;;1.0;TMG-LIB;**1**;05/29/07 ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"------------------------------------------ ;"Object oriented window object setup code below ;"------------------------------------------ Constructor(instanceName) ;"Module MUST have 'Constructor' procedure ;"Purpose -- A constructor for object Window ;"Input: instanceName -- the NAME of the type of the object to be defined. ;" This should be a variable (global or otherwise) of the object. ;"Note: This function should NOT be called directly, but instead is called ;" via new^TMGOOL ;"Result: none <--- REQUIRED TO NOT RETURN A RESULT ;"Here we define the default values for vars and functions. ;"----------------All constructors should copy this format -------------------- new TMGthis set TMGthis=instanceName ;"do inheritFrom^TMGOOL(instanceName,"TMGWGOJ") ;"--------------------------------------------------------- ;"register PROCEDURES/FUNCTIONS do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWSBX1()") do regFn^TMGOOL(TMGthis,"CLIP TO DISPLAY","ClipToDisplay^TMGWTBX1(TMGthis)") ;"--------------------------------------------------------- ;"Register Event Handlers ;"--------------------------------------------------------------------- ;"Register Properties ;"-------------------------------------------------------------------------------- ;"Optional initialization of some instance-specific variables. ;"Register Properties -- must be done after scrollbars created ;"-------------------------------------------------------------------------------- ;"Startup code here... quit Destructor(instanceName) ;"Module MUST have 'Destructor' procedure ;"Purpose: A destructor for object Widget ;" any needed clean up code would go here first. ;"Input: instanceName -- the name of the object instance to be deleted. ;" This should be the value returned from defWidget ;"Note: Don't actually delete the object here. Just perform code needed to ;" save the object variables etc. Anything neeed before the object ;" is deleted by delete^TMGOOL ;"----------------- ;" Here I would put code that needs to be called before destruction of the object. ;"----------------- quit ;"------------------------------------------ ;"Object member functions below ;"------------------------------------------ ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance) ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure) Paint() ;"Purpose: To paint the current window (and all children windows) ;"Input: instanceName -- the name/ref of this instance ;"call inherited (this effects paint of children too) do procInh^TMGOOL(TMGthis,"TMGWTBX1","PAINT") ;"do Specializations to paint here... quit 0 ClipToDisplay(TMGthis,extraT,extraL,extraB,extraR) ;"*** This is just a copy of ClipToParent -- must modify for new purpose ;"Purpose: to set the clipping boundries to the parent frame of TMGthis ;"Note: because the parent frame might be partly off screen, this will also ;" clip to the screen to prevent off-screen writing. ;"Input: TMGthis -- the THIS pointer to have the clipping to ;" extraT,extraL,extraB,extraR -- OPTIONAL -- NOT IMPLEMENTED (YET) ;" was to allow shrinking of the clip area by extra amounts. new PT,PL,PB,PR do getPCoords^TMGWGOJ(TMGthis,.PT,.PL,.PB,.PR) ;"get parent coordinates new pScrn set pScrn=$$GetScrn^TMGWGOJ() new ST,SL,SB,SR,SLOC set SLOC=$$getProp^TMGOOL(pScrn,"LOC",.SLOC) ;"get screen coordinates set ST=+$get(SLOC("TOP")) set SL=+$get(SLOC("LEFT")) set SR=SL+$get(SLOC("WIDTH")) set SB=ST+$get(SLOC("HEIGHT")) if PT