Module Dd_pklst.pkg
1//****************************************************************************//
2// //
3// $File name : dd_pklst.pkg //
4// $File title : //
5// Notice : //
6// $System : Data Dictionary //
7// Created : 05/28/96 08:32 am //
8// $Last Rev : 05/28/96 08:32 am //
9// //
10// $Description //
11// Mixin class for Validation pick lists. Can be used by both Character mode //
12// and DF (GUI) classes. //
13// //
14// $Rev History //
15//JT 05/28/96 Created //
16// //
17//****************************************************************************//
18Use cRowIdArray.pkg
19#IFDEF CD_Code_Display_Code
20#ELSE
21
22Enum_List
23 Define CD_Code_Display_Code
24 Define CD_Code_Display_Description
25 Define CD_Code_Display_Both
26End_Enum_List
27
28#ENDIF
29
30Register_Function Item_Field_Property Integer iMsg Integer iItem Returns String
31
32//
33{ Visibility=Private ClassType=Mixin }
34Class Validation_List_Mixin is a mixin
35
36 { Visibility=Private }
37 Procedure Define_Validation_List_Mixin
38 Property Integer Sort_State True
39 { EnumList="CD_Code_Display_Code, CD_Code_Display_Description, CD_Code_Display_Both" }
40 { Category=Behavior }
41 Property Integer Code_Display_Mode -1
42 Property Integer Working_Code_Display_Mode 0
43 Property Integer Code_Length -1 // figure it out yourself!
44 Property Integer Working_Code_Length 0 // will get calculated
45 { PropertyType=Boolean }
46 Property Integer Static_State False
47 Property Integer Relational_State False
48 Property Integer Current_Server 0
49 Property Integer Current_File 0
50 Property Integer Current_Field 0
51
52 Object oEntryValues is an Array
53 End_Object
54
55 Object oRowIds Is A cRowIdArray
56 End_Object
57
58 Set entry_msg to 0
59 Set Search_Mode to Incremental
60 End_Procedure
61
62 Procedure Set Entry_Value Integer Itm String Val
63 Set Value of oEntryValues Itm to Val
64 End_Procedure
65
66 Function Entry_Value Integer Itm Returns String
67 string sValue
68 Get Value of oEntryValues Itm to sValue
69 Function_Return sValue
70 End_Function
71
72 Procedure Set RowId_Value Integer Itm RowId riId
73 Set RowId_Value of oRowIds Itm to riId
74 End_Procedure
75
76 Function RowId_Value Integer Itm Returns RowID
77 RowID riId
78 Get RowId_Value of oRowIds Itm to riId
79 Function_Return riId
80 End_Function
81
82
83
84// Procedure Set Record_Value Integer Itm Integer Rec
85// Set Value of (EV(Self)) Item (Itm*2+1) to Rec
86// End_Procedure
87
88// Function Record_Value Integer Itm Returns Integer
89// Integer iRec
90// Get Value of (EV(Self)) Item (Itm*2+1) to iRec
91// Function_Return iRec
92// End_Function
93
94 //
95 // Do not use this. Augment Code_Description_Value instead.
96 // This is created so GUI picklists can augment this at the Client level
97 // making this an augmentable procedure.
98 //
99 Function Private.Code_Description_Value String DescVal String DataVal returns string
100 Integer Mode iLen
101 Get Working_Code_Display_Mode to mode
102 If mode ne CD_CODE_DISPLAY_DESCRIPTION Begin
103 Get Working_Code_Length to iLen
104 if iLen ;
105 Move ( left(Dataval+repeat(" ",iLen),iLen) ) to DataVal
106 If mode eq CD_CODE_DISPLAY_CODE ;
107 Move DataVal to DescVal
108 Else ; // mode eq CD_CODE_DISPLAY_BOTH
109 Move (DataVal * "-" * DescVal) to DescVal
110 End
111 Function_Return DescVal
112 End_Function // Code_Description_Value
113
114 //
115 // Augmentation point to support various description/data Display formats.
116 //
117 Function Code_Description_Value String DescVal String DataVal returns string
118 Function_Return (Private.Code_Description_Value(Self, DescVal, DataVal))
119 End_Function // Code_Description_Value
120
121
122 // Message to add Items to a list. Similar to Add_Item except
123 // it handles an optional second parameter. If no 2nd param the first
124 // is used in its place. This will normally be used inside of Fill_List.
125 //
126 // Send Code_add_Item Descr_Value {Data_Value}
127 //
128 Procedure Code_Add_Item String Descr_value String Data_Value RowId riRec
129 String dVal
130 Integer itm
131 // If one param passed use it for both display and database values
132 If num_arguments le 1 Move Descr_Value to dVal
133 Else Move Data_Value to dVal
134 Get item_count to itm // get this before we add the item.
135 // this lets us convert the description. By default it returns the
136 // value passed. This allows you to pass a data param that gets
137 // changed for display purposes.
138 If (Working_Code_Display_Mode(Self)=CD_CODE_DISPLAY_CODE) ;
139 Move dVal to Descr_Value
140 Else ;
141 Get Code_Description_Value Descr_Value dVal to Descr_Value
142 Send Add_Item msg_none Descr_Value // used by the display list
143 Set Aux_Value itm to itm // back pointer to entry array (if sorted)
144 Set Entry_Value itm to dVal // the actual data value
145 Set RowId_Value itm to riRec // the rowid
146 End_Procedure
147
148 Procedure Fill_Item integer iItem string sValue string sDescription ;
149 integer iFile rowId riRec
150 If sDescription eq '' Move sValue to sDescription
151 Send Code_Add_Item sDescription sValue riRec // first may get altered
152 End_Procedure
153
154 Function Find_Code_Display_Mode integer iInvObj integer iDsplyMode returns integer
155 integer iFile
156 integer iField
157 integer iObj
158
159 If iDsplyMode eq -1 begin // figure it out yourself
160 Move CD_Code_Display_Code to iDsplyMode // default
161 If iInvObj Begin
162 Get Data_File of iInvObj to iFile
163 Get Data_Field of iInvObj to iField
164 If iFile Begin
165 Get Item_Field_Property of iInvObj GET_File_Field_Table_Object CURRENT to iObj
166 If iObj Begin
167 If (Number_Elements(iObj)=1) ;
168 Move CD_Code_Display_Code to iDsplyMode
169 Else ;
170 Move CD_Code_Display_Both to iDsplyMode
171 End
172 End
173 End
174 End
175 Function_Return iDsplyMode
176 End_Function
177
178 // Fills the list by loading the entire defined data-file
179 //
180 Procedure Fill_List
181 integer iFile
182 integer iField
183 integer iSrvr
184 integer iValFile
185 integer iObj
186 integer iInvObj
187 integer iLen
188 integer iMode
189
190 get Invoking_Object_ID to iInvObj
191 If iInvObj Begin
192 Get Server of iInvObj to iSrvr
193 Get Data_File of iInvObj to iFile
194 Get Data_Field of iInvObj to iField
195 Get Code_Length to iLen
196 if iLen eq -1 Begin // if we must calculate length from inv obj
197 If (iSrvr AND iFile) ;
198 Get_Attribute DF_Field_Length of iFile iField to iLen
199 //Else ;
200 // Get Form_Margin of iInvobj item CURRENT to iLen
201 End
202 Set Working_Code_Length to iLen
203
204 Get Find_Code_Display_Mode iInvObj (Code_Display_Mode(Self)) to iMode
205 Set Working_Code_Display_Mode to iMode
206
207 If (iSrvr AND iFile) Begin
208 Set Current_Server to iSrvr
209 Set Current_File to iFile
210 Set Current_Field to iField
211 Get Item_Field_Property of iInvObj GET_File_Field_Table_Object CURRENT to iObj
212 If iObj ;
213 Get Main_File of iObj to iValFile
214 Set Relational_State to (iFile<>0 AND iValFile=iFile)
215 Send File_Field_Fill_List to iSrvr iFile iField self msg_Fill_Item
216 If (Sort_State(Self)) Send Sort_Items ascending
217 End
218 End
219 End_Procedure
220
221 Procedure Delete_Data
222 integer iObj
223 Forward Send Delete_Data
224 Move oEntryValues to iObj
225 If iObj Send Delete_Data to iObj
226 End_Procedure // Delete_Data
227
228 Procedure Initialize_List
229 if (Static_State(Self)=0 OR ;
230 Item_Count(Self)=0) Begin
231 Send Delete_Data
232 Send Fill_List
233 End
234 Send Seed_List
235 End_Procedure // Initialize_List
236
237 // Pass Code value and return its position from the entry array. This may
238 // not be the same order as the actual picklist items (the pick list may
239 // be sorted).
240 Function Find_Entry_Value string sVal returns integer
241 integer iObj iCnt iItms
242 Get Item_Count to iItms
243 Decrement iItms
244 For iCnt from 0 to iItms
245 If (sVal=Entry_Value(Self,iCnt)) ;
246 Function_return iCnt
247 Loop
248 Function_Return -1
249 end_function
250
251 // We know what the item is in our data-list. Find its location in the
252 // picklist. This is only an issue if the list is sorted.
253 Function Data_Position integer iItm returns integer
254 integer iCnt iItms
255 If (sort_state(Self)) Begin
256 Get Item_Count to iItms
257 Decrement iItms
258 For iCnt from 0 to iItms
259 // we have a match when the item equals the aux_value
260 If (iItm=Aux_Value(Self,iCnt)) ;
261 Function_return iCnt
262 Loop
263 Function_Return 0
264 end
265 Else Function_Return iItm
266 End_function
267
268 Procedure Seed_List
269 integer iObj itm#
270 string sVal
271 Get invoking_Object_id to iObj
272 If iObj Begin
273 Get value of iObj item CURRENT to sVal
274 If sVal ne '' Begin
275 Get Find_Entry_Value sVal to itm#
276 If itm# ge 0 ;
277 Set current_item to (Data_position(Self,itm#))
278 End
279 End
280 End_procedure
281
282 Procedure Move_Value_Out
283 integer iItem iFile iField
284 Handle hoSrvr
285 RowId riId
286 string sVal
287 if (Export_Item_State(Self)) begin
288 If (Select_Mode(Self)=No_Select) ;
289 Get current_Item to iItem
290 Else ;
291 Get first_selected_item to iItem
292 Get Aux_value iItem to iItem // actual position in array
293 Get Current_Server to hoSrvr
294 If hoSrvr Begin
295 Get Current_file to iFile
296 If (Relational_State(Self)) Begin
297 get rowId_value iItem to riId
298 If (not(isNullRowId(riId))) begin
299 Send FindByrowId of hoSrvr iFile riId
300 end
301 End
302 Else Begin
303 get entry_value iItem to sVal
304 Get Current_field to iField
305 set File_Field_changed_Value of hoSrvr iFile iField to sVal
306 End
307 End
308 End
309 End_Procedure
310
311End_Class
312