source: cprs/branches/tmg-cprs/m_files/TMGWBT01.m@ 1548

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

Initial upload

File size: 6.2 KB
Line 
1TMGWBT01 ;TMG/kst/OO Button Object ;04/18/07
2 ;;1.0;TMG-LIB;**1**;04/18/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^TMGWBT01()")
28
29 ;"---------------------------------------------------------------------
30 ;"Register Properties
31
32 do regProp^TMGOOL(TMGthis,"CAPTION","<OK>",)
33
34 ;"---------------------------------------------------------
35 ;"Register Event Handlers
36 do regEvent^TMGOOL(TMGthis,"SHIFT-CLICK","HandleSClick^TMGWBT01(LOC)")
37 do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWBT01(LOC)")
38
39 ;"--------------------------------------------------------------------------------
40 ;"Optional initialization of some instance-specific variables.
41
42
43
44 ;"--------------------------------------------------------------------------------
45 ;"Startup code here...
46
47 quit
48
49
50Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
51 ;"Purpose: A destructor for object Widget
52 ;" any needed clean up code would go here first.
53 ;"Input: instanceName -- the name of the object instance to be deleted.
54 ;" This should be the value returned from defWidget
55 ;"Note: Don't actually delete the object here. Just perform code needed to
56 ;" save the object variables etc. Anything neeed before the object
57 ;" is deleted by delete^TMGOOL
58
59 ;"-----------------
60
61 ;" Here I would put code that needs to be called before destruction of the object.
62
63 ;"-----------------
64
65 quit
66
67
68 ;"------------------------------------------
69 ;"Object member functions below
70 ;"------------------------------------------
71
72 ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
73 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
74
75Paint()
76 ;"Purpose: To paint the current window (and all children windows)
77 ;"Input: instanceName -- the name/ref of this instance
78
79 ;"call inherited
80 do procInh^TMGOOL(TMGthis,"TMGWBT01","PAINT")
81
82 ;"do Specializations to paint here...
83
84 new T,L,B,R,H,W,LOC
85 new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
86 do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,"SCREEN")
87 set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT"))
88 set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT"))
89 set H=+$get(LOC("HEIGHT")),W=+$get(LOC("WIDTH"))
90
91 new selected set selected=($$getProp^TMGOOL(TMGthis,"STATE")="SELECTED")
92 new focused set focused=$$fn^TMGOOL(TMGthis,"IS FOCUSED")
93 new caption set caption=$$getProp^TMGOOL(TMGthis,"CAPTION")
94
95 if selected do
96 . do CHGA^TMGXGF("R1")
97 . do WIN^TMGXGF(T,L,B,R)
98 . do CHGA^TMGXGF("R0")
99 . do proc^TMGOOL(TMGthis,"FLUSH MOUSE SAVE")
100
101 if caption'="" do
102 . new attrib set attrib=""
103 . if (selected=1) set attrib="R1"
104 . set T=T+(H/2)
105 . set L=L+((W-$length(caption))/2)
106 . do SAY^TMGXGF(T,L,caption,attrib)
107
108 if selected do
109 . ;"I want to turn the selected state off immediately, to make button flash
110 . do setProp^TMGOOL(TMGthis,"STATE",0) ;"unselect
111 . do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1) ;"flag as needs repaint
112
113 quit 0
114
115
116HandleClick(LOC)
117 ;"Purpose: do something here with a mouse click. Note: descendents can
118 ;" overwrite this function to customize their control.
119 ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
120 ;" coordinates in LOCAL frame of refeernces.
121 ;" LOC("TOP")=
122 ;" LOC("LEFT")=
123 ;" LOC("HEIGHT")= ;"optional
124 ;" LOC("WIDTH")= ;"optional
125 ;" LOC("BOTTOM")= ;"optional
126 ;" LOC("RIGHT")= ;"optional
127
128 ;"Click belongs to this window, so handle it.
129 ;"Put click handler code here
130
131 ;"for now, click and shift-click will be the same
132 do HandleSClick(.LOC)
133
134ACDone
135 quit ;"<-- required: NO return value for event handler
136
137
138HandleSClick(LOC)
139 ;"Purpose: do something here with a mouse shift click. Note: descendents can
140 ;" overwrite this function to customize their control.
141 ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
142 ;" coordinates in LOCAL frame of refeernces.
143 ;" LOC("TOP")=
144 ;" LOC("LEFT")=
145 ;" LOC("HEIGHT")= ;"optional
146 ;" LOC("WIDTH")= ;"optional
147 ;" LOC("BOTTOM")= ;"optional
148 ;" LOC("RIGHT")= ;"optional
149
150 ;"Click belongs to this window, so handle it.
151
152 new newState set newState="SELECTED"
153 if $$getProp^TMGOOL(TMGthis,"STATE")="SELECTED" set newState=0
154 do setProp^TMGOOL(TMGthis,"STATE",newState)
155 do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1) ;"flag as needs repaint
156
157ADCDone
158 quit ;"<-- required: NO return value for event handler
159
160
161
162
163 ;"------------------------------------------
164 ;"Private functions below
165 ;"------------------------------------------
Note: See TracBrowser for help on using the repository browser.