TMGWIN01 ;TMG/kst/OO Window Object ;04/18/07 ;;1.0;TMG-LIB;**1**;04/18/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") ;"--------------------------------------------------------- ;"Declare PROCEDURES/FUNCTIONS ;"Note: to use a procedure/function, use this format: ;" do proc^TMGOOL(instanceName,"SET TOP",MyTopVar),! ;" set MyTop=$$fn^TMGOOL(instanceName,"GET TOP") do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWIN01()") ;"--------------------------------------------------------------------- ;"Register Event Handlers do regEvent^TMGOOL(TMGthis,"SHIFT-CLICK","HandleSClick^TMGWIN01(LOC)") do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWIN01(LOC)") ;"-------------------------------------------------------------------------------- ;"Optional initialization of some instance-specific variables. do setProp^TMGOOL(TMGthis,"FRAME","SIZABLE") ;"change default to BE resizable ;"-------------------------------------------------------------------------------- ;"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,"TMGWIN01","PAINT") ;"do Specializations to paint here... new T,L,B,R,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")) do proc^TMGOOL(TMGthis,"CLIP TO PARENT",TMGthis) new selected set selected=($$getProp^TMGOOL(TMGthis,"STATE")="SELECTED") new focused set focused=$$fn^TMGOOL(TMGthis,"IS FOCUSED") if $$getProp^TMGOOL(TMGthis,"RESIZING FLAGS")'="" goto P2 if (selected)!(focused) do CHGA^TMGXGF("I1") new title set title="="_$$getProp^TMGOOL(TMGthis,"TITLE") if title="" goto P2 new w set w=$$getProp^TMGOOL(TMGthis,"WIDTH") for quit:($length(title)>(w-2)) set title=title_"=" if title'="" do SAY^TMGXGF(T,L+1,title,"") do SAY^TMGXGF(T,R-4,"v^X","") if (selected)!(focused) do CHGA^TMGXGF("I0") P2 quit 0 HandleClick(LOC) ;"Purpose: do something here with a mouse click. Note: descendents can ;" overwrite this function to customize their control. ;"Input: LOC -- PASS BY REFERNCE. Expected input format: ;" coordinates in LOCAL frame of refeernces. ;" LOC("TOP")= ;" LOC("LEFT")= ;" LOC("HEIGHT")= ;"optional ;" LOC("WIDTH")= ;"optional ;" LOC("BOTTOM")= ;"optional ;" LOC("RIGHT")= ;"optional ;"Click belongs to this window, so handle it. ;"Put click handler code here do fireInhEvent^TMGOOL(TMGthis,"TMGWIN01","CLICK",.LOC) ;"... ACDone quit ;"<-- required: NO return value for event handler HandleSClick(LOC) ;"Purpose: do something here with a mouse shift click. Note: descendents can ;" overwrite this function to customize their control. ;"Input: LOC -- PASS BY REFERNCE. Expected input format: ;" coordinates in LOCAL frame of refeernces. ;" LOC("TOP")= ;" LOC("LEFT")= ;" LOC("HEIGHT")= ;"optional ;" LOC("WIDTH")= ;"optional ;" LOC("BOTTOM")= ;"optional ;" LOC("RIGHT")= ;"optional ;"Click belongs to this window, so handle it. do fireInhEvent^TMGOOL(TMGthis,"TMGWIN01","SHIFT-CLICK",.LOC) ;"... ADCDone quit ;"<-- required: NO return value for event handler ;"------------------------------------------ ;"Private functions below ;"------------------------------------------