Module picklist.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright 1987-1995 Data Access Corporation, Miami FL, USA
5// All Rights reserved
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9
10//************************************************************************
11// Picklist.Pkg
12// Version: 1.0
13// 11-05-1992 : Created
14//
15// Author: John J. Tuohy
16//
17//************************************************************************
18//**jjt***********************************************************************
19// picklist.pkg - Modified picklist which is based on List_wide instead
20// of wide_list. This is identical to picklist.pkg
21// except when noted (lines marked with //**jjt**).
22// John Tuohy
23//**jjt***********************************************************************
24//************************************************************************
25//
26// Confidential Trade Secret.
27// Copyright 1987-1992 Data Access Corporation, Miami FL, USA
28// All Rights reserved
29// DataFlex is a registered trademark of Data Access Corporation.
30//
31//
32// $Source: k:\source.30b\pkg\rcs\picklist.pkg $
33// $Revision: 1 $
34// $State: Exp $
35// $Author: steve-l $
36// $Date: Apr 01 16:09:16 1997 $
37// $Locker: $
38//
39// $Log: picklist.pkg $
40//Revision 1.7 92/06/05 16:32:31 steve-l
41//altered set current_item occurrances to use set item false/true/2/3 instead,
42//in order to properly handle displayonly/noenter items on top-of-panel et al.
43//
44//Revision 1.6 92/05/29 14:06:05 lee
45//removed end_construct_* messages from mixins; now, classes that use the mixin
46//send the message that used to be sent by the end_construct_* message (for
47//efficiency).
48//
49//Revision 1.5 92/05/14 15:47:38 unknown
50//Updated Copyright slug - SWM.
51//
52//Revision 1.4 92/03/29 18:45:08 lee
53//added MSG_END_CONSTRUCT_OBJECT, moved ENDMAC macro stuff into END_CONSTRUCT-
54//OBJECT procedures (in .pkgs). moved Flag_ITems to list.pkg after generalizing
55//it based on PROTOTYPE_OBJECT instead of Whether or not it is a table-oriented
56//object. Moved define_access_keys mechanism completely into actionbr.pkg.
57//fixed two typos: import_class_protocol used !# instead of !3, and register-
58//procedure used !1 instead of !2.
59//
60//Revision 1.3 92/03/09 19:03:50 james
61//Added #CHKSUB directive to insure source
62//only compiled with correct revision of
63//compiler.
64//
65//Revision 1.2 92/01/13 17:39:45 steve-l
66//DAR 2241: send entering retval changed to get msg_entering to retval.
67//
68//Revision 1.1 91/10/23 10:21:59 elsa
69//Initial revision
70//
71//************************************************************************/
72
73//************************************************************************
74// File Name: PickList.Pkg
75// Creation Date: January 1, 1991
76// Modified Date: January 13, 1992
77// Author(s): Steven A. Lowe
78//
79// This module contains the Pick_List class definition.
80//************************************************************************/
81
82//************************************************************************
83// Version: 1.0
84// 12-01-1992 : Created
85//
86// Author: John J. Tuohy
87//
88// 1. Adds Stop_UI_State Support to Picklist
89// 2. Creates Move_Value_Out_State property (set when a popup) - Allows lists
90// in clients.
91// 3. Adds Auto_Locate_State Support
92// 4. Adds movable support (ver 1.1)
93//
94// 05-09-1993 Add Auto_Locate_State support
95// 03/17/94 Item 4 v.1.1
96// 03/20/94 modified add_item so that it does not change the object's
97// changed_state. Without this creating a new list makes the
98// item's changed_state true which sets its server's changed_
99// state to true. (v1.1)
100// 03-29-1994 (LS) Added Non_Dependent_Item_Mixin (for manual bcst/delg).
101//************************************************************************/
102
103//************************************************************************/
104// 12/22/94 JJT Merge Changes
105// Merged the 0 class into entry_form.
106// Added from List.pkg: Activating, Insert_item, Add_item,
107// Flag_items and Toggle_select.
108// 09/04/95 JJT - Code Clean up (removed dead commented code)
109//************************************************************************/
110// 2/26/2002 JJT - 8.2 clean up (indirect_file, local, self, etc.)
111
112
113#CHKSUB 1 1 // Verify the UI subsystem.
114
115Use List.pkg
116Use Dep_Item.pkg // Auto-Dependent_Item Support v1.1
117Use AutoLcMx.pkg // Auto locate of popup mixin
118
119class pick_list_mixin is a mixin
120 procedure Construct_Object integer img
121 forward send construct_object img
122 send define_list //invoke constructor for list support
123 set export_item_state to TRUE //change default to export item value
124 Send Define_Auto_Locate
125 end_procedure
126
127 IMPORT_CLASS_PROTOCOL LIST_Mixin //include list support module
128 IMPORT_CLASS_PROTOCOL Non_Dependent_Item_Mixin // v1.1
129 IMPORT_CLASS_PROTOCOL Auto_Locate_Mixin
130
131 { MethodType=Event }
132 procedure Initialize_List
133 integer pscope item#
134 string val
135 if (item_count(self)) lt 1 begin
136 send fill_list
137 get Invoking_Object_ID to pScope
138 if pscope ne 0 begin
139 get value of pscope item CURRENT to val
140 move 0 to item#
141 if val gt "" get item_matching val to item# //item# passed & returned
142 if item# ge 0 set current_item to item#
143 end
144 end
145 end_procedure
146
147 { MethodType=Event }
148 procedure Fill_List //invoked by Initialize_List - intended for override
149 end_procedure
150
151 function First_Selected_Item returns integer
152 integer count maxx
153 move (item_count(self) - 1) to maxx
154 for count from 0 to maxx
155 if (select_state(self,count)) function_Return count
156 loop
157 end_function
158
159 procedure Move_Value_Out
160 integer item# obj#
161 string val
162 get first_selected_item to item#
163 get Invoking_Object_ID to obj#
164 if obj# ne 0 begin
165 if (Export_Item_State(self)) begin
166 get value item item# to val
167 set value of obj# item CURRENT to val
168 set item_changed_state of obj# item CURRENT to TRUE
169 end
170 end
171 end_procedure
172
173 { MethodType=Event NoDoc=True }
174 procedure Entering returns integer
175 integer retval item# selMode
176 forward get msg_Entering to retval
177 get current_item to item#
178 set Original_Selection to item#
179 get select_mode to selMode
180 if (SelMode = AUTO_SELECT) set select_state item item# to true
181 procedure_return retval
182 end_procedure
183
184 procedure Cancel returns integer
185 set current_item to (Original_Selection(self)) //set SelState?
186 send request_cancel
187 end_procedure
188
189 function Next_Selection returns integer //returns -1 if no selections
190 integer selCounter retval maxx
191 get Enumeration_Counter to selCounter
192 Move (item_count(self) - 1) to maxx
193 if selCounter le maxx begin
194 for retval from selCounter to maxx
195 if (select_state(self,retval)) begin
196 set Enumeration_Counter to (retval + 1)
197 set current_item to retval
198 function_return retval
199 end
200 loop
201 function_Return -1 //no more items
202 end
203 else function_Return -1 //no more items
204 end_function
205
206 { Visibility=Private }
207 procedure Entry_Display integer mfile# integer flag
208 integer item# selMode file#
209 string astr
210 integer iField
211 get target_file to file#
212 if mfile# eq 0 is_file_included file# 1 //sets FOUND
213 else indicate FOUND as (file# = mfile# OR flag = TRUE)
214 [found] begin
215 get select_mode to selMode
216 if (SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) begin
217 if (file# > 0) begin
218// move file# to filenumber
219// get target_field to fieldindex
220// move Indirect_File.RECNUM to astr
221 get target_field to iField
222 Get_field_value file# iField to astr
223 get item_matching item astr to item#
224 if item# ge 0 begin
225 set current_item to item#
226 set select_state item item# to true
227 end
228 else set select_count to 0
229 end
230 end
231 end
232 end_procedure
233
234 { Visibility=Private }
235 procedure Entry_Update integer mfile# integer flag
236 integer item# file# selMode
237 string astr
238 integer iField
239 get target_file to file#
240 if (mfile# = 0 AND flag = 3) is_file_included file# 1 //sets FOUND
241 else indicate FOUND as (file# = mfile# OR flag = TRUE OR mfile# = 0)
242 [found] begin
243 get select_mode to selMode
244 if ((SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) AND ;
245 Select_Count(self) > 0 AND ;
246 (mfile# = 0 OR mfile# = file#)) begin
247 get first_selected_item to item#
248 get value item item# to astr
249// move file# to filenumber
250// if file# gt 0 begin
251// get target_field to fieldindex
252// move astr to Indirect_File.RECNUM
253// end
254 if (file#>0) begin
255 get target_field to iField
256 set_field_value file# iField to astr
257 end
258 end
259 end
260 end_procedure
261
262 procedure Beginning_of_Data
263// set current_item to 0
264 set item to 3 //go to first item and column in list
265 end_procedure
266
267 procedure End_of_Data
268// set current_item to (item_count(self) - 1)
269 set item to 2 //go to last item and column in list
270 end_procedure
271
272 { Visibility=Private }
273 procedure Clear
274 integer iFile
275 get target_file to iFile
276 if (iFile>0) is_file_included iFile 1
277 else indicate FOUND TRUE
278 [FOUND] begin
279 send beginning_of_data
280 set select_count to 0
281 end
282 end_procedure
283
284 { Visibility=Private }
285 procedure Clear_Set
286 send clear
287 end_procedure
288
289 { Visibility=Private }
290 procedure Clear_All
291 send clear
292 end_procedure
293
294 { Visibility=Private }
295 procedure Display
296 send entry_display 0 0
297 end_procedure
298
299 //
300 // override of SERVER.PKG procedure
301 //
302 { Visibility=Private }
303 procedure find_servers_to_watch integer tableFlag
304 integer file# obj# srvr#
305 get Server to srvr#
306 if srvr# ne 0 begin
307 get target_file to file#
308 get which_data_set of srvr# file# to obj#
309 if (obj# <> 0 AND obj# <> srvr#) send add_Watched_server obj#
310 end
311 end_procedure
312
313 procedure End_Construct_Object
314 send Flag_Items // mark checkbox items
315 forward send End_Construct_Object
316 end_procedure
317
318 // Augment to Support AutoLocate
319 //
320 { MethodType=Event NoDoc=True }
321 // as of 15.1 we changed all deactivating/activating signatures to not return values (see windows.pkg / ComboForm / Activating for more)
322 Procedure Activating //Returns Integer
323 integer InvokingId RVal
324 Get Focus of desktop to InvokingId
325 If InvokingId le desktop Move 0 to InvokingId
326 forward get MSG_activating to rVal
327 If rVal Procedure_Return rVal
328 Set Invoking_object_id to InvokingId
329 //
330 If (Auto_Locate_State(self) ) ;
331 Send Auto_Locate InvokingId
332 End_Procedure
333
334 //
335 // Description
336 //
337 // This procedure inserts a new item into the list before the specified
338 // item#, using the specified message id (msg#) and value.
339 //
340 // It ensures that the Entry_State of the new item is FALSE, and that
341 // the Checkbox_Item_State of the new item is TRUE if this object's
342 // Radio_State is TRUE.
343 //
344 // Assumptions/Preconditions
345 //
346 // msg# should be a valid message id or 0.
347 // item# should be a valid item index (between 0 and Item_Count-1).
348 //
349 // Exceptions
350 //
351 // None.
352 //
353 // Notes
354 //
355 // After successful execution, the item index of the new item is the same
356 // as the originally specified item#.
357 //
358 { NoDoc=True }
359 Procedure Insert_Item Integer iMessage String sValue Integer iItem
360 forward send insert_item iMessage sValue iItem
361 set entry_state iItem to false
362 if (Radio_State(self)) ;
363 set Checkbox_Item_State iItem to true
364 end_procedure
365
366
367 //
368 // Description
369 //
370 // This procedure adds a new item at the end of the list, using the
371 // specified message id (msg#) and value.
372 //
373 // It ensures that the Entry_State of the new item is FALSE, and that
374 // the Checkbox_Item_State of the new item is TRUE if this object's
375 // Radio_State is TRUE.
376 //
377 // Assumptions/Preconditions
378 //
379 // msg# should be a valid message id or 0.
380 //
381 // Exceptions
382 //
383 // None.
384 //
385 // Notes
386 //
387 // After successful execution, the item index of the new item is
388 // Item_Count-1.
389 //
390 { NoDoc=True }
391 procedure Add_Item integer iMessage string sValue
392 integer item# Oldst
393 //
394 // Augmented to disallow change of change_state property.
395 //
396 get Change_Disabled_State to Oldst
397 set Change_Disabled_State to TRUE
398 forward send add_item iMessage sValue
399 set Change_Disabled_State to Oldst
400 //
401 move (item_count(self) - 1) to item#
402 set entry_state item item# to false
403 if (Radio_State(self)) ;
404 set Checkbox_Item_State item item# to true
405 end_procedure
406
407 // (JJT) from list.pkg
408 // Description
409 //
410 // This procedure toggles the select_state of the current item unless the
411 // select-mode of this object is no_select, in which case this procedure
412 // mimics the pressing of the space-bar to generate a space character for
413 // incremental search.
414 //
415 // Assumptions/Preconditions
416 //
417 // This object must understand the Key message as a method of character
418 // input, and must also understand the Select_Toggling message as a method
419 // of altering the select_state of an item.
420 //
421 // Exceptions
422 //
423 // None.
424 //
425 // Notes
426 //
427 // Sent by kSpace.
428 //
429 { NoDoc=True }
430 procedure Toggle_Select
431 if (select_mode(self) = NO_SELECT) send key kSpace
432 else send select_toggling CURRENT TOGGLE_STATE
433 end_procedure
434
435 // If the list is radio all items should be checkbox. Since this is
436 // now based on list the entry-state is already set to false (no
437 // need to do that).
438 { Visibility=Private }
439 procedure Flag_Items
440 integer count maxx
441 If (Radio_State(self)) Begin
442 Get Item_count to maxx
443 decrement maxx
444 for count from 0 to maxx
445 //set Entry_State of obj# item count to false
446 Set Checkbox_Item_State item count to true
447 loop
448 end
449 end_procedure
450
451end_class
452
453
454