1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
6 &Scoped-define WINDOW-NAME CURRENT-WINDOW
7 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS V-table-Win
8 /*------------------------------------------------------------------------
12 Description
: from VIEWER.W
- Template for SmartViewer Objects
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 DEF VAR mode
AS CHAR NO-UNDO.
40 /* _UIB-CODE-BLOCK-END
*/
44 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
46 /* ******************** Preprocessor Definitions
******************** */
48 &Scoped-define PROCEDURE-TYPE SmartViewer
50 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
52 /* Name of first Frame and
/or Browse and
/or first Query
*/
53 &Scoped-define FRAME-NAME F-Main
56 &Scoped-define EXTERNAL-TABLES Usr
57 &Scoped-define FIRST-EXTERNAL-TABLE Usr
60 /* Need to scope the external tables to this procedure
*/
61 DEFINE QUERY external_tables
FOR Usr.
62 /* Standard List Definitions
*/
63 &Scoped-Define ENABLED-FIELDS Usr.UserName Usr.Abbreviation
64 &Scoped-define FIELD-PAIRS~
65 ~
{&FP1}UserName ~{&FP2}UserName ~{&FP3}~
66 ~
{&FP1}Abbreviation ~{&FP2}Abbreviation ~{&FP3}
67 &Scoped-define ENABLED-TABLES Usr
68 &Scoped-define FIRST-ENABLED-TABLE Usr
69 &Scoped-Define ENABLED-OBJECTS RECT-1
70 &Scoped-Define DISPLAYED-FIELDS Usr.UserName Usr.Abbreviation
71 &Scoped-Define DISPLAYED-OBJECTS fil_Person
73 /* Custom List Definitions
*/
74 /* ADM-CREATE-FIELDS
,ADM-ASSIGN-FIELDS
,List-3
,List-4
,List-5
,List-6
*/
76 /* _UIB-PREPROCESSOR-BLOCK-END
*/
80 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" V-table-Win _INLINE
81 /* Actions
: ? adm
/support
/keyedit.w ? ? ?
*/
87 PersonCode|y|y|TTPL.Usr.PersonCode
88 UserName|y|y|TTPL.Usr.UserName
91 **************************
92 * Set attributes related to FOREIGN
KEYS
94 RUN set-attribute-list
(
95 'Keys-Accepted
= "PersonCode,UserName",
96 Keys-Supplied
= "PersonCode,UserName"'
:U
).
97 /**************************
99 /* _UIB-CODE-BLOCK-END
*/
103 /* *********************** Control Definitions
********************** */
106 /* Definitions of the field level widgets
*/
107 DEFINE VARIABLE fil_Person
AS CHARACTER FORMAT "X(256)":U
110 SIZE 33.14 BY 1 NO-UNDO.
112 DEFINE RECTANGLE RECT-1
113 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
117 /* ************************ Frame Definitions
*********************** */
120 Usr.UserName
AT ROW 1.4 COL 12.14 COLON-ALIGNED
121 LABEL "Network User ID" FORMAT "X(64)"
124 Usr.Abbreviation
AT ROW 2.8 COL 12.14 COLON-ALIGNED
127 fil_Person
AT ROW 3.8 COL 12.14 COLON-ALIGNED
128 RECT-1
AT ROW 1 COL 1
129 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
130 SIDE-LABELS NO-UNDERLINE THREE-D
131 AT COL 1 ROW 1 SCROLLABLE
135 /* *********************** Procedure Settings
************************ */
137 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
138 /* Settings for
THIS-PROCEDURE
140 External Tables
: TTPL.Usr
141 Allow
: Basic
,DB-Fields
143 Add Fields to
: EXTERNAL-TABLES
144 Other Settings
: PERSISTENT-ONLY
COMPILE
147 /* This procedure should always be
RUN PERSISTENT. Report the error
, */
148 /* then cleanup and return.
*/
149 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
150 MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
151 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
155 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
157 /* ************************* Create Window
************************** */
159 &ANALYZE-SUSPEND _CREATE-WINDOW
160 /* DESIGN Window definition
(used by the UIB
)
161 CREATE WINDOW V-table-Win
ASSIGN
164 /* END WINDOW DEFINITION
*/
169 /* *************** Runtime Attributes and UIB Settings
************** */
171 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
172 /* SETTINGS
FOR WINDOW V-table-Win
173 VISIBLE,,RUN-PERSISTENT
*/
174 /* SETTINGS
FOR FRAME F-Main
175 NOT-VISIBLE Size-to-Fit
*/
177 FRAME F-Main
:SCROLLABLE = FALSE
178 FRAME F-Main
:HIDDEN = TRUE.
180 /* SETTINGS
FOR FILL-IN fil_Person
IN FRAME F-Main
182 /* SETTINGS
FOR FILL-IN Usr.UserName
IN FRAME F-Main
183 EXP-LABEL EXP-FORMAT
*/
184 /* _RUN-TIME-ATTRIBUTES-END
*/
188 /* Setting information for Queries and Browse Widgets fields
*/
190 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
191 /* Query rebuild information for
FRAME F-Main
194 */ /* FRAME F-Main
*/
200 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB V-table-Win
201 /* ************************* Included-Libraries
*********************** */
203 {src
/adm
/method
/viewer.i
}
204 {inc
/method
/m-mntvwr.i
}
206 /* _UIB-CODE-BLOCK-END
*/
212 /* ************************ Control Triggers
************************ */
214 &Scoped-define SELF-NAME fil_Person
215 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fil_Person V-table-Win
216 ON U1
OF fil_Person
IN FRAME F-Main
/* Person
*/
218 {inc
/selfil
/sfpsn1.i
"Usr" "PersonCode"}
221 /* _UIB-CODE-BLOCK-END
*/
225 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fil_Person V-table-Win
226 ON U2
OF fil_Person
IN FRAME F-Main
/* Person
*/
228 {inc
/selfil
/sfpsn2.i
"Usr" "PersonCode"}
231 /* _UIB-CODE-BLOCK-END
*/
235 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fil_Person V-table-Win
236 ON U3
OF fil_Person
IN FRAME F-Main
/* Person
*/
238 {inc
/selfil
/sfpsn3.i
"Usr" "PersonCode"}
241 /* _UIB-CODE-BLOCK-END
*/
247 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK V-table-Win
250 /* *************************** Main Block
*************************** */
252 /* _UIB-CODE-BLOCK-END
*/
256 /* ********************** Internal Procedures
*********************** */
258 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-find-using-key V-table-Win adm/support/_key-fnd.p
259 PROCEDURE adm-find-using-key
:
260 /*------------------------------------------------------------------------------
261 Purpose
: Finds the current record using the contents of
262 the 'Key-Name' and 'Key-Value' attributes.
264 ------------------------------------------------------------------------------*/
265 DEF VAR key-value
AS CHAR NO-UNDO.
266 DEF VAR row-avail-enabled
AS LOGICAL NO-UNDO.
268 /* LOCK status on the find depends on FIELDS-ENABLED.
*/
269 RUN get-attribute
('FIELDS-ENABLED'
:U
).
270 row-avail-enabled
= (RETURN-VALUE eq 'yes'
:U
).
271 /* Look up the current key-value.
*/
272 RUN get-attribute
('Key-Value'
:U
).
273 key-value
= RETURN-VALUE.
275 /* Find the current record using the current Key-Name.
*/
276 RUN get-attribute
('Key-Name'
:U
).
278 WHEN 'PersonCode'
:U
THEN
279 {src
/adm
/template
/find-tbl.i
281 &WHERE = "WHERE Usr.PersonCode eq INTEGER(key-value)"
283 WHEN 'UserName'
:U
THEN
284 {src
/adm
/template
/find-tbl.i
286 &WHERE = "WHERE Usr.UserName eq key-value"
292 /* _UIB-CODE-BLOCK-END
*/
296 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available V-table-Win _ADM-ROW-AVAILABLE
297 PROCEDURE adm-row-available
:
298 /*------------------------------------------------------------------------------
299 Purpose
: Dispatched to this procedure when the Record-
300 Source has a new row available. This procedure
301 tries to get the new row
(or foriegn keys
) from
302 the Record-Source and process it.
304 ------------------------------------------------------------------------------*/
306 /* Define variables needed by this internal procedure.
*/
307 {src
/adm
/template
/row-head.i
}
309 /* Create a list of all the tables that we need to get.
*/
310 {src
/adm
/template
/row-list.i
"Usr"}
312 /* Get the record
ROWID's from the RECORD-SOURCE.
*/
313 {src
/adm
/template
/row-get.i
}
315 /* FIND each record specified by the RECORD-SOURCE.
*/
316 {src
/adm
/template
/row-find.i
"Usr"}
318 /* Process the newly available records
(i.e. display fields
,
319 open queries
, and
/or pass records on to any RECORD-TARGETS
).
*/
320 {src
/adm
/template
/row-end.i
}
324 /* _UIB-CODE-BLOCK-END
*/
328 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE cancel-changes V-table-Win
329 PROCEDURE cancel-changes
:
330 /*------------------------------------------------------------------------------
332 ------------------------------------------------------------------------------*/
334 IF mode
= "Add" THEN RUN delete-user.
ELSE RUN check-modified
( "CLEAR" ).
335 RUN dispatch
( 'exit'
:U
).
339 /* _UIB-CODE-BLOCK-END
*/
343 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE confirm-changes V-table-Win
344 PROCEDURE confirm-changes
:
345 /*------------------------------------------------------------------------------
349 ------------------------------------------------------------------------------*/
352 IF RETURN-VALUE = "FAIL" THEN RETURN.
354 RUN dispatch
( 'update-record'
:U
).
356 RUN notify
( 'open-query
, RECORD-SOURCE'
:U
).
358 RUN notify
( 'row-display
, RECORD-SOURCE'
:U
).
360 RUN dispatch
( 'exit'
:U
).
364 /* _UIB-CODE-BLOCK-END
*/
368 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE delete-user V-table-Win
369 PROCEDURE delete-user
:
370 /*------------------------------------------------------------------------------
374 ------------------------------------------------------------------------------*/
376 FIND CURRENT Usr
EXCLUSIVE-LOCK NO-ERROR.
377 IF AVAILABLE Usr
THEN DELETE Usr.
381 /* _UIB-CODE-BLOCK-END
*/
385 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI V-table-Win _DEFAULT-DISABLE
386 PROCEDURE disable_UI
:
387 /*------------------------------------------------------------------------------
388 Purpose
: DISABLE the User Interface
390 Notes
: Here we clean-up the user-interface by deleting
391 dynamic widgets we have created and
/or hide
392 frames. This procedure is usually called when
393 we are ready to
"clean-up" after running.
394 ------------------------------------------------------------------------------*/
395 /* Hide all frames.
*/
397 IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
400 /* _UIB-CODE-BLOCK-END
*/
404 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-initialize V-table-Win
405 PROCEDURE inst-initialize
:
406 /*------------------------------------------------------------------------------
410 ------------------------------------------------------------------------------*/
415 RUN dispatch
( 'add-record'
:U
).
417 ELSE RUN dispatch
( 'enable-fields'
:U
).
421 /* _UIB-CODE-BLOCK-END
*/
425 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE override-add-record V-table-Win
426 PROCEDURE override-add-record
:
427 /*------------------------------------------------------------------------------
431 ------------------------------------------------------------------------------*/
435 FIND UsrGroup
WHERE UsrGroup.GroupName
= "Everyone" NO-LOCK NO-ERROR.
437 IF AVAILABLE UsrGroup
THEN
439 CREATE UsrGroupMember.
441 UsrGroupMember.UserName
= Usr.UserName
442 UsrGroupMember.Groupname
= UsrGroup.GroupName.
445 CURRENT-WINDOW:TITLE = "Adding a new user".
446 RUN dispatch
( 'display-fields'
:U
).
447 RUN dispatch
( 'enable-fields'
:U
).
451 /* _UIB-CODE-BLOCK-END
*/
455 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-destroy V-table-Win
456 PROCEDURE pre-destroy
:
457 /*------------------------------------------------------------------------------
461 ------------------------------------------------------------------------------*/
463 IF LAST-EVENT:FUNCTION = "WINDOW-CLOSE" THEN RUN cancel-changes.
467 /* _UIB-CODE-BLOCK-END
*/
471 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-key V-table-Win adm/support/_key-snd.p
473 /*------------------------------------------------------------------------------
474 Purpose
: Sends a requested
KEY value back to the calling
476 Parameters
: <see adm
/template
/sndkytop.i
>
477 ------------------------------------------------------------------------------*/
479 /* Define variables needed by this internal procedure.
*/
480 {src
/adm
/template
/sndkytop.i
}
482 /* Return the key value associated with each key case.
*/
483 {src
/adm
/template
/sndkycas.i
"PersonCode" "Usr" "PersonCode"}
484 {src
/adm
/template
/sndkycas.i
"UserName" "Usr" "UserName"}
486 /* Close the
CASE statement and end the procedure.
*/
487 {src
/adm
/template
/sndkyend.i
}
491 /* _UIB-CODE-BLOCK-END
*/
495 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records V-table-Win _ADM-SEND-RECORDS
496 PROCEDURE send-records
:
497 /*------------------------------------------------------------------------------
498 Purpose
: Send record
ROWID's for all tables used by
500 Parameters
: see template
/snd-head.i
501 ------------------------------------------------------------------------------*/
503 /* Define variables needed by this internal procedure.
*/
504 {src
/adm
/template
/snd-head.i
}
506 /* For each requested table
, put it's
ROWID in the output list.
*/
507 {src
/adm
/template
/snd-list.i
"Usr"}
509 /* Deal with any unexpected table requests before closing.
*/
510 {src
/adm
/template
/snd-end.i
}
514 /* _UIB-CODE-BLOCK-END
*/
518 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed V-table-Win
519 PROCEDURE state-changed
:
520 /* -----------------------------------------------------------
524 -------------------------------------------------------------*/
525 DEFINE INPUT PARAMETER p-issuer-hdl
AS HANDLE NO-UNDO.
526 DEFINE INPUT PARAMETER p-state
AS CHARACTER NO-UNDO.
529 /* Object instance CASEs can go here to replace standard behavior
531 {src
/adm
/template
/vstates.i
}
535 /* _UIB-CODE-BLOCK-END
*/
539 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-mode V-table-Win
541 /*------------------------------------------------------------------------------
545 ------------------------------------------------------------------------------*/
546 DEF INPUT PARAMETER new-mode
AS CHAR NO-UNDO.
551 /* _UIB-CODE-BLOCK-END
*/
555 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE verify-user V-table-Win
556 PROCEDURE verify-user
:
557 /*------------------------------------------------------------------------------
561 ------------------------------------------------------------------------------*/
563 DO WITH FRAME {&FRAME-NAME}:
565 /* All details entered ?
*/
567 IF INPUT Usr.UserName
= "" OR INPUT Usr.Abbreviation
= "" OR
568 NOT CAN-FIND( FIRST Contact
WHERE ROWID( Contact
) =
569 TO-ROWID( fil_Person
:PRIVATE-DATA ) ) THEN
572 "You must supply all fields for a user:" SKIP(1)
576 VIEW-AS ALERT-BOX ERROR TITLE "Incomplete details".
577 IF INPUT Usr.UserName
= "" THEN APPLY '
ENTRY'
:U
TO Usr.UserName.
ELSE
578 IF INPUT Usr.Abbreviation
= "" THEN APPLY '
ENTRY'
:U
TO Usr.Abbreviation.
ELSE
580 APPLY '
ENTRY'
:U
TO Usr.Abbreviation.
581 APPLY 'TAB'
:U
TO Usr.Abbreviation.
586 /* User Name unqiue ?
*/
588 IF INPUT Usr.UserName
<> Usr.UserName
AND
589 CAN-FIND( Usr
WHERE Usr.UserName
= INPUT Usr.UserName
) THEN
592 "A user already exists with the user name" SKIP
593 INPUT Usr.UserName
+ ". You must enter a unique user name."
594 VIEW-AS ALERT-BOX ERROR TITLE "Duplicate User".
595 APPLY '
ENTRY'
:U
TO Usr.UserName.
599 /* Abbreviation Unique ?
*/
600 IF INPUT Usr.Abbreviation
<> Usr.Abbreviation
AND
601 CAN-FIND( Usr
WHERE Usr.Abbreviation
= INPUT Usr.Abbreviation
) THEN
604 "A user already exists with the abbreviation" SKIP
605 INPUT Usr.Abbreviation
+ ". You must enter a unique abbreviation."
606 VIEW-AS ALERT-BOX ERROR TITLE "Duplicate User".
607 APPLY '
ENTRY'
:U
TO Usr.Abbreviation.
615 /* _UIB-CODE-BLOCK-END
*/