Module FlexCOM20.pkg
1
2//
3// Full Flexcom support for automation (cComAutomationObject),
4// activeX (cComActiveXControl and document objects (cComDocumentObject)
5//
6
7Use FlexCOM20_Base.pkg // defines basic flexcom symbols and class cComAutomationObject
8
9{ DesignerClass=cDTComDocument }
10{ HelpTopic=cComDocumentObject }
11Class cComDocumentObject Is a DFComDocumentObject
12 Procedure Construct_Object
13 Forward Send Construct_Object
14 Send RegisterComEvents
15 Send Define_Standard_Object_Mixin
16 Send Define_Shadow_Mixin
17 End_Procedure
18 Import_Class_Protocol Standard_Object_Mixin
19 Import_Class_Protocol Shadow_Mixin
20
21 // It is expected that the Com class will augment this with useful event definitions
22 { Visibility=Private }
23 Procedure RegisterComEvents
24 End_Procedure
25
26 // returns true if the control is created.
27 { MethodType=Function }
28 Function IsComObjectCreated Returns Boolean
29 Variant vComObject
30 Get pvComObject to vComObject
31 Function_Return (Not(IsNullComObject(vComObject)))
32 End_Function
33
34End_Class
35
36{ DesignerClass=cDTComControl }
37{ OverrideProperty=Size InitialValue=0,0 }
38{ HelpTopic=cComActiveXControl }
39Class cComActiveXControl Is a DFComActiveXControl
40 Procedure Construct_Object
41 Forward Send Construct_Object
42 Send RegisterComEvents
43 Send Define_Standard_Object_Mixin
44 Send Define_Single_Item_Navigate_Mixin
45 Send Define_Dflabel_Mixin
46
47 // If set true, then the control will attempt to bind the value property in the object to the
48 // comValue in the control. It will try to keep these values in synch at all times. This allows a
49 // control to be used as a Form style value control. the default is true. Even when true if the
50 // get/set ComValue methods are not set up to do anything, this will do nothing.
51 { Category=Behavior }
52 Property boolean pbBindValue True
53
54 // internal: set true object is notified that the OCX value has changed.
55 { Visibility=Private }
56 Property Boolean pbPrivateControlChanging false
57
58 // Class sets this true when making a local (externally triggered) change. This is
59 // set when a Set Value change is made to prevent recursion
60 { Visibility=Private }
61 property Boolean pbPrivateControlRefresh false
62
63 // added to eumlate a single item form support
64 { Visibility=Private }
65 property Boolean pbPrivateItem_Changed_State false
66
67 // This keeps track of value, even when control is not created
68 { Visibility=Private }
69 Property String psPrivateValue ''
70
71 End_Procedure
72
73 Import_Class_Protocol Standard_Object_Mixin
74 Import_Class_Protocol Single_Item_Navigate_Mixin
75 Import_Class_Protocol Dflabel_Mixin
76
77 // It is expected that the Com class will augment this with useful event definitions
78 { Visibility=Private }
79 Procedure RegisterComEvents
80 End_Procedure
81
82 // added to eumlate a single item form support
83 { MethodType=Property }
84 Function Item_Count returns integer
85 function_return 1
86 end_function
87
88 // added to eumlate a single item form support
89 { MethodType=Property }
90 Procedure Set Item_Changed_State integer iItem integer iState
91 Set pbPrivateItem_changed_state to iState
92 If (iState and changed_state(self)=false) set changed_state to true
93 end_procedure
94
95 { MethodType=Property }
96 Function Item_Changed_State integer iItem returns integer
97 function_return (pbPrivateItem_changed_state(self))
98 end_function
99
100
101 // augment to set the label's appearance
102 { MethodType=Event }
103 Procedure Shadow_Display
104 forward send Shadow_display
105 Send Label_Shadow_Display
106 End_Procedure // Shadow_Display
107
108 // Created to simulate get/Set value.
109 { MethodType=Property }
110 Procedure set Value integer iItem string sVal
111 If not (pbPrivateControlChanging(self)) ;
112 Send OnRefreshControl sVal
113 Set psPrivateValue to sVal
114 Send OnChange
115 //Set changed_state to True
116 set item_changed_state 0 to true
117 End_Procedure
118
119 { MethodType=Property }
120 Function Value integer iItem returns string
121 function_return (psPrivateValue(self))
122 //function_return (Controlvalue(self))
123 end_function
124
125 { MethodType=Event }
126 Procedure OnChange
127 End_Procedure
128
129
130 // It is expected that the sub-class will provide functionality
131 // for these messages. This gets and sets the value of the actual
132 // window control. These should only be used to synchronize the window
133 // control and the DF side. Do not use for any other purpose.
134 { MethodType=Property }
135 { DesignTime=False }
136 Procedure Set ControlValue string sVal
137 End_Procedure
138
139 { MethodType=Property }
140 Function ControlValue Returns String
141 End_Function
142
143 { MethodType=Event }
144 Procedure OnCreate
145 // if we are binding value to comValue, do so upon creation
146 If (pbBindValue(self)) ;
147 Set ControlValue to (Value(self))
148 Forward Send OnCreate
149 End_Procedure
150
151
152 // returns true if the control is created.
153 { MethodType=Function }
154 Function IsComObjectCreated Returns Boolean
155 Variant vComObject
156 Get pvComObject to vComObject
157 Function_Return (Not(IsNullComObject(vComObject)))
158 End_Function
159
160 // Notification that the control's value has been changed
161 // externally by the program (via set value). Use to synchronize
162 // OCX control value.
163 { MethodType=Event Visibility=Private }
164 Procedure OnRefreshControl string sVal
165 Boolean bOld
166 If (pbBindValue(self) and pbPrivateControlChanging(self)=0 And IsComObjectCreated(self)) Begin
167 Get pbPrivateControlRefresh to bOld
168 Set pbPrivateControlRefresh to True
169 set ControlValue to sval
170 Set pbPrivateControlRefresh to bOld
171 end
172 End_Procedure
173
174 // notification that the control has changed its value. Used to
175 // synchronize the object with the change.
176 { MethodType=Event }
177 Procedure OnControlValueChanged
178 String sVal
179 Boolean bOld
180 If (pbBindValue(self) and pbPrivateControlRefresh(self)=0) Begin
181 Get pbPrivateControlChanging to bOld
182 Set pbPrivateControlChanging to True
183 Get ControlValue to sVal
184 Set Value to sVal
185 Set Item_Changed_State 0 to True
186 Set pbPrivateControlChanging to bOld
187 end
188 End_Procedure
189
190 { Nodoc=True }
191 Procedure Delete_Data
192 Forward Send Delete_Data
193 Set Value to ''
194 Set Changed_state to False
195 Set Item_changed_state 0 to false
196 End_Procedure
197
198End_Class
199
200