Module Combo_mx.pkg
1// 1/31/2002 JJT - Trim search text in WinCombo_item_matching (trailing spaces caused problems in search)
2// 12/13/2001 JJT check Oem_translate_state before making translations.
3// Fixed combo_delete_item (if combo is active and sorted, it works)
4// 8/2/97 JJT Made item_changed_state in combo_edit_changed unconditional.
5// (DFCentry.pkg modified to forward to combo_edit_changed and
6// combo_item_changed)
7// 06/13/97 JVH Modified Combo_Edit_Changed so that it sends OnChange. It looks
8// like it used to do this and was commented out (don't know why).
9// 04/01/97 JJT Fixed all OEM to ANSI / ANSI to OEM problems
10
11Use VDFBase.pkg
12
13{ ClassType=Mixin }
14Class Combo_Mixin is a Mixin
15
16 { Visibility=Private }
17 Procedure Define_Combo_Mixin
18 Set Focus_Mode of (Combo_data_Object(self)) to NO_ACTIVATE
19 { Category=Behavior }
20 { PropertyType=Boolean }
21 Property Integer Combo_Sort_State True
22 { Category=Behavior }
23 { PropertyType=Boolean }
24 Property Integer Allow_Blank_State False
25
26 { Visibility=Private }
27 { PropertyType=Boolean }
28 Property Integer Deferred_State False
29
30 { Visibility=Private }
31 Property Integer Default_Combo_Item -1 // -1 means top
32 { Category=Appearance }
33 Property Integer ListRowCount 0 // how many drop-down rows are required (0 = use size to determine number of rows)
34 { Category=Appearance }
35 Property Integer ListWidth 0 // width of dropped-down list (0=default width of edit)
36
37 { Visibility=Private }
38 Property boolean pbPrivateAddingFocus false // private, used by add_focus w/ set value
39
40// Send define_standard_Form_Mixin
41 End_Procedure
42
43// Import_Class_Protocol Standard_Form_Mixin
44
45 { Visibility=Private MethodType=Event }
46 Procedure Command integer i1 integer i2
47 integer param
48 Forward Send Command i1 i2
49 Move (hi(i1)) to param
50 If param eq CBN_SELCHANGE Send Combo_Item_Changed
51 Else if (param=CBN_EDITCHANGE OR param=CBN_EDITUPDATE) send Combo_Edit_Changed
52 Else If Param eq CBN_DROPDOWN Send OnDropDown
53 Else If Param eq CBN_CLOSEUP Send OnCloseUp
54 end_procedure
55
56 { MethodType=Event }
57 Procedure Combo_Item_Changed
58 Set item_Changed_State item 0 to true
59 Send OnChange
60 end_Procedure
61
62 { MethodType=Event }
63 Procedure Combo_Edit_Changed
64 Set item_Changed_State item 0 to true // JJT - 8/2/97 - Made unconditional
65 Send OnChange // jvh - 13 Jun 97
66 end_Procedure
67
68 { MethodType=Property }
69 Function Combo_Item_Count Returns Integer
70 integer dataobj
71 Get Combo_data_object to dataobj
72 If dataobj ;
73 Function_return (item_count(dataobj))
74 End_function
75
76 // get/set Combo_current_item serve no purpose as this deals with the
77 // DF list of values (and not the windows position). There just isn't anything
78 // you can do with this.
79 { MethodType=Property Visibility=Private Obsolete=True }
80 Function Combo_Current_Item Returns Integer
81 integer dataobj
82 Get Combo_data_object to dataobj
83 If dataobj ;
84 Function_return (current_item(dataobj))
85 End_Function
86
87 { MethodType=Property Visibility=Private Obsolete=True }
88 Procedure Set Combo_Current_Item integer iTo
89 integer dataobj
90 Get Combo_data_object to dataobj
91 If dataobj ;
92 Set Current_item of dataobj to iTo
93 End_Procedure
94
95 { MethodType=Property }
96 Procedure Set Combo_Value Integer item# String sValue
97 integer dataobj witem#
98 String OldVal OldComboVal
99 Get Combo_data_object to dataobj
100 If dataobj Begin
101 Move (Rtrim(sValue)) to sValue // see Combo_Add_Item
102 // if windows exists make sure it is also up to date.
103 If (Window_Handle(self)) Begin
104 Get Value of dataobj item item# to OldComboVal // current value
105 Get WinCombo_Item_Matching OldComboVal To WItem#
106 If WItem# ne -1 Begin
107 Get Value item 0 to OldVal // current value
108 Send Windows_Message CB_DELETESTRING WItem# 0
109 Send WinCombo_Add_Insert_Value CB_INSERTSTRING WItem# sValue
110 Set Value item 0 to OldVal // current value
111 End
112 End
113 Set Value of dataobj item item# to sValue
114 End
115 End_Procedure
116
117 { MethodType=Property }
118 Function Combo_Value Integer item# Returns String
119 integer dataobj
120 Get Combo_data_object to dataobj
121 If dataobj ;
122 Function_return (Value(dataobj,item#))
123 End_Procedure
124
125 Procedure Combo_Add_Item string sValue
126 integer dataobj
127 Get Combo_data_object to dataobj
128 If dataobj Begin
129 // 14.1 change: Trailing spaces causes matching problems
130 // with entry_state=false combos. We are RTrim all because
131 // you probably never want spaces in the combo list
132 Move (Rtrim(sValue)) to sValue
133 send add_item to dataobj msg_none sValue
134 If (Deferred_State(self)=0 AND Window_Handle(self)) ;
135 Send WinCombo_Add_Insert_Value CB_ADDSTRING 0 sValue
136 End
137 End_Procedure
138
139 Procedure Combo_Insert_Item Integer iItem string sValue
140 integer dataobj
141 Get Combo_data_object to dataobj
142 If dataobj Begin
143 Move (Rtrim(sValue)) to sValue // see Combo_Add_Item_Notes
144 Send insert_item to dataobj msg_none sValue iItem
145 If (Window_Handle(self)) ;
146 Send WinCombo_Add_Insert_Value CB_INSERTSTRING iItem sValue
147 End
148 End_Procedure
149
150 // Internal: Send it the wrong values and watch the smoke!
151 { Visibility=Private }
152 Procedure WinCombo_Add_Insert_Value integer mode integer iItem String sValue
153 pointer lpString pVoid
154 // trim trailing spaces. Should already be trimmed but just in case (14.1 change)
155 Move (sValue - Character(0)) to sValue
156 GetAddress of sValue To lpString
157 If (Oem_Translate_State(self)) ;
158 Move (OemToAnsi(lpString,lpString)) To pVoid // covert to ANSI first
159 Send Windows_Message Mode iItem lpString
160 End_Procedure
161
162 Procedure Combo_Delete_Item Integer iItem
163 integer dataobj
164 integer iWinItem
165 String sOldVal
166 Get Combo_data_object to dataobj
167 If dataobj Begin
168 // if active, find item in the windows list and remove it there
169 If (Window_Handle(self)) Begin
170 Get Value of dataobj item iItem to sOldVal // value of deleted item
171 // we must search for value because it may be sorted
172 Get WinCombo_Item_Matching sOldVal to iWinItem
173 If (iWinItem<>-1) ; // if item found (should be) remove it.
174 Send Windows_Message CB_DELETESTRING iWinItem 0
175 End
176 Send Delete_Item to dataobj iItem
177 End
178 End_Procedure
179
180 Procedure Combo_Delete_Data
181 integer dataobj
182 Get Combo_data_object to dataobj
183 If dataobj Begin
184 Send Delete_Data to dataobj
185 If (Deferred_State(self)=0 AND Window_Handle(self)) ;
186 Send Windows_Message CB_RESETCONTENT 0 0
187 End
188 End_Procedure
189
190 Function Combo_Item_Matching String sText Returns Integer
191 integer dataobj item#
192 Get Combo_data_object to dataobj
193 If dataobj Begin
194 Move 0 to item#
195 get item_matching of dataobj sText to item#
196 //showln "comboitemmat " stext item#
197 Function_return item#
198 end
199 Else Function_Return -1
200 End_Function
201
202 // Perform the item match in the window's control
203 //
204 { Visibility=Private }
205 Function WinCombo_Item_Matching String sText Returns Integer
206 Handle hWnd
207 Integer iItem iItems
208 Pointer lpsText pVoid
209 String sItem
210 Get Window_Handle To hWnd
211 If hWnd Begin
212
213 // CB_FINDSTRINGEXACT does not find blank items even though they can be added. If blank
214 // we must manually search for the first empty item
215 If (sText="") Begin
216 Get Combo_Item_Count to iItems
217 Move 0 to iItem
218 While (iItem<iItems)
219 Get WinCombo_Value iItem to sItem
220 If (sItem="") Begin
221 Function_Return iItem
222 End
223 Increment iItem
224 Loop
225 Function_Return -1
226 End
227
228 Move (sText-Character(0)) to sText // (1/31/2002) Trim trailing spaces and append 0 for C string
229 GetAddress of sText To lpsText
230 // convert to ANSI for search against ANSI items in list
231 If (Oem_Translate_State(self)) ;
232 Move (OemToAnsi(lpsText,lpsText)) To pVoid
233 Move (SendMessage (hWnd, CB_FINDSTRINGEXACT, 0, lpsText)) To iItem
234 If iItem eq CB_ERR Function_Return -1
235 Else Function_Return iItem
236 End
237 End_Function
238
239 { MethodType=Property Visibility=Private }
240 Procedure Set WinCombo_Current_Item integer iTo
241 Send Windows_Message CB_SETCURSEL iTo 0
242 End_Procedure
243
244 { MethodType=Property Visibility=Private }
245 Function WinCombo_Current_Item Returns Integer
246 Function_Return (SendMessage(Window_Handle(self), CB_GETCURSEL,0,0))
247 End_Function
248
249 { MethodType=Property Visibility=Private }
250 Function WinCombo_Value Integer item# Returns String
251 string sValue
252 Pointer lpsValue pVoid
253 Pad sValue To sValue 255
254 GetAddress of sValue To lpsValue
255 Send Windows_Message CB_GETLBTEXT item# lpsValue
256 If (Oem_Translate_State(self)) ;
257 Move (AnsiToOem(lpsValue, lpsValue)) To pVoid // covert back to OEM
258 Function_Return (CString(sValue))
259 End_Function
260
261 Function Validate_Combo_Value returns integer
262 string val
263 integer ival
264 Get value item 0 to val
265 Move ( (Val='' AND allow_Blank_state(self) ) OR ;
266 (Combo_item_matching(self,Val)>=0) ) to ival
267 function_return (not(ival)) // 1=bad, 0=ok
268 End_function
269
270 { MethodType=Event }
271 Procedure OnDropDown // cancelled
272 End_Procedure
273
274 { MethodType=Event }
275 Procedure OnCloseUp // cancelled
276 End_Procedure
277
278 Procedure Add_Form_To_List
279 String Val
280 String itm
281 Get Value item 0 to Val
282 Get Combo_Item_matching Val to itm
283 if itm eq -1 Send Combo_Add_Item Val
284 End_Procedure
285
286 { MethodType=Event }
287 Procedure Combo_Fill_List
288 End_Procedure
289
290 { Visibility=Private }
291 Procedure combo_initialize_list
292 if (Combo_Item_count(self)=0) ;
293 Send Combo_fill_list
294 End_Procedure // combo_initialize_list
295
296 { Visibility=Private }
297 Procedure End_Define_Combo_Mixin
298 integer Sz
299 Get Size to Sz
300 If (Hi(Sz)<20) Set Size to 100 (Low(Sz))
301 Send Locate_Label
302 End_Procedure
303
304 { MethodType=Property Nodoc=True }
305 Procedure Set Value Integer iItem String sValue
306 integer ComboItem#
307 If (Window_Handle(self) AND Entry_State(self,0)=0) Begin
308 Get WinCombo_Item_Matching sValue To ComboItem#
309 If ComboItem# eq -1 Begin // not found
310 Get Default_Combo_Item to ComboItem#
311 If ComboItem# eq -1 Begin // -1 means top of list
312 Get WinCombo_Value item 0 to sValue
313 Move 0 to ComboItem#
314 End
315 Else Begin
316 Get Combo_Value item ComboItem# to sValue
317 Get WinCombo_Item_Matching sValue To ComboItem#
318 End
319 End
320 Forward Set value item iItem to sValue
321 If ComboItem# ge 0 ;
322 Set WinCombo_Current_Item To ComboItem#
323 // set value is called during add-focus (when entry_state is false) we
324 // will not consider this a change condition. Skip sending onChange
325 if (pbPrivateAddingFocus(self)) procedure_return
326 End
327 Else ;
328 Forward Set value item iItem to sValue
329 Send onChange // When value changes, we call onChange
330 End_Procedure // set value
331
332 { NoDoc=True }
333 Procedure Add_Focus Handle hoParent Returns Integer
334 boolean bOld
335 Forward Send Add_Focus hoParent
336 If not (Entry_State(self,0)) begin
337 // if setting value during add-focus set flag to tell set value that this is a special case
338 // JJT: This was done in this manner to have minimum impact on pre 8.2 behaviors.
339 get pbPrivateAddingFocus to bOld
340 set pbPrivateAddingFocus to True
341 Set Value Item 0 to (value(self,0))
342 set pbPrivateAddingFocus to bOld
343 end
344 End_Procedure
345
346 { Visibility=Private }
347 Procedure DoSetListWidth
348 Integer iListWidth // required width of drop-down list
349
350 Get ListWidth to iListWidth
351 If (iListWidth <> 0) Begin
352 Send Windows_Message CB_SETDROPPEDWIDTH iListWidth 0
353 End
354 End_Procedure
355
356 { Visibility=Private }
357 Procedure DoSetSize
358 Integer cyEdit // height of edit control
359 Integer cyListItem // height of each item in the drop-down list
360 Integer icRow // integer count of visible rows
361 Integer cyControl // height of complete control
362 Integer cxControl // width of control
363
364 Get ListRowCount to icRow // how many rows are required
365 If (icRow <>0) Begin
366 // get height of edit portion
367 Get WindowsMessage CB_GETITEMHEIGHT -1 0 to cyEdit
368
369 // get height of single item in list
370 Get WindowsMessage CB_GETITEMHEIGHT 0 0 to cyListItem
371
372 // calculate required height
373 Move (cyEdit +8 +(cyListItem *icRow)) to cyControl // 8 is the empirical height of 3d effects
374
375 // retain width from initial settings
376 Move (Low(GuiSize(self))) to cxControl
377
378 Set GuiSize to cyControl cxControl
379 End
380
381 End_Procedure
382
383 // The following three messages are designed to handle accelerator key
384 // handling when a list is dropped down. When a list is dropped, we want all
385 // accelerator keys to be ignored. In addition, we want the return and enter
386 // keys to roll the list up, if return is pressed the value should be updated
387
388 // Called by key and Process_Accelerator when a list is dropped down and a
389 // key is pressed. We pass the virtual key (not the df key) and a flag telling
390 // us if this is an accelerator key (Tells us where it was called from)
391 // Return: True if you, want to stop any other actions.
392 // Currently this looks for return and escape.
393 //
394 { MethodType=Event }
395 Function OnDropKey integer iVKey boolean bIsAccelerator returns boolean
396 integer i iItem
397 If (iVKey=vk_escape or iVKey=vk_return) begin
398 if (iVKey=vk_return) Begin
399 // this forces the form value to get updated with the list's current value
400 Get WinCombo_Current_item to iItem // current value in the list
401 Get WindowsMessage CB_SHOWDROPDOWN 0 0 to i // roll up list
402 Set WinCombo_Current_item to iItem // make sure form has new value
403 send Combo_Item_Changed // list changed event
404 end
405 else ; // if escape, just roll up list
406 Get WindowsMessage CB_SHOWDROPDOWN 0 0 to i // roll up list
407 function_return true // if ret or esc, we are done processing
408 end
409 // if accel, we want to do nothing at all.
410 function_return bIsAccelerator // we want to always ignore accelerator keys.
411 end_Procedure
412
413 // note that we must test for both process_accelerator and Key because we
414 // don't know if a key (e.g. esc=kCancel) has been assigned to on On_key or
415 // not. If an on_key, process_accelerator is called, else Key is called
416
417 // augment to check for keys pressed in dropped state. Most likely, when dropped
418 // we will trap esc and return and ignore all others
419 //
420 { Visibility=Private }
421 Procedure Process_Accelerator integer i1 integer i2
422 integer bDropped iVKey bDone
423 Get WindowsMessage CB_GETDROPPEDSTATE 0 0 to bDropped
424 if bDropped begin // if dropped we probably ignore all acc keys
425 get ansiKey to iVKey // get the last virtual key
426 Get OnDropKey iVKey true to bDone
427 end
428 if not bDone ;
429 forward send process_accelerator i1 i2
430 End_Procedure
431
432 // augment to check for keys pressed in dropped state. Most likely, when dropped
433 // we will trap esc and return and pass all others through
434 //
435 { MethodType=Event Visibility=Private }
436 procedure Key integer iKy returns integer
437 integer bDropped iVKey
438 boolean bDone
439 Get WindowsMessage CB_GETDROPPEDSTATE 0 0 to bDropped
440 if bDropped begin // if dropped we may ignore the key
441 get ansiKey to iVKey // get the last virtual key
442 Get OnDropKey iVKey false to bDone
443 end
444 if not bDone ;
445 forward send key iKy
446 end_procedure
447end_class
448