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

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

Initial upload

File size: 4.7 KB
Line 
1TMGWSBX1 ;TMG/kst/OO Scroll Box ;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^TMGWSBX1()")
28
29 ;"---------------------------------------------------------
30 ;"Register Event Handlers
31
32 ;"---------------------------------------------------------------------
33 ;"Register Properties
34
35 ;"--------------------------------------------------------------------------------
36 ;"Optional initialization of some instance-specific variables.
37 new pType set pType=$name(@TMGthis@("OBJS","ScrollBars"))
38 new pScrlH,pScrlV
39
40 set pScrlH=$$new^TMGOOL(pType,"TMGWSBR1")
41 do setProp^TMGOOL(pScrlH,"ORIENTATION","H")
42 do setProp^TMGOOL(pScrlH,"PARENT",TMGthis)
43 do setProp^TMGOOL(pScrlH,"ALIGN","BOTTOM")
44 do setProp^TMGOOL(pScrlH,"HEIGHT",0)
45
46 set pScrlV=$$new^TMGOOL(pType,"TMGWSBR1")
47 do setProp^TMGOOL(pScrlV,"ORIENTATION","V")
48 do setProp^TMGOOL(pScrlV,"PARENT",TMGthis)
49 do setProp^TMGOOL(pScrlV,"ALIGN","RIGHT")
50 do setProp^TMGOOL(pScrlV,"WIDTH",0)
51
52 ;"Register Properties -- must be done after scrollbars created
53 do regProp^TMGOOL(TMGthis,"H-SCROLLER",pScrlH)
54 do regProp^TMGOOL(TMGthis,"V-SCROLLER",pScrlV)
55
56 ;"--------------------------------------------------------------------------------
57 ;"Startup code here...
58
59 quit
60
61
62Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
63 ;"Purpose: A destructor for object Widget
64 ;" any needed clean up code would go here first.
65 ;"Input: instanceName -- the name of the object instance to be deleted.
66 ;" This should be the value returned from defWidget
67 ;"Note: Don't actually delete the object here. Just perform code needed to
68 ;" save the object variables etc. Anything neeed before the object
69 ;" is deleted by delete^TMGOOL
70
71 ;"-----------------
72
73 ;" Here I would put code that needs to be called before destruction of the object.
74
75 ;"-----------------
76
77 quit
78
79
80 ;"------------------------------------------
81 ;"Object member functions below
82 ;"------------------------------------------
83
84 ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
85 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
86
87Paint()
88 ;"Purpose: To paint the current window (and all children windows)
89 ;"Input: instanceName -- the name/ref of this instance
90
91 ;"call inherited (this effects paint of children too)
92 do procInh^TMGOOL(TMGthis,"TMGWSBX1","PAINT")
93
94 ;"do Specializations to paint here...
95
96 new T,L,B,R,H,W,LOC
97 new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
98 do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,"SCREEN")
99 set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT"))
100 set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT"))
101
102 new pScrlH set pScrlH=$$getProp^TMGOOL(TMGthis,"H-SCROLLER")
103 new pScrlV set pScrlV=$$getProp^TMGOOL(TMGthis,"V-SCROLLER")
104 new HValue set HValue=$$getProp^TMGOOL(pScrlH,"VALUE")
105 new VValue set VValue=$$getProp^TMGOOL(pScrlV,"VALUE")
106
107 do SAY^TMGXGF(T+1,L+2,"H:"_HValue_", V:"_VValue)
108 do SAY^TMGXGF(B-1,R-1,"#")
109
110
111
112 quit 0
113
114
115 ;"------------------------------------------
116 ;"Event Handler functions below
117 ;"------------------------------------------
118
119
120
121
122 ;"------------------------------------------
123 ;"Private functions below
124 ;"------------------------------------------
Note: See TracBrowser for help on using the repository browser.