sec/b-usrgrp.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
   2 &ANALYZE-RESUME
   3 /* Connected Databases
   4           ttpl             PROGRESS
   5 */
   6 &Scoped-define WINDOW-NAME CURRENT-WINDOW
   7 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS B-table-Win
   8 /*------------------------------------------------------------------------
   9 ------------------------------------------------------------------------*/
  10
  11 CREATE WIDGET-POOL.
  12
  13 /* ***************************  Definitions  ************************** */
  14
  15 {inc/topic/tpusrgrp.i}
  16
  17 /* _UIB-CODE-BLOCK-END */
  18 &ANALYZE-RESUME
  19
  20
  21 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  22
  23 /* ********************  Preprocessor Definitions  ******************** */
  24
  25 &Scoped-define PROCEDURE-TYPE SmartBrowser
  26
  27 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
  28
  29 /* Name of first Frame and/or Browse and/or first Query                 */
  30 &Scoped-define FRAME-NAME F-Main
  31 &Scoped-define BROWSE-NAME br_table
  32
  33 /* Internal Tables (found by Frame, Query & Browse Queries)             */
  34 &Scoped-define INTERNAL-TABLES UsrGroup
  35
  36 /* Define KEY-PHRASE in case it is used by any query. */
  37 &Scoped-define KEY-PHRASE TRUE
  38
  39 /* Definitions for BROWSE br_table                                      */
  40 &Scoped-define FIELDS-IN-QUERY-br_table UsrGroup.GroupName ~
  41 UsrGroup.Description UsrGroup.Sequence
  42 &Scoped-define ENABLED-FIELDS-IN-QUERY-br_table UsrGroup.GroupName ~
  43 UsrGroup.Description UsrGroup.Sequence
  44 &Scoped-define FIELD-PAIRS-IN-QUERY-br_table~
  45  ~{&FP1}GroupName ~{&FP2}GroupName ~{&FP3}~
  46  ~{&FP1}Description ~{&FP2}Description ~{&FP3}~
  47  ~{&FP1}Sequence ~{&FP2}Sequence ~{&FP3}
  48 &Scoped-define ENABLED-TABLES-IN-QUERY-br_table UsrGroup
  49 &Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-br_table UsrGroup
  50 &Scoped-define OPEN-QUERY-br_table OPEN QUERY br_table FOR EACH UsrGroup WHERE ~{&KEY-PHRASE} NO-LOCK ~
  51     ~{&SORTBY-PHRASE}.
  52 &Scoped-define TABLES-IN-QUERY-br_table UsrGroup
  53 &Scoped-define FIRST-TABLE-IN-QUERY-br_table UsrGroup
  54
  55
  56 /* Definitions for FRAME F-Main                                         */
  57
  58 /* Standard List Definitions                                            */
  59 &Scoped-Define ENABLED-OBJECTS br_table
  60
  61 /* Custom List Definitions                                              */
  62 /* List-1,List-2,List-3,List-4,List-5,List-6                            */
  63
  64 /* _UIB-PREPROCESSOR-BLOCK-END */
  65 &ANALYZE-RESUME
  66
  67
  68 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" B-table-Win _INLINE
  69 /* Actions: ? adm/support/keyedit.w ? ? ? */
  70 /* STRUCTURED-DATA
  71 <KEY-OBJECT>
  72 &BROWSE-NAME
  73 </KEY-OBJECT>
  74 <FOREIGN-KEYS>
  75 GroupName||y|TTPL.UsrGroup.GroupName
  76 </FOREIGN-KEYS>
  77 <EXECUTING-CODE>
  78 **************************
  79 * Set attributes related to FOREIGN KEYS
  80 */
  81 RUN set-attribute-list (
  82     'Keys-Accepted = ,
  83      Keys-Supplied = "GroupName"':U).
  84
  85 /* Tell the ADM to use the OPEN-QUERY-CASES. */
  86 &Scoped-define OPEN-QUERY-CASES RUN dispatch ('open-query-cases':U).
  87 /**************************
  88 </EXECUTING-CODE> */
  89 /* _UIB-CODE-BLOCK-END */
  90 &ANALYZE-RESUME
  91
  92 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Advanced Query Options" B-table-Win _INLINE
  93 /* Actions: ? adm/support/advqedit.w ? ? ? */
  94 /* STRUCTURED-DATA
  95 <KEY-OBJECT>
  96 &BROWSE-NAME
  97 </KEY-OBJECT>
  98 <SORTBY-OPTIONS>
  99 Name|y||TTPL.UsrGroup.GroupName|yes
 100 Sequence|||TTPL.UsrGroup.Sequence|yes
 101 </SORTBY-OPTIONS>
 102 <SORTBY-RUN-CODE>
 103 ************************
 104 * Set attributes related to SORTBY-OPTIONS */
 105 RUN set-attribute-list (
 106     'SortBy-Options = "Name,Sequence",
 107      SortBy-Case = Name':U).
 108
 109 /* Tell the ADM to use the OPEN-QUERY-CASES. */
 110 &Scoped-define OPEN-QUERY-CASES RUN dispatch ('open-query-cases':U).
 111
 112 /* This SmartObject is a valid SortBy-Target. */
 113 &IF '{&user-supported-links}':U ne '':U &THEN
 114   &Scoped-define user-supported-links {&user-supported-links},SortBy-Target
 115 &ELSE
 116   &Scoped-define user-supported-links SortBy-Target
 117 &ENDIF
 118
 119 /************************
 120 </SORTBY-RUN-CODE>
 121 <FILTER-ATTRIBUTES></FILTER-ATTRIBUTES> */
 122
 123 /* _UIB-CODE-BLOCK-END */
 124 &ANALYZE-RESUME
 125
 126
 127 /* ***********************  Control Definitions  ********************** */
 128
 129
 130 /* Definitions of the field level widgets                               */
 131 /* Query definitions                                                    */
 132 &ANALYZE-SUSPEND
 133 DEFINE QUERY br_table FOR
 134       UsrGroup SCROLLING.
 135 &ANALYZE-RESUME
 136
 137 /* Browse definitions                                                   */
 138 DEFINE BROWSE br_table
 139 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS br_table B-table-Win _STRUCTURED
 140   QUERY br_table NO-LOCK DISPLAY
 141       UsrGroup.GroupName FORMAT "X(25)"
 142       UsrGroup.Description FORMAT "X(60)"
 143       UsrGroup.Sequence COLUMN-LABEL "Seq" FORMAT "->,>>9"
 144   ENABLE
 145       UsrGroup.GroupName
 146       UsrGroup.Description
 147       UsrGroup.Sequence
 148 /* _UIB-CODE-BLOCK-END */
 149 &ANALYZE-RESUME
 150     WITH NO-ASSIGN SEPARATORS SIZE 72.57 BY 15.6
 151          BGCOLOR 15 .
 152
 153
 154 /* ************************  Frame Definitions  *********************** */
 155
 156 DEFINE FRAME F-Main
 157      br_table AT ROW 1 COL 1
 158     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 159          SIDE-LABELS NO-UNDERLINE THREE-D
 160          AT COL 1 ROW 1 SCROLLABLE
 161          FGCOLOR 0 .
 162
 163
 164 /* *********************** Procedure Settings ************************ */
 165
 166 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 167 /* Settings for THIS-PROCEDURE
 168    Type: SmartBrowser
 169    Allow: Basic,Browse
 170    Frames: 1
 171    Add Fields to: EXTERNAL-TABLES
 172    Other Settings: PERSISTENT-ONLY COMPILE
 173  */
 174
 175 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 176 /* then cleanup and return.                                            */
 177 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 178   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
 179           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 180   RETURN.
 181 END.
 182
 183 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 184
 185 /* *************************  Create Window  ************************** */
 186
 187 &ANALYZE-SUSPEND _CREATE-WINDOW
 188 /* DESIGN Window definition (used by the UIB)
 189   CREATE WINDOW B-table-Win ASSIGN
 190          HEIGHT             = 19.45
 191          WIDTH              = 87.72.
 192 /* END WINDOW DEFINITION */
 193                                                                         */
 194 &ANALYZE-RESUME
 195
 196
 197 /* ***************  Runtime Attributes and UIB Settings  ************** */
 198
 199 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 200 /* SETTINGS FOR WINDOW B-table-Win
 201   NOT-VISIBLE,,RUN-PERSISTENT                                           */
 202 /* SETTINGS FOR FRAME F-Main
 203    NOT-VISIBLE Size-to-Fit                                              */
 204 /* BROWSE-TAB br_table 1 F-Main */
 205 ASSIGN
 206        FRAME F-Main:SCROLLABLE       = FALSE
 207        FRAME F-Main:HIDDEN           = TRUE.
 208
 209 /* _RUN-TIME-ATTRIBUTES-END */
 210 &ANALYZE-RESUME
 211
 212
 213 /* Setting information for Queries and Browse Widgets fields            */
 214
 215 &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE br_table
 216 /* Query rebuild information for BROWSE br_table
 217      _TblList          = "TTPL.UsrGroup"
 218      _Options          = "NO-LOCK KEY-PHRASE SORTBY-PHRASE"
 219      _FldNameList[1]   > TTPL.UsrGroup.GroupName
 220 "GroupName" ? "X(25)" "character" ? ? ? ? ? ? yes ?
 221      _FldNameList[2]   > TTPL.UsrGroup.Description
 222 "Description" ? "X(60)" "character" ? ? ? ? ? ? yes ?
 223      _FldNameList[3]   > TTPL.UsrGroup.Sequence
 224 "Sequence" "Seq" "->,>>9" "integer" ? ? ? ? ? ? yes ?
 225      _Query            is NOT OPENED
 226 */  /* BROWSE br_table */
 227 &ANALYZE-RESUME
 228
 229 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 230 /* Query rebuild information for FRAME F-Main
 231      _Options          = "NO-LOCK"
 232      _Query            is NOT OPENED
 233 */  /* FRAME F-Main */
 234 &ANALYZE-RESUME
 235
 236
 237
 238
 239 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB B-table-Win
 240 /* ************************* Included-Libraries *********************** */
 241
 242 {src/adm/method/browser.i}
 243 {inc/method/m-drlvwr.i}
 244
 245 /* _UIB-CODE-BLOCK-END */
 246 &ANALYZE-RESUME
 247
 248
 249
 250
 251 /* ************************  Control Triggers  ************************ */
 252
 253 &Scoped-define BROWSE-NAME br_table
 254 &Scoped-define SELF-NAME br_table
 255 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 256 ON ROW-ENTRY OF br_table IN FRAME F-Main
 257 DO:
 258   /* This code displays initial values for newly added or copied rows. */
 259   {src/adm/template/brsentry.i}
 260 END.
 261
 262 /* _UIB-CODE-BLOCK-END */
 263 &ANALYZE-RESUME
 264
 265
 266 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 267 ON ROW-LEAVE OF br_table IN FRAME F-Main
 268 DO:
 269     /* Do not disable this code or no updates will take place except
 270      by pressing the Save button on an Update SmartPanel. */
 271    {src/adm/template/brsleave.i}
 272 END.
 273
 274 /* _UIB-CODE-BLOCK-END */
 275 &ANALYZE-RESUME
 276
 277
 278 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL br_table B-table-Win
 279 ON VALUE-CHANGED OF br_table IN FRAME F-Main
 280 DO:
 281   /* This ADM trigger code must be preserved in order to notify other
 282      objects when the browser's current row changes. */
 283   {src/adm/template/brschnge.i}
 284
 285 END.
 286
 287 /* _UIB-CODE-BLOCK-END */
 288 &ANALYZE-RESUME
 289
 290
 291 &UNDEFINE SELF-NAME
 292
 293 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK B-table-Win
 294
 295
 296 /* ***************************  Main Block  *************************** */
 297
 298 /* _UIB-CODE-BLOCK-END */
 299 &ANALYZE-RESUME
 300
 301
 302 /* **********************  Internal Procedures  *********************** */
 303
 304 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-open-query-cases B-table-Win adm/support/_adm-opn.p
 305 PROCEDURE adm-open-query-cases :
 306 /*------------------------------------------------------------------------------
 307   Purpose:     Opens different cases of the query based on attributes
 308                such as the 'Key-Name', or 'SortBy-Case'
 309   Parameters:  <none>
 310 ------------------------------------------------------------------------------*/
 311
 312   /* No Foreign keys are accepted by this SmartObject. */
 313
 314   RUN get-attribute ('SortBy-Case':U).
 315   CASE RETURN-VALUE:
 316     WHEN 'Name':U THEN DO:
 317       &Scope SORTBY-PHRASE BY UsrGroup.GroupName
 318       {&OPEN-QUERY-{&BROWSE-NAME}}
 319     END.
 320     WHEN 'Sequence':U THEN DO:
 321       &Scope SORTBY-PHRASE BY UsrGroup.Sequence
 322       {&OPEN-QUERY-{&BROWSE-NAME}}
 323     END.
 324     OTHERWISE DO:
 325       &Undefine SORTBY-PHRASE
 326       {&OPEN-QUERY-{&BROWSE-NAME}}
 327     END. /* OTHERWISE...*/
 328   END CASE.
 329
 330 END PROCEDURE.
 331
 332 /* _UIB-CODE-BLOCK-END */
 333 &ANALYZE-RESUME
 334
 335
 336 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available B-table-Win _ADM-ROW-AVAILABLE
 337 PROCEDURE adm-row-available :
 338 /*------------------------------------------------------------------------------
 339   Purpose:     Dispatched to this procedure when the Record-
 340                Source has a new row available.  This procedure
 341                tries to get the new row (or foriegn keys) from
 342                the Record-Source and process it.
 343   Parameters:  <none>
 344 ------------------------------------------------------------------------------*/
 345
 346   /* Define variables needed by this internal procedure.             */
 347   {src/adm/template/row-head.i}
 348
 349   /* Process the newly available records (i.e. display fields,
 350      open queries, and/or pass records on to any RECORD-TARGETS).    */
 351   {src/adm/template/row-end.i}
 352
 353 END PROCEDURE.
 354
 355 /* _UIB-CODE-BLOCK-END */
 356 &ANALYZE-RESUME
 357
 358
 359 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI B-table-Win _DEFAULT-DISABLE
 360 PROCEDURE disable_UI :
 361 /*------------------------------------------------------------------------------
 362   Purpose:     DISABLE the User Interface
 363   Parameters:  <none>
 364   Notes:       Here we clean-up the user-interface by deleting
 365                dynamic widgets we have created and/or hide
 366                frames.  This procedure is usually called when
 367                we are ready to "clean-up" after running.
 368 ------------------------------------------------------------------------------*/
 369   /* Hide all frames. */
 370   HIDE FRAME F-Main.
 371   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 372 END PROCEDURE.
 373
 374 /* _UIB-CODE-BLOCK-END */
 375 &ANALYZE-RESUME
 376
 377
 378 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE increase-group-sequence B-table-Win
 379 PROCEDURE increase-group-sequence :
 380 /*------------------------------------------------------------------------------
 381   Purpose:
 382 ------------------------------------------------------------------------------*/
 383 DEF BUFFER PrevUG FOR UsrGroup.
 384 DEF BUFFER NextUG FOR UsrGroup.
 385
 386 DEF VAR offset AS INT NO-UNDO.
 387 DEF VAR curr-recid AS RECID NO-UNDO.
 388
 389   curr-recid = RECID(UsrGroup).
 390   FIND LAST PrevUG WHERE PrevUG.Sequence <= UsrGroup.Sequence
 391                      AND RECID(PrevUG) <> curr-recid NO-LOCK NO-ERROR.
 392   FIND FIRST NextUG WHERE NextUG.Sequence >= UsrGroup.Sequence
 393                      AND RECID(NextUG) <> curr-recid NO-LOCK NO-ERROR.
 394
 395   IF NOT AVAILABLE(NextUG) THEN DO:
 396     offset = 5.
 397   END.
 398   ELSE IF NextUG.Sequence > UsrGroup.Sequence THEN DO:
 399     offset = NextUG.Sequence - UsrGroup.Sequence.
 400     FIND CURRENT NextUG EXCLUSIVE-LOCK.
 401     NextUG.Sequence = UsrGroup.Sequence.
 402     FIND CURRENT NextUG NO-LOCK.
 403   END.
 404   ELSE DO:
 405     offset = 1.
 406   END.
 407
 408   FIND CURRENT UsrGroup EXCLUSIVE-LOCK.
 409   UsrGroup.Sequence = UsrGroup.Sequence + offset.
 410   FIND CURRENT UsrGroup NO-LOCK.
 411
 412   RUN dispatch( 'open-query':U ).
 413   REPOSITION {&BROWSE-NAME} TO RECID curr-recid.
 414
 415 END PROCEDURE.
 416
 417 /* _UIB-CODE-BLOCK-END */
 418 &ANALYZE-RESUME
 419
 420
 421 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reduce-group-sequence B-table-Win
 422 PROCEDURE reduce-group-sequence :
 423 /*------------------------------------------------------------------------------
 424   Purpose:
 425 ------------------------------------------------------------------------------*/
 426 DEF BUFFER PrevUG FOR UsrGroup.
 427 DEF BUFFER NextUG FOR UsrGroup.
 428
 429 DEF VAR offset AS INT NO-UNDO.
 430 DEF VAR curr-recid AS RECID NO-UNDO.
 431
 432   curr-recid = RECID(UsrGroup).
 433   FIND LAST PrevUG WHERE PrevUG.Sequence <= UsrGroup.Sequence
 434                      AND RECID(PrevUG) <> curr-recid NO-LOCK NO-ERROR.
 435   FIND FIRST NextUG WHERE NextUG.Sequence >= UsrGroup.Sequence
 436                      AND RECID(NextUG) <> curr-recid NO-LOCK NO-ERROR.
 437
 438   IF NOT AVAILABLE(PrevUG) THEN DO:
 439     offset = 5.
 440   END.
 441   ELSE IF PrevUG.Sequence < UsrGroup.Sequence THEN DO:
 442     offset = UsrGroup.Sequence - PrevUG.Sequence.
 443     FIND CURRENT PrevUG EXCLUSIVE-LOCK.
 444     PrevUG.Sequence = UsrGroup.Sequence.
 445     FIND CURRENT PrevUG NO-LOCK.
 446   END.
 447   ELSE DO:
 448     offset = 1.
 449   END.
 450
 451   FIND CURRENT UsrGroup EXCLUSIVE-LOCK.
 452   UsrGroup.Sequence = UsrGroup.Sequence - offset.
 453   FIND CURRENT UsrGroup NO-LOCK.
 454
 455   RUN dispatch( 'open-query':U ).
 456   REPOSITION {&BROWSE-NAME} TO RECID curr-recid.
 457
 458 END PROCEDURE.
 459
 460 /* _UIB-CODE-BLOCK-END */
 461 &ANALYZE-RESUME
 462
 463
 464 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-key B-table-Win adm/support/_key-snd.p
 465 PROCEDURE send-key :
 466 /*------------------------------------------------------------------------------
 467   Purpose:     Sends a requested KEY value back to the calling
 468                SmartObject.
 469   Parameters:  <see adm/template/sndkytop.i>
 470 ------------------------------------------------------------------------------*/
 471
 472   /* Define variables needed by this internal procedure.             */
 473   {src/adm/template/sndkytop.i}
 474
 475   /* Return the key value associated with each key case.             */
 476   {src/adm/template/sndkycas.i "GroupName" "UsrGroup" "GroupName"}
 477
 478   /* Close the CASE statement and end the procedure.                 */
 479   {src/adm/template/sndkyend.i}
 480
 481 END PROCEDURE.
 482
 483 /* _UIB-CODE-BLOCK-END */
 484 &ANALYZE-RESUME
 485
 486
 487 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records B-table-Win _ADM-SEND-RECORDS
 488 PROCEDURE send-records :
 489 /*------------------------------------------------------------------------------
 490   Purpose:     Send record ROWID's for all tables used by
 491                this file.
 492   Parameters:  see template/snd-head.i
 493 ------------------------------------------------------------------------------*/
 494
 495   /* Define variables needed by this internal procedure.               */
 496   {src/adm/template/snd-head.i}
 497
 498   /* For each requested table, put it's ROWID in the output list.      */
 499   {src/adm/template/snd-list.i "UsrGroup"}
 500
 501   /* Deal with any unexpected table requests before closing.           */
 502   {src/adm/template/snd-end.i}
 503
 504 END PROCEDURE.
 505
 506 /* _UIB-CODE-BLOCK-END */
 507 &ANALYZE-RESUME
 508
 509
 510 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed B-table-Win
 511 PROCEDURE state-changed :
 512 /* -----------------------------------------------------------
 513   Purpose:
 514   Parameters:  <none>
 515   Notes:
 516 -------------------------------------------------------------*/
 517   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 518   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 519
 520   CASE p-state:
 521       /* Object instance CASEs can go here to replace standard behavior
 522          or add new cases. */
 523       {src/adm/template/bstates.i}
 524   END CASE.
 525 END PROCEDURE.
 526
 527 /* _UIB-CODE-BLOCK-END */
 528 &ANALYZE-RESUME
 529
 530