TMGWBT01 ;TMG/kst/OO Button 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")
 
        ;"---------------------------------------------------------
        ;"register PROCEDURES/FUNCTIONS
        do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWBT01()")
 
        ;"---------------------------------------------------------------------
        ;"Register Properties
 
        do regProp^TMGOOL(TMGthis,"CAPTION","<OK>",)
 
        ;"---------------------------------------------------------
        ;"Register Event Handlers
        do regEvent^TMGOOL(TMGthis,"SHIFT-CLICK","HandleSClick^TMGWBT01(LOC)")
        do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWBT01(LOC)")
 
        ;"--------------------------------------------------------------------------------
        ;"Optional initialization of some instance-specific variables.
 
 
 
        ;"--------------------------------------------------------------------------------
        ;"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
        do procInh^TMGOOL(TMGthis,"TMGWBT01","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"))
        set H=+$get(LOC("HEIGHT")),W=+$get(LOC("WIDTH"))
 
        new selected set selected=($$getProp^TMGOOL(TMGthis,"STATE")="SELECTED")
        new focused set focused=$$fn^TMGOOL(TMGthis,"IS FOCUSED")
        new caption set caption=$$getProp^TMGOOL(TMGthis,"CAPTION")
 
        if selected do
        . do CHGA^TMGXGF("R1")
        . do WIN^TMGXGF(T,L,B,R)
        . do CHGA^TMGXGF("R0")
        . do proc^TMGOOL(TMGthis,"FLUSH MOUSE SAVE")
 
        if caption'="" do
        . new attrib set attrib=""
        . if (selected=1) set attrib="R1"
        . set T=T+(H/2)
        . set L=L+((W-$length(caption))/2)
        . do SAY^TMGXGF(T,L,caption,attrib)
 
        if selected do
        . ;"I want to turn the selected state off immediately, to make button flash
        . do setProp^TMGOOL(TMGthis,"STATE",0)  ;"unselect
        . do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1)  ;"flag as needs repaint
 
        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
 
        ;"for now, click and shift-click will be the same
        do HandleSClick(.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.
 
        new newState set newState="SELECTED"
        if $$getProp^TMGOOL(TMGthis,"STATE")="SELECTED" set newState=0
        do setProp^TMGOOL(TMGthis,"STATE",newState)
        do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1)  ;"flag as needs repaint
 
ADCDone
        quit ;"<-- required: NO return value for event handler
 
 
 
 
 ;"------------------------------------------
 ;"Private functions below
 ;"------------------------------------------