source: cprs/branches/tmg-cprs/m_files/TMGWMEMO.m@ 861

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

Initial upload

File size: 4.6 KB
RevLine 
[796]1TMGWTBX1 ;TMG/kst/OO Memo (text-editing) 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^TMGWMEMO()")
28 do regFn^TMGOOL(TMGthis,"CLIP TO DISPLAY","ClipToDisplay^TMGWMEMO(TMGthis)")
29
30 ;"---------------------------------------------------------
31 ;"Register Event Handlers
32
33 ;"---------------------------------------------------------------------
34 ;"Register Properties
35
36 ;"--------------------------------------------------------------------------------
37 ;"Optional initialization of some instance-specific variables.
38
39 ;"--------------------------------------------------------------------------------
40 ;"Startup code here...
41
42 do setProp^TMGOOL(TMGthis,"FRAME","NONE") ;"this is default. Owners can change
43 quit
44
45
46Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
47 ;"Purpose: A destructor for object Widget
48 ;" any needed clean up code would go here first.
49 ;"Input: instanceName -- the name of the object instance to be deleted.
50 ;" This should be the value returned from defWidget
51 ;"Note: Don't actually delete the object here. Just perform code needed to
52 ;" save the object variables etc. Anything neeed before the object
53 ;" is deleted by delete^TMGOOL
54
55 ;"-----------------
56
57 ;" Here I would put code that needs to be called before destruction of the object.
58
59 ;"-----------------
60
61 quit
62
63
64 ;"------------------------------------------
65 ;"Object member functions below
66 ;"------------------------------------------
67
68 ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
69 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
70
71Paint()
72 ;"Purpose: To paint the current window (and all children windows)
73 ;"Input: instanceName -- the name/ref of this instance
74
75 ;"call inherited (this effects paint of children too)
76 do procInh^TMGOOL(TMGthis,"TMGWMEMO","PAINT")
77
78 ;"do Specializations to paint here...
79
80
81 quit 0
82
83
84ClipToDisplay(TMGthis,extraT,extraL,extraB,extraR)
85 ;"*** This is just a copy of ClipToParent -- must modify for new purpose
86
87 ;"Purpose: to set the clipping boundries to the parent frame of TMGthis
88 ;"Note: because the parent frame might be partly off screen, this will also
89 ;" clip to the screen to prevent off-screen writing.
90 ;"Input: TMGthis -- the THIS pointer to have the clipping to
91 ;" extraT,extraL,extraB,extraR -- OPTIONAL -- NOT IMPLEMENTED (YET)
92 ;" was to allow shrinking of the clip area by extra amounts.
93 new PT,PL,PB,PR
94 do getPCoords^TMGWGOJ(TMGthis,.PT,.PL,.PB,.PR) ;"get parent coordinates
95 new pScrn set pScrn=$$GetScrn^TMGWGOJ()
96 new ST,SL,SB,SR,SLOC
97 set SLOC=$$getProp^TMGOOL(pScrn,"LOC",.SLOC) ;"get screen coordinates
98 set ST=+$get(SLOC("TOP"))
99 set SL=+$get(SLOC("LEFT"))
100 set SR=SL+$get(SLOC("WIDTH"))
101 set SB=ST+$get(SLOC("HEIGHT"))
102 if PT<ST set PT=ST
103 if PB'<SB set PB=SB
104 if PL<SL set PL=SL
105 if PR'<SR set PR=SR
106 do SETCLIP^TMGXGF(PT,PL,PB,PR) ;"clip to parent's window
107 quit 0
108
109
110
111 ;"------------------------------------------
112 ;"Event Handler functions below
113 ;"------------------------------------------
114
115
116
117
118 ;"------------------------------------------
119 ;"Private functions below
120 ;"------------------------------------------
121
122
123
Note: See TracBrowser for help on using the repository browser.