source: cprs/branches/tmg-cprs/m_files/TMGWSBR1.m@ 1713

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

Initial upload

File size: 12.2 KB
Line 
1TMGWSBR1 ;TMG/kst/OO Scroll Bar ;05/10/07
2 ;;1.0;TMG-LIB;**1**;05/10/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^TMGWSBR1()")
28
29 ;"---------------------------------------------------------
30 ;"Register Event Handlers
31 do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWSBR1(LOC)") ;"override
32
33 ;"---------------------------------------------------------------------
34 ;"Register Properties
35 do regProp^TMGOOL(TMGthis,"MAX VALUE",100,"setMax^TMGWSBR1") ;"
36 do regProp^TMGOOL(TMGthis,"MIN VALUE",0,"setMin^TMGWSBR1") ;"
37 do regProp^TMGOOL(TMGthis,"VALUE",50,"setValue^TMGWSBR1") ;"
38 do regProp^TMGOOL(TMGthis,"PERCENT",50,"setPercent^TMGWSBR1") ;"
39 do regProp^TMGOOL(TMGthis,"ORIENTATION","H") ;"[H]ORIZ VS. [V]ERT
40
41 ;"--------------------------------------------------------------------------------
42 ;"Optional initialization of some instance-specific variables.
43
44
45 ;"--------------------------------------------------------------------------------
46 ;"Startup code here...
47
48 quit
49
50
51Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
52 ;"Purpose: A destructor for object Widget
53 ;" any needed clean up code would go here first.
54 ;"Input: instanceName -- the name of the object instance to be deleted.
55 ;" This should be the value returned from defWidget
56 ;"Note: Don't actually delete the object here. Just perform code needed to
57 ;" save the object variables etc. Anything neeed before the object
58 ;" is deleted by delete^TMGOOL
59
60 ;"-----------------
61
62 ;" Here I would put code that needs to be called before destruction of the object.
63
64 ;"-----------------
65
66 quit
67
68
69 ;"------------------------------------------
70 ;"Object member functions below
71 ;"------------------------------------------
72
73 ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
74 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
75
76Paint()
77 ;"Purpose: To paint the scroolbar
78 ;"Input: instanceName -- the name/ref of this instance
79
80 new T,L,B,R,H,W,LOC
81 new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
82 do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,"SCREEN")
83 set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT"))
84 set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT"))
85 set H=+$get(LOC("HEIGHT")),W=+$get(LOC("WIDTH"))
86
87 new o set o=$$getProp^TMGOOL(TMGthis,"ORIENTATION")
88 new pct set pct=$$getProp^TMGOOL(TMGthis,"PERCENT")
89 new len set len=$select(o="H":(W),1:(H))
90 set len=len-1 ;"avoid overlap in bottom-right corner.
91 new tempS set tempS=$$getDispS(len,o,pct)
92
93 if o="H" do SAY^TMGXGF(T,L,tempS)
94 else do VSAY^TMGXGF(T,L,tempS)
95
96 do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",0) ;"flag as painted.
97
98 quit 0
99
100
101 ;"------------------------------------------
102 ;"Property Getters & Setters below
103 ;"------------------------------------------
104
105setMax(TMGthis,PropName,value)
106 ;"Purpose: to set MAX value possible for scroll bar
107 ;"Input: TMGthis -- a this pointer for properter setter.
108 ;" PropName -- the name of the property -- not used here
109 ;" value -- value to set
110
111 set @TMGthis@("PROP","MAX")=$get(value)
112 do setActualPct
113 quit ;"<-- required not return value for property setter.
114
115
116setMin(TMGthis,PropName,value)
117 ;"Purpose: to set MIN value possible for scroll bar
118 ;"Input: TMGthis -- a this pointer for properter setter.
119 ;" PropName -- the name of the property -- not used here
120 ;" value -- value to set
121
122 set @TMGthis@("PROP","MIN")=$get(value)
123 do setActualPct
124 quit ;"<-- required not return value for property setter.
125
126
127setValue(TMGthis,PropName,value)
128 ;"Purpose: to set value for scroll bar
129 ;"Input: TMGthis -- a this pointer for properter setter.
130 ;" PropName -- the name of the property -- not used here
131 ;" value -- value to set
132
133 new max,min
134 set max=$get(@TMGthis@("PROP","MAX"))
135 set min=$get(@TMGthis@("PROP","MIN"))
136 set value=+$get(value)
137 if (value'>max)&(value'<min) do
138 . set @TMGthis@("PROP","VALUE")=value
139 . do setActualPct
140 do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1)
141 quit ;"<-- required not return value for property setter.
142
143
144setPercent(TMGthis,PropName,pct)
145 ;"Purpose: to set percent value for scroll bar
146 ;"Input: TMGthis -- a this pointer for properter setter.
147 ;" PropName -- the name of the property -- not used here
148 ;" pct -- value to set: expected input=0-100 (NOT 0.00-1.00)
149
150 new max,min
151 set max=$get(@TMGthis@("PROP","MAX"))
152 set min=$get(@TMGthis@("PROP","MIN"))
153 set pct=+$get(pct)
154 if pct>100 set pct=100
155 else if pct<0 set pct=0
156 new range set range=max-min
157 new value set value=(range*(pct/100))+min
158 set @TMGthis@("PROP","VALUE")=value
159 set @TMGthis@("PROP","PERCENT")=pct
160 quit ;"<-- required not return value for property setter.
161
162
163setOrient(TMGthis,PropName,value)
164 ;"Purpose: to set percent value for scroll bar
165 ;"Input: TMGthis -- a this pointer for properter setter.
166 ;" PropName -- the name of the property -- not used here
167 ;" pct -- value to set: expected input="H" or "V"
168
169 set value=$$UP^XLFSTR($extract(value,1))
170 if (value="H")!(value="V") set @TMGthis@("PROP","ORIENTATION")=value
171 quit ;"<-- required not return value for property setter.
172
173 ;"------------------------------------------
174 ;"Event handlers below
175 ;"------------------------------------------
176
177HandleClick(LOC)
178 ;"Purpose: do something here with a mouse click. Note: descendents can
179 ;" overwrite this function to customize their control.
180 ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
181 ;" coordinates in LOCAL frame of refeernces.
182 ;" LOC("TOP")=
183 ;" LOC("LEFT")=
184 ;" LOC("HEIGHT")= ;"optional
185 ;" LOC("WIDTH")= ;"optional
186 ;" LOC("BOTTOM")= ;"optional
187 ;" LOC("RIGHT")= ;"optional
188 ;"Note: It has already been determined that the click belongs to this window
189 ;" (and not a child of this window), so it should be handled here.)
190
191 ;"Click belongs to this window, so handle it.
192
193 ;"Put default click handler code here...
194
195 do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,TMGthis) ;"ensure coordinates in TMGthis's frame
196
197 new L set L=$get(LOC("LEFT"))
198 new T set T=$get(LOC("TOP"))
199
200 new orient set orient=$$getProp^TMGOOL(TMGthis,"ORIENTATION")
201 if orient="H" do
202 . new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH")
203 . if L=0 do scrlMinus(1)
204 . ;"For line below: why W-2?
205 . ;" A: numbering starts at 0, so W seems 1 too long
206 . ;" then subtract another 1 to avoid overlap with Vscroll bar
207 . else if L=(W-2) do scrlPlus(1)
208 . else do
209 . . new pos set pos=$$getMrkPos()
210 . . if L<pos do scrlPLeft
211 . . if L>pos do scrlPRight
212 else if orient="V" do
213 . new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT")
214 . if T=0 do scrlMinus(1)
215 . ;"For line below: why H-1?
216 . ;" A: numbering starts at 0, so H seems 1 too long
217 . ;" no need to subtract another 1 re overlap, because Vscroller has corner
218 . else if T=(H-2) do scrlPlus(1)
219 . else do
220 . . new pos set pos=$$getMrkPos()
221 . . if T<pos do scrlPUp
222 . . if T>pos do scrlPDown
223
224
225HCDone
226 quit ;"<-- required: NO return value for event handler
227
228
229
230
231 ;"------------------------------------------
232 ;"Private functions below
233 ;"------------------------------------------
234
235getMrkPos()
236 ;"Purpose: to get the graphical position of the marker on
237 ;" the scroll bar.
238 new o set o=$$getProp^TMGOOL(TMGthis,"ORIENTATION")
239 new pct set pct=$$getProp^TMGOOL(TMGthis,"PERCENT")
240 new len set len=$select(o="H":(W),1:(H))
241 set len=len-1 ;"avoid overlap in bottom-right corner.
242 new tempS set tempS=$$getDispS(len,o,pct)
243 new s set s=$piece(tempS,"*",1)
244 quit $length(s)
245
246scrlPLeft
247 ;"Purpose: to handle a request to scroll a page to the left
248 new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH")
249 do scrlMinus(W)
250 quit
251
252scrlPRight
253 ;"Purpose: to handle a request to scroll a page to the left
254 new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH")
255 do scrlPlus(W)
256 quit
257
258scrlPUp
259 ;"Purpose: to handle a request to scroll a page to the left
260 new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT")
261 do scrlMinus(H)
262 quit
263
264scrlPDown
265 ;"Purpose: to handle a request to scroll a page to the left
266 new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT")
267 do scrlPlus(H)
268 quit
269
270scrlMinus(num)
271 ;"Purpose: to handle a request to scroll to the minus direction (left, or up)
272 new value set value=$$getProp^TMGOOL(TMGthis,"VALUE")
273 set value=value-num
274 do setProp^TMGOOL(TMGthis,"VALUE",value)
275 quit
276
277scrlPlus(num)
278 ;"Purpose: to handle a request to scroll to the plus direction (right or down)
279 new value set value=$$getProp^TMGOOL(TMGthis,"VALUE")
280 set value=value+num
281 do setProp^TMGOOL(TMGthis,"VALUE",value)
282 quit
283
284
285
286setActualPct
287 ;"Purpose: to set the value of PERCENT to match current values
288
289 new max,min,value
290 set max=$get(@TMGthis@("PROP","MAX"))
291 set min=$get(@TMGthis@("PROP","MIN"))
292 set value=$get(@TMGthis@("PROP","VALUE"))
293
294 new range set range=max-min
295 new pos set pos=value-min
296 new pct set pct=0
297
298 if range'=0 set pct=((pos/range)*100)
299 set @TMGthis@("PROP","PERCENT")=pct
300 quit
301
302
303getDispS(len,o,pct)
304 ;"Purpose: get a string that represents the scroll bar
305 ;" e.g. '<---#------>'
306 ;" or if orientation is vertical: '^||||#|||v'
307 ;"Input: len -- the total length of the string to be returned
308 ;" o -- orientation: 'H' or 'V'
309 ;" pct -- the percent position
310 ;"results: returns string, or "" if length<3
311
312 new result set result=""
313 set len=$get(len)-2 ;"shrink for arrows on ends
314 if len'>0 goto gDSDone
315 set o=$get(o,"H")
316 set pct=+$get(pct)
317 ;"if o="H" set len=len-1 ;"avoid overlap with HORIZ bar at the corner
318
319 new bar
320 ;"if o="V" set $piece(bar,$get(IOVL,"|"),len+2)=" "
321 ;"else set $piece(bar,$get(IOHL,"-"),len+2)=" "
322 if o="V" set $piece(bar,"|",len+2)=" "
323 else set $piece(bar,"-",len+2)=" "
324
325 new pre,post
326 set pre=(len*pct\100),post=len-pre
327 set result=result_$extract(bar,1,pre-1)_"*"_$extract(bar,1,post)
328
329 if o="V" set result="^"_result_"v"
330 else set result="<"_result_">"
331
332gDSDone
333 quit result
334
335
336
Note: See TracBrowser for help on using the repository browser.