TMGWSBX1 ;TMG/kst/OO Scroll Box ;05/10/07 ;;1.0;TMG-LIB;**1**;05/10/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()") ;"--------------------------------------------------------- ;"Register Event Handlers ;"--------------------------------------------------------------------- ;"Register Properties ;"-------------------------------------------------------------------------------- ;"Optional initialization of some instance-specific variables. new pType set pType=$name(@TMGthis@("OBJS","ScrollBars")) new pScrlH,pScrlV set pScrlH=$$new^TMGOOL(pType,"TMGWSBR1") do setProp^TMGOOL(pScrlH,"ORIENTATION","H") do setProp^TMGOOL(pScrlH,"PARENT",TMGthis) do setProp^TMGOOL(pScrlH,"ALIGN","BOTTOM") do setProp^TMGOOL(pScrlH,"HEIGHT",0) set pScrlV=$$new^TMGOOL(pType,"TMGWSBR1") do setProp^TMGOOL(pScrlV,"ORIENTATION","V") do setProp^TMGOOL(pScrlV,"PARENT",TMGthis) do setProp^TMGOOL(pScrlV,"ALIGN","RIGHT") do setProp^TMGOOL(pScrlV,"WIDTH",0) ;"Register Properties -- must be done after scrollbars created do regProp^TMGOOL(TMGthis,"H-SCROLLER",pScrlH) do regProp^TMGOOL(TMGthis,"V-SCROLLER",pScrlV) ;"-------------------------------------------------------------------------------- ;"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,"TMGWSBX1","PAINT") ;"do Specializations to paint here... new T,L,B,R,H,W,LOC new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC) do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,"SCREEN") set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT")) set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT")) new pScrlH set pScrlH=$$getProp^TMGOOL(TMGthis,"H-SCROLLER") new pScrlV set pScrlV=$$getProp^TMGOOL(TMGthis,"V-SCROLLER") new HValue set HValue=$$getProp^TMGOOL(pScrlH,"VALUE") new VValue set VValue=$$getProp^TMGOOL(pScrlV,"VALUE") do SAY^TMGXGF(T+1,L+2,"H:"_HValue_", V:"_VValue) do SAY^TMGXGF(B-1,R-1,"#") quit 0 ;"------------------------------------------ ;"Event Handler functions below ;"------------------------------------------ ;"------------------------------------------ ;"Private functions below ;"------------------------------------------