source: cprs/branches/tmg-cprs/m_files/TMGWTBX1.m@ 1620

Last change on this file since 1620 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 4.6 KB
Line 
1TMGWTBX1 ;TMG/kst/OO Text Box ;05/29/07
2 ;;1.0;TMG-LIB;**1**;05/29/07
3
4 ;"Kevin Toppenberg MD
5 ;"GNU General Public License (GPL) applies
6 ;"------------------------------------------
7 ;"Object oriented window object setup code below
8 ;"------------------------------------------
9
10Constructor(instanceName) ;"Module MUST have 'Constructor' procedure
11 ;"Purpose -- A constructor for object Window
12 ;"Input: instanceName -- the NAME of the type of the object to be defined.
13 ;" This should be a variable (global or otherwise) of the object.
14 ;"Note: This function should NOT be called directly, but instead is called
15 ;" via new^TMGOOL
16 ;"Result: none <--- REQUIRED TO NOT RETURN A RESULT
17
18 ;"Here we define the default values for vars and functions.
19
20 ;"----------------All constructors should copy this format --------------------
21 new TMGthis set TMGthis=instanceName
22
23 ;"do inheritFrom^TMGOOL(instanceName,"TMGWGOJ")
24
25 ;"---------------------------------------------------------
26 ;"register PROCEDURES/FUNCTIONS
27 do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWSBX1()")
28 do regFn^TMGOOL(TMGthis,"CLIP TO DISPLAY","ClipToDisplay^TMGWTBX1(TMGthis)")
29
30 ;"---------------------------------------------------------
31 ;"Register Event Handlers
32
33 ;"---------------------------------------------------------------------
34 ;"Register Properties
35
36 ;"--------------------------------------------------------------------------------
37 ;"Optional initialization of some instance-specific variables.
38
39 ;"Register Properties -- must be done after scrollbars created
40
41 ;"--------------------------------------------------------------------------------
42 ;"Startup code here...
43
44 quit
45
46
47Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
48 ;"Purpose: A destructor for object Widget
49 ;" any needed clean up code would go here first.
50 ;"Input: instanceName -- the name of the object instance to be deleted.
51 ;" This should be the value returned from defWidget
52 ;"Note: Don't actually delete the object here. Just perform code needed to
53 ;" save the object variables etc. Anything neeed before the object
54 ;" is deleted by delete^TMGOOL
55
56 ;"-----------------
57
58 ;" Here I would put code that needs to be called before destruction of the object.
59
60 ;"-----------------
61
62 quit
63
64
65 ;"------------------------------------------
66 ;"Object member functions below
67 ;"------------------------------------------
68
69 ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
70 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
71
72Paint()
73 ;"Purpose: To paint the current window (and all children windows)
74 ;"Input: instanceName -- the name/ref of this instance
75
76 ;"call inherited (this effects paint of children too)
77 do procInh^TMGOOL(TMGthis,"TMGWTBX1","PAINT")
78
79 ;"do Specializations to paint here...
80
81
82
83
84 quit 0
85
86
87ClipToDisplay(TMGthis,extraT,extraL,extraB,extraR)
88 ;"*** This is just a copy of ClipToParent -- must modify for new purpose
89
90 ;"Purpose: to set the clipping boundries to the parent frame of TMGthis
91 ;"Note: because the parent frame might be partly off screen, this will also
92 ;" clip to the screen to prevent off-screen writing.
93 ;"Input: TMGthis -- the THIS pointer to have the clipping to
94 ;" extraT,extraL,extraB,extraR -- OPTIONAL -- NOT IMPLEMENTED (YET)
95 ;" was to allow shrinking of the clip area by extra amounts.
96 new PT,PL,PB,PR
97 do getPCoords^TMGWGOJ(TMGthis,.PT,.PL,.PB,.PR) ;"get parent coordinates
98 new pScrn set pScrn=$$GetScrn^TMGWGOJ()
99 new ST,SL,SB,SR,SLOC
100 set SLOC=$$getProp^TMGOOL(pScrn,"LOC",.SLOC) ;"get screen coordinates
101 set ST=+$get(SLOC("TOP"))
102 set SL=+$get(SLOC("LEFT"))
103 set SR=SL+$get(SLOC("WIDTH"))
104 set SB=ST+$get(SLOC("HEIGHT"))
105 if PT<ST set PT=ST
106 if PB'<SB set PB=SB
107 if PL<SL set PL=SL
108 if PR'<SR set PR=SR
109 do SETCLIP^TMGXGF(PT,PL,PB,PR) ;"clip to parent's window
110 quit 0
111
112
113
114 ;"------------------------------------------
115 ;"Event Handler functions below
116 ;"------------------------------------------
117
118
119
120
121 ;"------------------------------------------
122 ;"Private functions below
123 ;"------------------------------------------
124
125
126
Note: See TracBrowser for help on using the repository browser.