1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
6 &Scoped-define WINDOW-NAME CURRENT-WINDOW
7 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS B-table-Win
8 /*------------------------------------------------------------------------
12 Description
: from BROWSER.W
- Basic SmartBrowser Object Template
20 ------------------------------------------------------------------------*/
21 /* This .W file was created with the Progress UIB.
*/
22 /*----------------------------------------------------------------------*/
24 /* Create an unnamed pool to store all the widgets created
25 by this procedure. This is a good default which assures
26 that this procedure's triggers and internal procedures
27 will execute in this procedure's storage
, and that proper
28 cleanup will occur on deletion of the procedure.
*/
32 /* *************************** Definitions
************************** */
34 /* Parameters Definitions
--- */
36 /* Local Variable Definitions
--- */
38 /* _UIB-CODE-BLOCK-END
*/
42 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
44 /* ******************** Preprocessor Definitions
******************** */
46 &Scoped-define PROCEDURE-TYPE SmartBrowser
48 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
50 /* Name of first Frame and
/or Browse and
/or first Query
*/
51 &Scoped-define FRAME-NAME F-Main
52 &Scoped-define BROWSE-NAME br_table
54 /* Internal Tables
(found by Frame
, Query
& Browse Queries) */
55 &Scoped-define INTERNAL-TABLES AssetType
57 /* Define KEY-PHRASE in case it is used by any query.
*/
58 &Scoped-define KEY-PHRASE TRUE
60 /* Definitions for
BROWSE br_table
*/
61 &Scoped-define FIELDS-IN-QUERY-br_table AssetType.AssetType ~
62 AssetType.Description AssetType.AccountCode AssetType.DepreciationRate ~
63 AssetType.DepreciationStyle
64 &Scoped-define ENABLED-FIELDS-IN-QUERY-br_table AssetType.AssetType ~
65 AssetType.Description AssetType.AccountCode AssetType.DepreciationRate ~
66 AssetType.DepreciationStyle
67 &Scoped-define FIELD-PAIRS-IN-QUERY-br_table~
68 ~
{&FP1}AssetType ~{&FP2}AssetType ~{&FP3}~
69 ~
{&FP1}Description ~{&FP2}Description ~{&FP3}~
70 ~
{&FP1}AccountCode ~{&FP2}AccountCode ~{&FP3}~
71 ~
{&FP1}DepreciationRate ~{&FP2}DepreciationRate ~{&FP3}~
72 ~
{&FP1}DepreciationStyle ~{&FP2}DepreciationStyle ~{&FP3}
73 &Scoped-define ENABLED-TABLES-IN-QUERY-br_table AssetType
74 &Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-br_table AssetType
75 &Scoped-define OPEN-QUERY-br_table OPEN QUERY br_table FOR EACH AssetType WHERE ~{&KEY-PHRASE} NO-LOCK ~
77 &Scoped-define TABLES-IN-QUERY-br_table AssetType
78 &Scoped-define FIRST-TABLE-IN-QUERY-br_table AssetType
81 /* Definitions for
FRAME F-Main
*/
83 /* Standard List Definitions
*/
84 &Scoped-Define ENABLED-OBJECTS br_table
86 /* Custom List Definitions
*/
87 /* List-1
,List-2
,List-3
,List-4
,List-5
,List-6
*/
89 /* _UIB-PREPROCESSOR-BLOCK-END
*/
93 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" B-table-Win _INLINE
94 /* Actions
: ? adm
/support
/keyedit.w ? ? ?
*/
102 **************************
103 * Set attributes related to FOREIGN
KEYS
105 RUN set-attribute-list
(
107 Keys-Supplied
= ""'
:U
).
108 /**************************
111 /* _UIB-CODE-BLOCK-END
*/
114 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Advanced Query Options" B-table-Win _INLINE
115 /* Actions
: ? adm
/support
/advqedit.w ? ? ?
*/
123 ************************
124 * Set attributes related to SORTBY-OPTIONS
*/
125 RUN set-attribute-list
(
126 'SortBy-Options
= ""'
:U
).
127 /************************
130 </FILTER-ATTRIBUTES
> */
132 /* _UIB-CODE-BLOCK-END
*/
136 /* *********************** Control Definitions
********************** */
139 /* Definitions of the field level widgets
*/
140 /* Query definitions
*/
142 DEFINE QUERY br_table
FOR
146 /* Browse definitions
*/
147 DEFINE BROWSE br_table
148 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS br_table B-table-Win _STRUCTURED
149 QUERY br_table
NO-LOCK DISPLAY
151 AssetType.Description
152 AssetType.AccountCode
153 AssetType.DepreciationRate
COLUMN-LABEL "Depn. Rate"
154 AssetType.DepreciationStyle
COLUMN-LABEL "Depn. Style"
157 AssetType.Description
158 AssetType.AccountCode
159 AssetType.DepreciationRate
160 AssetType.DepreciationStyle
161 /* _UIB-CODE-BLOCK-END
*/
163 WITH NO-ASSIGN SEPARATORS SIZE 76.57 BY 12.8
167 /* ************************ Frame Definitions
*********************** */
170 br_table
AT ROW 1 COL 1
171 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
172 SIDE-LABELS NO-UNDERLINE THREE-D
173 AT COL 1 ROW 1 SCROLLABLE
174 BGCOLOR 8 FGCOLOR 0 .
177 /* *********************** Procedure Settings
************************ */
179 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
180 /* Settings for
THIS-PROCEDURE
184 Add Fields to
: EXTERNAL-TABLES
185 Other Settings
: PERSISTENT-ONLY
COMPILE
188 /* This procedure should always be
RUN PERSISTENT. Report the error
, */
189 /* then cleanup and return.
*/
190 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
191 MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
192 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
196 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
198 /* ************************* Create Window
************************** */
200 &ANALYZE-SUSPEND _CREATE-WINDOW
201 /* DESIGN Window definition
(used by the UIB
)
202 CREATE WINDOW B-table-Win
ASSIGN
205 /* END WINDOW DEFINITION
*/
210 /* *************** Runtime Attributes and UIB Settings
************** */
212 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
213 /* SETTINGS
FOR WINDOW B-table-Win
214 NOT-VISIBLE
,,RUN-PERSISTENT
*/
215 /* SETTINGS
FOR FRAME F-Main
216 NOT-VISIBLE Size-to-Fit
*/
217 /* BROWSE-TAB br_table
1 F-Main
*/
219 FRAME F-Main
:SCROLLABLE = FALSE
220 FRAME F-Main
:HIDDEN = TRUE.
222 /* _RUN-TIME-ATTRIBUTES-END
*/
226 /* Setting information for Queries and Browse Widgets fields
*/
228 &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE br_table
229 /* Query rebuild information for
BROWSE br_table
230 _TblList
= "TTPL.AssetType"
231 _Options
= "NO-LOCK KEY-PHRASE SORTBY-PHRASE"
232 _FldNameList
[1] > TTPL.AssetType.AssetType
233 "AssetType" ? ?
"character" ? ? ? ? ? ? yes ?
234 _FldNameList
[2] > TTPL.AssetType.Description
235 "Description" ? ?
"character" ? ? ? ? ? ? yes ?
236 _FldNameList
[3] > TTPL.AssetType.AccountCode
237 "AccountCode" ? ?
"decimal" ? ? ? ? ? ? yes ?
238 _FldNameList
[4] > TTPL.AssetType.DepreciationRate
239 "DepreciationRate" "Depn. Rate" ?
"decimal" ? ? ? ? ? ? yes ?
240 _FldNameList
[5] > TTPL.AssetType.DepreciationStyle
241 "DepreciationStyle" "Depn. Style" ?
"character" ? ? ? ? ? ? yes ?
243 */ /* BROWSE br_table
*/
246 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
247 /* Query rebuild information for
FRAME F-Main
250 */ /* FRAME F-Main
*/
256 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB B-table-Win
257 /* ************************* Included-Libraries
*********************** */
259 {src
/adm
/method
/browser.i
}
260 {inc
/method
/m-drlvwr.i
}
262 /* _UIB-CODE-BLOCK-END
*/
268 /* ************************ Control Triggers
************************ */
270 &Scoped-define BROWSE-NAME br_table
271 &Scoped-define SELF-NAME br_table
272 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
273 ON ROW-ENTRY
OF br_table
IN FRAME F-Main
275 /* This code displays initial values for newly added or copied rows.
*/
276 {src
/adm
/template
/brsentry.i
}
279 /* _UIB-CODE-BLOCK-END
*/
283 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
284 ON ROW-LEAVE
OF br_table
IN FRAME F-Main
286 /* Do not disable this code or no updates will take place except
287 by pressing the Save button on an Update SmartPanel.
*/
288 {src
/adm
/template
/brsleave.i
}
291 /* _UIB-CODE-BLOCK-END
*/
295 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
296 ON VALUE-CHANGED
OF br_table
IN FRAME F-Main
298 /* This ADM trigger code must be preserved in order to notify other
299 objects when the browser's current row changes.
*/
300 {src
/adm
/template
/brschnge.i
}
303 /* _UIB-CODE-BLOCK-END
*/
309 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK B-table-Win
312 /* *************************** Main Block
*************************** */
314 &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
315 RUN dispatch
IN THIS-PROCEDURE ('initialize'
:U
).
318 /* _UIB-CODE-BLOCK-END
*/
322 /* ********************** Internal Procedures
*********************** */
324 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available B-table-Win _ADM-ROW-AVAILABLE
325 PROCEDURE adm-row-available
:
326 /*------------------------------------------------------------------------------
327 Purpose
: Dispatched to this procedure when the Record-
328 Source has a new row available. This procedure
329 tries to get the new row
(or foriegn keys
) from
330 the Record-Source and process it.
332 ------------------------------------------------------------------------------*/
334 /* Define variables needed by this internal procedure.
*/
335 {src
/adm
/template
/row-head.i
}
337 /* Process the newly available records
(i.e. display fields
,
338 open queries
, and
/or pass records on to any RECORD-TARGETS
).
*/
339 {src
/adm
/template
/row-end.i
}
343 /* _UIB-CODE-BLOCK-END
*/
347 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI B-table-Win _DEFAULT-DISABLE
348 PROCEDURE disable_UI
:
349 /*------------------------------------------------------------------------------
350 Purpose
: DISABLE the User Interface
352 Notes
: Here we clean-up the user-interface by deleting
353 dynamic widgets we have created and
/or hide
354 frames. This procedure is usually called when
355 we are ready to
"clean-up" after running.
356 ------------------------------------------------------------------------------*/
357 /* Hide all frames.
*/
359 IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
362 /* _UIB-CODE-BLOCK-END
*/
366 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records B-table-Win _ADM-SEND-RECORDS
367 PROCEDURE send-records
:
368 /*------------------------------------------------------------------------------
369 Purpose
: Send record
ROWID's for all tables used by
371 Parameters
: see template
/snd-head.i
372 ------------------------------------------------------------------------------*/
374 /* Define variables needed by this internal procedure.
*/
375 {src
/adm
/template
/snd-head.i
}
377 /* For each requested table
, put it's
ROWID in the output list.
*/
378 {src
/adm
/template
/snd-list.i
"AssetType"}
380 /* Deal with any unexpected table requests before closing.
*/
381 {src
/adm
/template
/snd-end.i
}
385 /* _UIB-CODE-BLOCK-END
*/
389 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed B-table-Win
390 PROCEDURE state-changed
:
391 /* -----------------------------------------------------------
395 -------------------------------------------------------------*/
396 DEFINE INPUT PARAMETER p-issuer-hdl
AS HANDLE NO-UNDO.
397 DEFINE INPUT PARAMETER p-state
AS CHARACTER NO-UNDO.
400 /* Object instance CASEs can go here to replace standard behavior
402 {src
/adm
/template
/bstates.i
}
406 /* _UIB-CODE-BLOCK-END
*/