source: cprs/branches/tmg-cprs/m_files/TMGWIN01.m@ 1117

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
 ;"------------------------------------------