Module Dfsellst.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright 1987-1997 Data Access Corporation, Miami FL, USA
5// All Rights reserved
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9//
10// $File name : DFSelLst.pkg
11// $File title : Selection list (dbList) support for VDF
12// Notice :
13// $Author(s) : John Tuohy
14//
15// $Rev History
16// 5/3/00 JJT - If popup search used with batch, make it sensible. Also
17// clear search-mode when mouse is clicked
18//************************************************************************
19// 12/18/01 JJT - Fixed bug where string and date masks did work with search key
20// (removed vk_end from activate and added form_mask to search window)
21// General cleanup.
22// 5/3/98 JJT - Fixed bug in Key to not respond to scroll bar clicks.
23// 11/20/97 JJT - Fixed OEM Kbd problems with search box.
24// 11/15/97 JJT - Added Column checkbox support.
25// 11/13/97 JJT - Removed img# from dbList constructor. Why was that there?
26// 10/15/97 JJt - use selst_ds.pkg instead of sellist.pkg
27// 9/4/97 JJT - Modified popup search dialog to use default action button
28// 07/30/97 JJT - Added set current_item check for batch_state
29// 6/24/97 JJT - Added Limited DD Support. Sel-lists now understand DD_NoEnter
30// Masks, Capslock and DD Labels (via Auto_Label_State). Also
31// added DD support for Auto-shadow (Auto_shadow_state)
32// 01/16/97 JJT - Make auto_index_State default to TRUE
33// 07/23/96 JJT - New Class names
34// 11/10/95 JJT - Merged with windaf3 for 3.1
35// 05/01/95 JJT - Modified to support Cell and row highlighting
36// 03/28/95 JJT - Removed Layer for 0 class
37// changed name to dfsellst.pkg
38//************************************************************************
39Use LanguageText.pkg
40Use DFData.pkg
41Use Selst_ds.pkg
42
43{ Visibility=Private }
44{ HelpTopic=dbListSearchDialog }
45Class dbListSearchDialog is a ModalPanel
46 Procedure Construct_Object
47 Forward Send Construct_Object
48 Property integer SearchOk_State 0
49 End_Procedure // Construct_Object
50
51 Procedure Search_ok
52 Set SearchOk_state to 1
53 Send Stop_Modal_UI
54 End_Procedure
55
56End_Class
57
58{ Visibility=Private }
59Class dbListSearchForm is a form
60
61 Procedure Construct_Object
62 Forward Send Construct_Object
63 Property integer Seed_Char 0 // ansi character
64 // no longer needed, uses default button behavior
65 // on_key kEnter send Search_OK
66 on_key kCancel Send Cancel
67 End_Procedure // Construct_Object
68
69 Procedure Activate
70 integer hnd rval Chr
71 Forward Send activate
72 Get Seed_Char to Chr
73 If Chr begin
74 Get form_Window_Handle 0 to hnd
75 Move (sendmessage(hnd,WM_CHAR,Chr,0)) to rval
76 // above line replaces these three. Makes mask input work properly
77 //Move (sendmessage(hnd,WM_KEYDOWN,VK_END,EXTKEY)) to rval
78 //Move (sendmessage(hnd,WM_CHAR,Chr,0)) to rval
79 //Move (sendmessage(hnd,WM_KEYDOWN,VK_END,EXTKEY)) to rval
80 Set Seed_Char to 0
81 end
82 Else Send Select_All
83 End_Procedure // activate
84
85End_Class
86
87//
88// SelectionList
89//
90{ ClassType=Abstract }
91{ OverrideProperty=Initial_Row InitialValue=Fill_From_Center }
92{ HelpTopic=dbList_ }
93Class dbList_ is a DataList
94 Import_Class_Protocol Selection_List_ds_mixin
95End_Class
96
97// DFSELECTION_LIST
98//
99{ ClassType=Abstract }
100{ OverrideProperty=CurrentCellColor InitialValue=clAqua }
101{ OverrideProperty=CurrentRowColor InitialValue=clAqua }
102{ OverrideProperty=Gridline_Mode InitialValue=Grid_Visible_Vert }
103{ OverrideProperty=Auto_Index_State InitialValue=True }
104{ OverrideProperty=Highlight_Row_State InitialValue=True }
105{ HelpTopic=dbListDS }
106Class dbListDS is a dbList_
107 Procedure Construct_Object
108 Forward Send Construct_Object No_Image
109 Set CurrentRowColor to clAqua // by default highlight color for selists is aqua
110 Set CurrentCellColor to clAqua
111 Set Gridline_Mode to GRID_VISIBLE_VERT
112
113 Set Highlight_Row_State to True
114
115 { Category=Behavior }
116 { PropertyType=Boolean }
117 Property Integer Popup_Search_State True
118 set find_search_state to false
119
120 // We've always used an odd method to figure out if a list
121 // is a lookup list or an entry list. This makes this process
122 // manual. Normally a list does a move out. If you do not want this
123 // change this property.
124 Set Move_Value_Out_State to TRUE
125 // Auto_Index_state is the most useful setting, make it the default
126 Set Auto_Index_State to TRUE
127
128 // private array...access via get/set column_checkbox_state
129 Object ColCkBox Is an Array
130 End_Object
131 End_Procedure // Construct_Object
132
133 { MethodType=Property NoDoc=True }
134 Procedure Set Current_Item integer item#
135 integer i
136 if (batch_State(self)) ;
137 Forward Set Current_Item to item#
138 else begin
139 get dynamic_update_State to i
140 Set dynamic_update_State to 0
141 Forward Set Current_Item to item#
142 if i eq 1 ;
143 set dynamic_update_State to 2
144 ELse ;
145 if i eq 0 Set dynamic_update_State to 0
146 end
147 end_procedure
148
149
150 { MethodType=Event Visibility=Private }
151 procedure Key integer keyval
152 integer rval NewKeyVal iShift
153 If (keyVal<>KDOWNARROW AND KeyVal<>KUPARROW AND Popup_Search_State(self)) Begin
154 get shift_state to iShift
155 If ( iShift IAND (KEY_CTRL IOR KEY_ALT)=0) Begin // Skip Ctrl and Alt keys
156 Get AnsiKey to NewKeyVal // convert to Ansi char
157 If NewKeyval gt 0 Begin // if a printable character
158 Send Request_Search NewKeyval
159 procedure_Return
160 end
161 end
162 End
163 // if message is not handled by searching we MUST forward get.
164 // Else scroll bar activity will not work
165 Forward Get Msg_key keyval to rval
166 procedure_return rval
167 End_procedure
168
169
170
171 // this is called to pop-up the search box. Pass the first character
172 // to display. If zero, display entire invoking value.
173 // This supports both forms and checkbox values
174 //
175 Procedure Request_Search integer keyval
176 integer obj obj1 itm fw dt mg opt
177 integer Oldst rval
178 String val ttl sMask
179 integer bCkbox bSt
180 Get Current_Item to Itm // invoking Item
181 Get Column_Checkbox_state item (Current_col(self)) to bCkbox
182 If bCkBox Begin
183 // if checkbox, set default width to 50 and use the
184 // current state as the search.
185 Move 50 to fw
186 get Item_Buffer_Select_State itm to bSt
187 end
188 else begin
189 // if no value is passed use entire current item.
190 If KeyVal eq 0 ;
191 Get value item Itm to val
192 Else move '' to val
193 Get Form_Width item itm to Fw
194 If Fw lt 50 Move 50 to fw
195 Get Form_DataType Item itm to dt
196 // if a mask string, don't use mask -- make it a normal Ascii window
197 //If (dt=MASK_WINDOW) Move ASCII_WINDOW to dt
198 Get Form_mask Item itm to sMask
199 Get Form_Margin item itm to mg
200 Get Item_Options item itm to opt
201 end
202 Get Header_Label Item (column(self,itm)) to ttl
203 Object Search_Dialog is a dbListSearchDialog
204 Set Locate_mode to center_on_Parent
205 Set label to (C_$Search +":" * Ttl)
206 Set pbSizeToClientArea to True
207
208 If Fw ge 100 ;
209 Set size to (24+14+5) (Fw+5+5)
210 Else ;
211 Set size to (14+5+5) (Fw+5+5+5+50)
212
213 If not bCkBox Begin
214 Object frm is a dbListSearchForm
215 On_Item val
216 Set location to 5 5
217 Set size to 14 fw
218 Set Form_DataType item 0 to dt
219 set Form_mask item 0 to sMask
220 Set Form_Margin item 0 to mg
221 Set Form_Options item 0 to opt
222 Set Seed_Char to KeyVal
223 Move self to obj1
224 End_Object
225 End
226 Else Begin
227 Object Frm Is A CheckBox
228 Set location to 5 5
229 Set Checked_State to bSt
230 Set Label to Ttl
231 Move self to obj1
232 End_Object
233 End
234 Object PB is a Button
235 On_Item C_$Ok Send Search_OK // stop_modal_ui
236 If Fw ge 100 ;
237 Set Location to 24 (fw+5-50)
238 Else ;
239 Set Location to 5 (fw+5+5)
240 Set Default_State to True
241 End_Object
242
243 Move self to obj
244 End_Object
245
246 Send popup_modal to obj
247 Get SearchOk_State of obj to rval
248 If RVal Begin
249 Set dynamic_update_State to False
250 If not bCkBox ;
251 get value of obj1 item 0 to val
252 Else begin
253 get checked_state of obj1 to bSt
254 // convert state to item's appropriate DB value
255 Get Item_CheckBox_Value Item itm bSt to val
256 End
257 Send destroy of obj
258 if (batch_state(self)) Begin
259 // if batch_state uses the popup (which is kind of an odd thing to do)
260 // we will do a proper batch state search. In this case we try to find the closest
261 // match by removing one character at a time from the string till we get something
262 Repeat
263 Get Item_matching (val-"*") 0 to itm
264 // if no match, remove the last character and try again (e.g. JO -> J)
265 If (itm=-1) Move (left(val,length(val)-1)) to val
266 Until (itm>-1 Or val="")
267 If (itm>=0) Set current_item to itm // if match, change the item
268 end
269 else begin
270 Set Value item itm to val
271 Get find_search_state to Oldst
272 Set find_search_state to true
273 Send Request_Lookup itm
274 Set find_search_state to OldSt
275 End
276 Set dynamic_update_State to True
277 end
278 else ;
279 Send destroy of obj
280 End_procedure
281
282 { Visibility=Private }
283 Procedure Search
284 Send Request_Search 0
285 End_Procedure
286
287 { MethodType=Event NoDoc=True }
288 Procedure Mouse_Up integer i1 integer i2
289 set search_mode to (search_mode(self)) //reset incr srch index
290 If (Select_mode(self)<>No_Select) ;
291 Forward Send Mouse_up i1 i2
292 end_procedure
293
294 { MethodType=Event NoDoc=True }
295 Procedure Mouse_Click integer i1 integer i2
296 If (Select_mode(self)=No_Select) ;
297 Send Ok
298 Else ;
299 Forward Send Mouse_click i1 i2
300 End_Procedure
301
302 // Get/Set column_checkbox_state
303 // Use custom object for storage and not checkbox_item_state
304 //
305 { MethodType=Property NoDoc=True }
306 Procedure set Column_Checkbox_State integer iItem integer bState
307 Set Value of (ColCkBox (self)) item iItem to bState
308 End_Procedure
309
310 { MethodType=Property NoDoc=True }
311 Function Column_Checkbox_State integer iItem returns integer
312 Function_return (Value(ColCkBox(self),iItem)=1)
313 End_Procedure
314
315 // if you are not using DDs you must provide this function. Pass item
316 // number with buffer info in place. Return select-state.
317 // This is the primary augmentation point for determining if an item s/b
318 // checked. Sample usage:
319 // functon item_buffer_select_state integer iItem returns integer
320 // integer iCol bState
321 // get column iItem to iCol
322 // if iCol eq 3 ;
323 // Move (Invt.Qty_on_Hand>0) to bState
324 // function_return bState
325 // end_function
326 //
327 { MethodType=Property Visibility=Private }
328 Function Item_Buffer_Select_State integer iItem Returns integer
329 Function_Return 0
330 End_Function
331
332 // if you are not using DDs you must provide this. Pass item# and
333 // state, return the string value for this item. This is usually only
334 // needed when you support searching in the dbList.
335 //
336 { MethodType=Property Visibility=Private }
337 Function Item_CheckBox_Value Integer iItem Integer bState returns String
338 Function_Return bState
339 End_Function
340
341
342 // Augment to check for checkbox columns. If found,
343 // get checkbox state of item and send message to display ckbx
344 //
345 { MethodType=Event Visibility=Private }
346 Procedure Entry_Display integer i1 integer i2
347 integer iBase iCnt iCols iItm
348 integer bSt
349 forward send entry_display i1 i2
350 Get base_item to iBase
351 Get Item_Count of (prototype_object(self)) to iCols
352 decrement iCols
353 For iCnt From 0 to iCols
354 If (column_checkbox_state(self,iCnt)) Begin
355 Move (iCnt+iBase) to iItm
356 Set Value item iItm to ''
357 Get Item_Buffer_Select_State iItm to bSt // get check state
358 Send doDisplayCheckBox iItm bSt // do display
359 end
360 Loop
361 End_Procedure
362
363End_Class
364
365
366Use DD_Deomx.pkg // mixin support for dd classes
367
368{ HelpTopic=dbList }
369// while it may be possible to use these in dbLists it is so unlikely that
370// we will consider them non-designtime properties
371{ OverrideProperty=Column_Combo_Entry_State DesignTime=False }
372{ OverrideProperty=Column_Combo_ListRowCount DesignTime=False }
373{ OverrideProperty=Column_Combo_Sort_State DesignTime=False }
374{ OverrideProperty=Column_Combo_State DesignTime=False }
375{ OverrideProperty=Column_Maximum_Position DesignTime=False }
376{ OverrideProperty=Column_Minimum_Position DesignTime=False }
377{ OverrideProperty=Column_Minimum_Position DesignTime=False }
378{ OverrideProperty=Column_Zoom_Object DesignTime=False }
379{ OverrideProperty=Column_Prompt_Object DesignTime=False }
380
381
382Class dbList is a dbListDS
383
384 Procedure Construct_Object
385 Forward Send construct_object
386 { Category=Appearance }
387 { PropertyType=Boolean }
388 Property Integer Auto_Shadow_State True
389 { Category=Appearance }
390 { PropertyType=Boolean }
391 Property Integer Auto_Label_State False
392 End_Procedure
393
394 Import_Class_Protocol Extended_DEO_Mixin dbList Copy_Mask_Options
395
396 //************************************************************************//
397 // Procedure Copy_Item_Options //
398 // This procedure will copies limited DD information to the sel-list. //
399 // (no-enter, capslock, zero-suppress, masks, and auto-labels. //
400 //************************************************************************//
401 //
402 { Visibility=Private }
403 Procedure Copy_Item_Options Integer iDSO Integer iFile Integer iField ;
404 Integer iDEO Integer iItem
405 Integer iDEO_Opt
406 Integer iDSO_Opt
407 Integer iNew_Opt
408 If not (Extended_DSO_State(iDSO)) ;
409 Procedure_Return
410
411 Get File_Field_Options of iDSO iFile iField to iDSO_Opt
412 Get Item_Options of iDEO item iItem to iDEO_Opt
413
414// Removed this for 10.1. A no-enter field may be indexed and would be useful for searching
415// Forcing a no-enter, really makes no sense.
416// If ( iDSO_Opt IAND DD_NoEnter) ;
417// Move DD_NoEnter to iNew_Opt
418 If (iDSO_Opt IAND DD_CapsLock) ;
419 Move (iNew_Opt iOR DD_CapsLock) to iNew_Opt
420 If ( iDSO_Opt IAND DD_Zero_Suppress) ;
421 Move (iNew_Opt iOR DD_Zero_Suppress) to iNew_Opt
422
423 Set Item_Options of iDEO item iItem to (iDEO_Opt IOR iNew_Opt)
424 Set Form_Options of iDEO item iItem to (iDEO_Opt IOR iNew_Opt)
425 If (iDSO_Opt IAND DD_AUTOCLEAR) ;
426 Set Autoclear_State of iDEO item iItem to TRUE
427 Send Copy_Mask_Options iDSO iFile iField iDEO iItem
428 If (Auto_Label_State(self)) ;
429 Send Assign_DD_Label iDSO iFile iField iDEO iItem
430 End_Procedure
431
432 //************************************************************************//
433 // Assign_DD_Label //
434 // This assigns the DEO's from the DD. This uses short labels and //
435 // sets column headers. //
436 //************************************************************************//
437 //
438 { Visibility=Private }
439 Procedure Assign_DD_Label Integer iDSO Integer iFile Integer iField ;
440 Integer iDEO Integer iItem
441 string sName
442 Get File_Field_Label of iDSO iFile iField DD_LABEL_SHORT to sName
443 Set Header_Label item iItem to sName
444 End_Procedure
445
446 { Visibility=Private }
447 Procedure DoAutoShadow
448 integer iItem iIndex iCnt iEle iDEO_Opt
449 Get ProtoType_Object to iEle
450 Get Item_count of iEle to iCnt
451 Decrement iCnt
452 For iItem from 0 to iCnt
453 Get Col_Index item iItem to iIndex // -1 means no index
454 If iIndex eq -1 Begin
455 Get Item_Options of iEle item iItem to iDEO_Opt
456 Set Item_Options of iEle item iItem to (iDEO_Opt IOR DD_NoEnter)
457 End
458 Loop
459 End_Procedure
460
461 Procedure End_Construct_Object
462 If (Auto_Shadow_State(self)) Send DoAutoShadow
463 Forward send end_construct_Object
464 End_Procedure
465
466 //************************************************************************//
467 // Get Item_Buffer_Select_State //
468 // Returns Select_state based on field's buffer value (not the DD buffer //
469 // value). Used by entry_display to display checkbox values. It must use //
470 // the buffer //
471 //************************************************************************//
472
473 { MethodType=Property Visibility=Private }
474 Function Item_Buffer_Select_State Integer iItem returns integer
475 Integer iFile iField
476 Integer iServer
477 Integer bState
478 String sValue
479 Get Data_File Item iItem to iFile
480 Get Data_Field Item iItem to iField
481 Get Server to iServer
482 If (iServer AND iFile AND iField) Begin
483 Get_Field_Value iFile iField to sValue // command gets from buffer
484 Get File_Field_Value_Select_State of iServer iFile iField sValue to bState
485 end
486 Else ;
487 Forward get Item_Buffer_select_State iItem to bState
488 function_return bState
489 End_Function
490
491 //************************************************************************//
492 // Get Item_Checkbox_value //
493 // Returns the string value for the state passed for the passed item. //
494 // This is used to a bufer with the data associated with a checkbox state //
495 //************************************************************************//
496
497 { MethodType=Property Visibility=Private }
498 Function Item_CheckBox_Value Integer iItem Integer bState returns String
499 Integer iFile iField
500 Integer iServer
501 String sValue
502 Get Data_File Item iItem to iFile
503 Get Data_Field Item iItem to iField
504 Get Server to iServer
505 If (iServer AND iFile AND iField) ;
506 Get File_Field_CheckBox_Value of iServer iFile iField bState to sValue
507 Else ;
508 Forward get Item_Checkbox_Value iItem bState to sValue
509 Function_Return sValue
510 End_Function
511
512
513End_Class
514
515// Just like selection-list except the current item is always
516// column 0 and only one color is used for the entire highlighted row
517//
518{ Visibility=Private Obsolete=True }
519Class dbListRow is an dbList
520
521 Procedure Construct_Object
522 Forward Send Construct_Object
523 Set Auto_Column_State to False
524 Set Highlight_Row_State to True
525 Set CurrentRowColor to clAqua // by default highlight color for selists is aqua
526 Set CurrentCellColor to clAqua
527 End_Procedure // Construct_Object
528
529 // Item_Change:
530 // Augment to always make the current item the
531 // first column in the row
532 //
533 { MethodType=Event NoDoc=True }
534 Procedure Item_Change Integer iFromItem Integer iToItem returns integer
535 Integer rVal
536 Move (Row(self,iToItem)*Item_Limit(self)) to iToItem
537 Forward Get Msg_Item_Change iFromItem iToItem to Rval
538 Procedure_Return rVal
539 End_Procedure
540
541End_Class
542