sec/v-usrgrp-members.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
   2 &ANALYZE-RESUME
   3 &Scoped-define WINDOW-NAME CURRENT-WINDOW
   4 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS V-table-Win
   5 /*------------------------------------------------------------------------
   6   File:
   7 ------------------------------------------------------------------------*/
   8
   9 CREATE WIDGET-POOL.
  10
  11 /* ***************************  Definitions  ************************** */
  12
  13 DEF VAR last-id      AS ROWID  NO-UNDO.
  14 DEF VAR this-win     AS HANDLE NO-UNDO.
  15
  16 /* _UIB-CODE-BLOCK-END */
  17 &ANALYZE-RESUME
  18
  19
  20 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  21
  22 /* ********************  Preprocessor Definitions  ******************** */
  23
  24 &Scoped-define PROCEDURE-TYPE SmartViewer
  25
  26 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
  27
  28 /* Name of first Frame and/or Browse and/or first Query                 */
  29 &Scoped-define FRAME-NAME F-Main
  30
  31 /* Standard List Definitions                                            */
  32 &Scoped-Define ENABLED-OBJECTS tgl_topmost sel_avail btn_add sel_curr ~
  33 btn_rem
  34 &Scoped-Define DISPLAYED-OBJECTS tgl_topmost sel_avail sel_curr
  35
  36 /* Custom List Definitions                                              */
  37 /* ADM-CREATE-FIELDS,ADM-ASSIGN-FIELDS,List-3,List-4,List-5,List-6      */
  38
  39 /* _UIB-PREPROCESSOR-BLOCK-END */
  40 &ANALYZE-RESUME
  41
  42
  43 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" V-table-Win _INLINE
  44 /* Actions: ? adm/support/keyedit.w ? ? ? */
  45 /* STRUCTURED-DATA
  46 <KEY-OBJECT>
  47 THIS-PROCEDURE
  48 </KEY-OBJECT>
  49 <FOREIGN-KEYS>
  50 GroupName|y|y|TTPL.UsrGroup.GroupName
  51 </FOREIGN-KEYS>
  52 <EXECUTING-CODE>
  53 **************************
  54 * Set attributes related to FOREIGN KEYS
  55 */
  56 RUN set-attribute-list (
  57     'Keys-Accepted = "GroupName",
  58      Keys-Supplied = "GroupName"':U).
  59 /**************************
  60 </EXECUTING-CODE> */
  61 /* _UIB-CODE-BLOCK-END */
  62 &ANALYZE-RESUME
  63
  64
  65 /* ***********************  Control Definitions  ********************** */
  66
  67
  68 /* Definitions of the field level widgets                               */
  69 DEFINE BUTTON btn_add
  70      LABEL "Add"
  71      SIZE 10.29 BY 1.05
  72      FONT 10.
  73
  74 DEFINE BUTTON btn_rem
  75      LABEL "Remove"
  76      SIZE 10.29 BY 1.05
  77      FONT 10.
  78
  79 DEFINE VARIABLE sel_avail AS CHARACTER
  80      VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL
  81      SIZE 30 BY 17
  82      FONT 10 NO-UNDO.
  83
  84 DEFINE VARIABLE sel_curr AS CHARACTER
  85      VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL
  86      SIZE 30 BY 17
  87      FONT 10 NO-UNDO.
  88
  89 DEFINE VARIABLE tgl_topmost AS LOGICAL INITIAL no
  90      LABEL "On Top ?"
  91      VIEW-AS TOGGLE-BOX
  92      SIZE 10 BY 1
  93      FONT 10 NO-UNDO.
  94
  95
  96 /* ************************  Frame Definitions  *********************** */
  97
  98 DEFINE FRAME F-Main
  99      tgl_topmost AT ROW 1 COL 65
 100      sel_avail AT ROW 2 COL 2 NO-LABEL
 101      btn_add AT ROW 2 COL 33
 102      sel_curr AT ROW 2 COL 45 NO-LABEL
 103      btn_rem AT ROW 3.2 COL 33
 104      "Available Users" VIEW-AS TEXT
 105           SIZE 16 BY 1 AT ROW 1 COL 2
 106           FONT 10
 107      "Current Members" VIEW-AS TEXT
 108           SIZE 13.72 BY 1 AT ROW 1 COL 45
 109           FONT 10
 110     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 111          SIDE-LABELS NO-UNDERLINE THREE-D
 112          AT COL 1 ROW 1 SCROLLABLE .
 113
 114
 115 /* *********************** Procedure Settings ************************ */
 116
 117 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 118 /* Settings for THIS-PROCEDURE
 119    Type: SmartViewer
 120    Allow: Basic,DB-Fields
 121    Frames: 1
 122    Add Fields to: EXTERNAL-TABLES
 123    Other Settings: PERSISTENT-ONLY COMPILE
 124  */
 125
 126 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 127 /* then cleanup and return.                                            */
 128 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 129   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT."
 130           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 131   RETURN.
 132 END.
 133
 134 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 135
 136 /* *************************  Create Window  ************************** */
 137
 138 &ANALYZE-SUSPEND _CREATE-WINDOW
 139 /* DESIGN Window definition (used by the UIB)
 140   CREATE WINDOW V-table-Win ASSIGN
 141          HEIGHT             = 23.95
 142          WIDTH              = 75.43.
 143 /* END WINDOW DEFINITION */
 144                                                                         */
 145 &ANALYZE-RESUME
 146
 147
 148 /* ***************  Runtime Attributes and UIB Settings  ************** */
 149
 150 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 151 /* SETTINGS FOR WINDOW V-table-Win
 152   VISIBLE,,RUN-PERSISTENT                                               */
 153 /* SETTINGS FOR FRAME F-Main
 154    NOT-VISIBLE Size-to-Fit                                              */
 155 ASSIGN
 156        FRAME F-Main:SCROLLABLE       = FALSE
 157        FRAME F-Main:HIDDEN           = TRUE.
 158
 159 /* _RUN-TIME-ATTRIBUTES-END */
 160 &ANALYZE-RESUME
 161
 162
 163 /* Setting information for Queries and Browse Widgets fields            */
 164
 165 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 166 /* Query rebuild information for FRAME F-Main
 167      _Options          = "NO-LOCK"
 168      _Query            is NOT OPENED
 169 */  /* FRAME F-Main */
 170 &ANALYZE-RESUME
 171
 172
 173
 174
 175 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB V-table-Win
 176 /* ************************* Included-Libraries *********************** */
 177
 178 {src/adm/method/viewer.i}
 179 {inc/method/m-mntvwr.i}
 180
 181 /* _UIB-CODE-BLOCK-END */
 182 &ANALYZE-RESUME
 183
 184
 185
 186
 187 /* ************************  Control Triggers  ************************ */
 188
 189 &Scoped-define SELF-NAME btn_add
 190 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_add V-table-Win
 191 ON CHOOSE OF btn_add IN FRAME F-Main /* Add */
 192 DO:
 193   RUN add-member.
 194 END.
 195
 196 /* _UIB-CODE-BLOCK-END */
 197 &ANALYZE-RESUME
 198
 199
 200 &Scoped-define SELF-NAME btn_rem
 201 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_rem V-table-Win
 202 ON CHOOSE OF btn_rem IN FRAME F-Main /* Remove */
 203 DO:
 204   RUN remove-member.
 205 END.
 206
 207 /* _UIB-CODE-BLOCK-END */
 208 &ANALYZE-RESUME
 209
 210
 211 &Scoped-define SELF-NAME sel_avail
 212 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL sel_avail V-table-Win
 213 ON MOUSE-SELECT-DBLCLICK OF sel_avail IN FRAME F-Main
 214 DO:
 215   APPLY 'CHOOSE':U TO btn_add .
 216 END.
 217
 218 /* _UIB-CODE-BLOCK-END */
 219 &ANALYZE-RESUME
 220
 221
 222 &Scoped-define SELF-NAME sel_curr
 223 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL sel_curr V-table-Win
 224 ON MOUSE-SELECT-DBLCLICK OF sel_curr IN FRAME F-Main
 225 DO:
 226   APPLY 'CHOOSE':U TO btn_rem .
 227 END.
 228
 229 /* _UIB-CODE-BLOCK-END */
 230 &ANALYZE-RESUME
 231
 232
 233 &Scoped-define SELF-NAME tgl_topmost
 234 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL tgl_topmost V-table-Win
 235 ON VALUE-CHANGED OF tgl_topmost IN FRAME F-Main /* On Top ? */
 236 DO:
 237   RUN top-most-changed.
 238 END.
 239
 240 /* _UIB-CODE-BLOCK-END */
 241 &ANALYZE-RESUME
 242
 243
 244 &UNDEFINE SELF-NAME
 245
 246 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK V-table-Win
 247
 248
 249 /* ***************************  Main Block  *************************** */
 250
 251   &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
 252     RUN dispatch IN THIS-PROCEDURE ('initialize':U).
 253   &ENDIF
 254
 255   /************************ INTERNAL PROCEDURES ********************/
 256
 257 /* _UIB-CODE-BLOCK-END */
 258 &ANALYZE-RESUME
 259
 260
 261 /* **********************  Internal Procedures  *********************** */
 262
 263 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE add-member V-table-Win
 264 PROCEDURE add-member :
 265 /*------------------------------------------------------------------------------
 266   Purpose:
 267   Parameters:  <none>
 268   Notes:
 269 ------------------------------------------------------------------------------*/
 270
 271 DO WITH FRAME {&FRAME-NAME}:
 272
 273   IF NOT AVAILABLE UsrGroup THEN RETURN.
 274
 275   RUN notify( 'set-busy, CONTAINER-SOURCE':U ).
 276
 277   FIND FIRST Usr WHERE Usr.UserName = INPUT sel_avail.
 278   CREATE UsrGroupMember.
 279   ASSIGN
 280     UsrGroupMember.GroupName = UsrGroup.GroupName
 281     UsrGroupMember.UserName  = Usr.UserName .
 282
 283   sel_curr:ADD-LAST( UsrGroupMember.UserName ) .
 284   sel_curr:SCREEN-VALUE = UsrGroupMember.UserName.
 285   sel_avail:DELETE( INPUT sel_avail ) .
 286
 287   RUN update-buttons.
 288
 289   RUN notify( 'set-idle, CONTAINER-SOURCE':U ).
 290
 291 END.
 292
 293 END PROCEDURE.
 294
 295 /* _UIB-CODE-BLOCK-END */
 296 &ANALYZE-RESUME
 297
 298
 299 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-find-using-key V-table-Win adm/support/_key-fnd.p
 300 PROCEDURE adm-find-using-key :
 301 /*------------------------------------------------------------------------------
 302   Purpose:     Finds the current record using the contents of
 303                the 'Key-Name' and 'Key-Value' attributes.
 304   Parameters:  <none>
 305 ------------------------------------------------------------------------------*/
 306   DEF VAR key-value AS CHAR NO-UNDO.
 307   DEF VAR row-avail-enabled AS LOGICAL NO-UNDO.
 308
 309   /* LOCK status on the find depends on FIELDS-ENABLED. */
 310   RUN get-attribute ('FIELDS-ENABLED':U).
 311   row-avail-enabled = (RETURN-VALUE eq 'yes':U).
 312   /* Look up the current key-value. */
 313   RUN get-attribute ('Key-Value':U).
 314   key-value = RETURN-VALUE.
 315
 316   /* Find the current record using the current Key-Name. */
 317   RUN get-attribute ('Key-Name':U).
 318   CASE RETURN-VALUE:
 319     WHEN 'GroupName':U THEN
 320        {src/adm/template/find-tbl.i
 321            &TABLE = UsrGroup
 322            &WHERE = "WHERE UsrGroup.GroupName eq key-value"
 323        }
 324   END CASE.
 325
 326 END PROCEDURE.
 327
 328 /* _UIB-CODE-BLOCK-END */
 329 &ANALYZE-RESUME
 330
 331
 332 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available V-table-Win _ADM-ROW-AVAILABLE
 333 PROCEDURE adm-row-available :
 334 /*------------------------------------------------------------------------------
 335   Purpose:     Dispatched to this procedure when the Record-
 336                Source has a new row available.  This procedure
 337                tries to get the new row (or foriegn keys) from
 338                the Record-Source and process it.
 339   Parameters:  <none>
 340 ------------------------------------------------------------------------------*/
 341
 342   /* Define variables needed by this internal procedure.             */
 343   {src/adm/template/row-head.i}
 344
 345   /* Process the newly available records (i.e. display fields,
 346      open queries, and/or pass records on to any RECORD-TARGETS).    */
 347   {src/adm/template/row-end.i}
 348
 349 END PROCEDURE.
 350
 351 /* _UIB-CODE-BLOCK-END */
 352 &ANALYZE-RESUME
 353
 354
 355 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI V-table-Win _DEFAULT-DISABLE
 356 PROCEDURE disable_UI :
 357 /*------------------------------------------------------------------------------
 358   Purpose:     DISABLE the User Interface
 359   Parameters:  <none>
 360   Notes:       Here we clean-up the user-interface by deleting
 361                dynamic widgets we have created and/or hide
 362                frames.  This procedure is usually called when
 363                we are ready to "clean-up" after running.
 364 ------------------------------------------------------------------------------*/
 365   /* Hide all frames. */
 366   HIDE FRAME F-Main.
 367   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 368 END PROCEDURE.
 369
 370 /* _UIB-CODE-BLOCK-END */
 371 &ANALYZE-RESUME
 372
 373
 374 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-initialize V-table-Win
 375 PROCEDURE inst-initialize :
 376 /*------------------------------------------------------------------------------
 377   Purpose:
 378 ------------------------------------------------------------------------------*/
 379
 380   this-win = {&WINDOW-NAME}:HANDLE .
 381   RUN top-most-changed.
 382
 383 END PROCEDURE.
 384
 385 /* _UIB-CODE-BLOCK-END */
 386 &ANALYZE-RESUME
 387
 388
 389 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-row-available V-table-Win
 390 PROCEDURE inst-row-available :
 391 /*------------------------------------------------------------------------------
 392   Purpose:
 393   Parameters:  <none>
 394   Notes:
 395 ------------------------------------------------------------------------------*/
 396
 397   RUN dispatch( 'find-using-key':u ).
 398   IF NOT AVAILABLE UsrGroup THEN RETURN.
 399
 400   CURRENT-WINDOW:TITLE = "Members - " + UsrGroup.GroupName.
 401   IF ROWID( UsrGroup ) <> last-id THEN RUN refresh-members.
 402   last-id = ROWID( UsrGroup ).
 403
 404 END PROCEDURE.
 405
 406 /* _UIB-CODE-BLOCK-END */
 407 &ANALYZE-RESUME
 408
 409
 410 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-row-available V-table-Win
 411 PROCEDURE pre-row-available :
 412 /*------------------------------------------------------------------------------
 413   Purpose:  Override toolkit behaviour
 414 ------------------------------------------------------------------------------*/
 415
 416   have-records = No.
 417
 418 END PROCEDURE.
 419
 420 /* _UIB-CODE-BLOCK-END */
 421 &ANALYZE-RESUME
 422
 423
 424 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE refresh-members V-table-Win
 425 PROCEDURE refresh-members :
 426 /*------------------------------------------------------------------------------
 427   Purpose:
 428   Parameters:  <none>
 429   Notes:
 430 ------------------------------------------------------------------------------*/
 431
 432 DO WITH FRAME {&FRAME-NAME}:
 433
 434   sel_avail:LIST-ITEMS = "".
 435   sel_curr:LIST-ITEMS = "".
 436
 437   IF NOT AVAILABLE UsrGroup THEN RETURN.
 438
 439   RUN notify( 'set-busy, CONTAINER-SOURCE':U ).
 440
 441   FOR EACH Usr NO-LOCK:
 442     IF CAN-FIND( UsrGroupMember WHERE UsrGroupMember.UserName = Usr.UserName
 443                      AND UsrGroupMember.GroupName = UsrGroup.GroupName ) THEN
 444       sel_curr:ADD-LAST( Usr.UserName ).
 445     ELSE
 446       sel_avail:ADD-LAST( Usr.UserName ).
 447   END.
 448
 449   RUN update-buttons.
 450
 451   RUN notify( 'set-idle, CONTAINER-SOURCE':U ).
 452
 453 END.
 454
 455 END PROCEDURE.
 456
 457 /* _UIB-CODE-BLOCK-END */
 458 &ANALYZE-RESUME
 459
 460
 461 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remove-member V-table-Win
 462 PROCEDURE remove-member :
 463 /*------------------------------------------------------------------------------
 464   Purpose:
 465   Parameters:  <none>
 466   Notes:
 467 ------------------------------------------------------------------------------*/
 468
 469 DO WITH FRAME {&FRAME-NAME}:
 470
 471   IF NOT AVAILABLE UsrGroup THEN RETURN.
 472
 473   RUN notify( 'set-busy, CONTAINER-SOURCE':U ).
 474
 475   FIND FIRST Usr WHERE Usr.UserName = INPUT sel_curr.
 476   FIND UsrGroupMember OF UsrGroup WHERE UsrGroupMember.UserName = Usr.UserName EXCLUSIVE-LOCK.
 477   DELETE UsrGroupMember.
 478
 479   sel_avail:ADD-LAST( INPUT sel_curr ) .
 480   sel_avail:SCREEN-VALUE = INPUT sel_curr.
 481   sel_curr:DELETE( INPUT sel_curr ) .
 482
 483   RUN update-buttons.
 484   RUN notify( 'set-idle, CONTAINER-SOURCE':U ).
 485
 486 END.
 487
 488 END PROCEDURE.
 489
 490 /* _UIB-CODE-BLOCK-END */
 491 &ANALYZE-RESUME
 492
 493
 494 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-key V-table-Win adm/support/_key-snd.p
 495 PROCEDURE send-key :
 496 /*------------------------------------------------------------------------------
 497   Purpose:     Sends a requested KEY value back to the calling
 498                SmartObject.
 499   Parameters:  <see adm/template/sndkytop.i>
 500 ------------------------------------------------------------------------------*/
 501
 502   /* Define variables needed by this internal procedure.             */
 503   {src/adm/template/sndkytop.i}
 504
 505   /* Return the key value associated with each key case.             */
 506   {src/adm/template/sndkycas.i "GroupName" "UsrGroup" "GroupName"}
 507
 508   /* Close the CASE statement and end the procedure.                 */
 509   {src/adm/template/sndkyend.i}
 510
 511 END PROCEDURE.
 512
 513 /* _UIB-CODE-BLOCK-END */
 514 &ANALYZE-RESUME
 515
 516
 517 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records V-table-Win _ADM-SEND-RECORDS
 518 PROCEDURE send-records :
 519 /*------------------------------------------------------------------------------
 520   Purpose:     Send record ROWID's for all tables used by
 521                this file.
 522   Parameters:  see template/snd-head.i
 523 ------------------------------------------------------------------------------*/
 524
 525   /* SEND-RECORDS does nothing because there are no External
 526      Tables specified for this SmartViewer, and there are no
 527      tables specified in any contained Browse, Query, or Frame. */
 528
 529 END PROCEDURE.
 530
 531 /* _UIB-CODE-BLOCK-END */
 532 &ANALYZE-RESUME
 533
 534
 535 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed V-table-Win
 536 PROCEDURE state-changed :
 537 /* -----------------------------------------------------------
 538   Purpose:
 539   Parameters:  <none>
 540   Notes:
 541 -------------------------------------------------------------*/
 542   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 543   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 544
 545   CASE p-state:
 546       /* Object instance CASEs can go here to replace standard behavior
 547          or add new cases. */
 548       {src/adm/template/vstates.i}
 549   END CASE.
 550 END PROCEDURE.
 551
 552 /* _UIB-CODE-BLOCK-END */
 553 &ANALYZE-RESUME
 554
 555
 556 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE top-most-changed V-table-Win
 557 PROCEDURE top-most-changed :
 558 /*------------------------------------------------------------------------------
 559   Purpose:
 560 ------------------------------------------------------------------------------*/
 561
 562   IF INPUT FRAME {&FRAME-NAME} tgl_topmost THEN
 563     RUN notify( 'set-topmost,container-source':U ).
 564   ELSE
 565     RUN notify( 'reset-topmost,container-source':U ).
 566
 567 END PROCEDURE.
 568
 569 /* _UIB-CODE-BLOCK-END */
 570 &ANALYZE-RESUME
 571
 572
 573 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-buttons V-table-Win
 574 PROCEDURE update-buttons :
 575 /*------------------------------------------------------------------------------
 576   Purpose:
 577   Parameters:  <none>
 578   Notes:
 579 ------------------------------------------------------------------------------*/
 580
 581 DO WITH FRAME {&FRAME-NAME}:
 582   btn_add:SENSITIVE = sel_avail:SCREEN-VALUE <> "" AND sel_avail:SCREEN-VALUE <> ?.
 583   btn_rem:SENSITIVE = sel_curr:SCREEN-VALUE <> ""  AND sel_curr:SCREEN-VALUE <> ?.
 584 END.
 585
 586 END PROCEDURE.
 587
 588 /* _UIB-CODE-BLOCK-END */
 589 &ANALYZE-RESUME
 590
 591