panel/p-option.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
   2 &ANALYZE-RESUME
   3 &Scoped-define WINDOW-NAME CURRENT-WINDOW
   4 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS s-object
   5 /*------------------------------------------------------------------------
   6
   7   File: p-option.w
   8
   9   Description:
  10       A SmartPanel that has a list of options. These options are retrieved from
  11       linked object at initialization.:
  12           RUN get-attribute IN <link> ('<Options-Attribute>':U).
  13       This list is displayed in either a combo-box, selection-list or radio-set.
  14
  15       When the user changes the value of the list, then the linked object is sent
  16       the new value:
  17           RUN set-attribute-list IN <link> ('<Case-Attribute> = <value>':U)
  18
  19       This panel will also automatically dispatch an additional event to
  20       the linked object if the 'Case-Changed-Event' is also set:
  21           RUN dispatch IN <link> ('<Case-Changed-Event>').
  22
  23   Input Parameters:
  24       <none>
  25
  26   Output Parameters:
  27       <none>
  28
  29   Authors: Wm.T.Wood and Rick Kuzyk
  30   Created: March 1996
  31 ------------------------------------------------------------------------*/
  32 CREATE WIDGET-POOL.
  33
  34 /* Parameters Definitions ---                                           */
  35
  36 /* Local Variable Definitions ---                                       */
  37 DEF VAR c_options-list AS CHAR NO-UNDO.            /* List of options.         */
  38 DEF VAR c_initial-case AS CHAR NO-UNDO.            /* Initial Case             */
  39 DEF VAR h_list AS WIDGET-HANDLE NO-UNDO.           /* Control to list options. */
  40 DEF VAR c_delimiter AS CHAR NO-UNDO INITIAL ",":U. /* The delimiter to use.    */
  41
  42 /* ADM Preprocessor Defintions ---                                      */
  43 &Scoped-define adm-attribute-dlg adm/support/optiond.w
  44
  45 /* _UIB-CODE-BLOCK-END */
  46 &ANALYZE-RESUME
  47
  48
  49 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  50
  51 /* ********************  Preprocessor Definitions  ******************** */
  52
  53 &Scoped-define PROCEDURE-TYPE SmartPanel
  54 &Scoped-define DB-AWARE no
  55
  56 /* Name of designated FRAME-NAME and/or first browse and/or first query */
  57 &Scoped-define FRAME-NAME F-Main
  58
  59 /* Standard List Definitions                                            */
  60 &Scoped-Define ENABLED-OBJECTS RECT-1
  61
  62 /* Custom List Definitions                                              */
  63 /* Box-Rectangle,Label,List-3,List-4,List-5,List-6                      */
  64 &Scoped-define Box-Rectangle RECT-1
  65 &Scoped-define Label c-Label
  66
  67 /* _UIB-PREPROCESSOR-BLOCK-END */
  68 &ANALYZE-RESUME
  69
  70
  71
  72 /* ***********************  Control Definitions  ********************** */
  73
  74
  75 /* Definitions of the field level widgets                               */
  76 DEFINE VARIABLE c-Label AS CHARACTER FORMAT "X(256)":U INITIAL "&Options"
  77       VIEW-AS TEXT
  78      SIZE 8 BY .6 NO-UNDO.
  79
  80 DEFINE RECTANGLE RECT-1
  81      EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
  82      SIZE 22.86 BY 1.5.
  83
  84
  85 /* ************************  Frame Definitions  *********************** */
  86
  87 DEFINE FRAME F-Main
  88      c-Label AT ROW 1 COL 2 NO-LABEL
  89      RECT-1 AT ROW 1.3 COL 1
  90     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
  91          SIDE-LABELS NO-UNDERLINE THREE-D
  92          AT COL 1 ROW 1 SCROLLABLE
  93          FGCOLOR 1 .
  94
  95
  96 /* *********************** Procedure Settings ************************ */
  97
  98 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  99 /* Settings for THIS-PROCEDURE
 100    Type: SmartPanel
 101    Allow: Basic
 102    Frames: 1
 103    Add Fields to: NEITHER
 104    Other Settings: PERSISTENT-ONLY COMPILE
 105  */
 106
 107 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 108 /* then cleanup and return.                                            */
 109 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 110   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
 111           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 112   RETURN.
 113 END.
 114
 115 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 116
 117 /* *************************  Create Window  ************************** */
 118
 119 &ANALYZE-SUSPEND _CREATE-WINDOW
 120 /* DESIGN Window definition (used by the UIB)
 121   CREATE WINDOW s-object ASSIGN
 122          HEIGHT             = 2.4
 123          WIDTH              = 31.86.
 124 /* END WINDOW DEFINITION */
 125                                                                         */
 126 &ANALYZE-RESUME
 127
 128 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB s-object
 129 /* ************************* Included-Libraries *********************** */
 130
 131 {src/adm/method/smart.i}
 132
 133 /* _UIB-CODE-BLOCK-END */
 134 &ANALYZE-RESUME
 135
 136
 137
 138
 139 /* ***********  Runtime Attributes and AppBuilder Settings  *********** */
 140
 141 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 142 /* SETTINGS FOR WINDOW s-object
 143   VISIBLE,,RUN-PERSISTENT                                               */
 144 /* SETTINGS FOR FRAME F-Main
 145    NOT-VISIBLE FRAME-NAME Size-to-Fit                                   */
 146 ASSIGN
 147        FRAME F-Main:SCROLLABLE       = FALSE
 148        FRAME F-Main:HIDDEN           = TRUE.
 149
 150 /* SETTINGS FOR FILL-IN c-Label IN FRAME F-Main
 151    NO-DISPLAY NO-ENABLE ALIGN-L 2                                       */
 152 ASSIGN
 153        c-Label:HIDDEN IN FRAME F-Main           = TRUE.
 154
 155 /* SETTINGS FOR RECTANGLE RECT-1 IN FRAME F-Main
 156    1                                                                    */
 157 /* _RUN-TIME-ATTRIBUTES-END */
 158 &ANALYZE-RESUME
 159
 160
 161 /* Setting information for Queries and Browse Widgets fields            */
 162
 163 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 164 /* Query rebuild information for FRAME F-Main
 165      _Options          = "NO-LOCK"
 166      _Query            is NOT OPENED
 167 */  /* FRAME F-Main */
 168 &ANALYZE-RESUME
 169
 170
 171
 172
 173 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK s-object
 174
 175
 176 /* ***************************  Main Block  *************************** */
 177
 178   &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
 179     /* Code needed to test this object (when run directly from the UIB) */
 180     RUN dispatch IN THIS-PROCEDURE ('initialize').
 181   &ENDIF
 182
 183 RUN set-default-attributes.
 184
 185 /* _UIB-CODE-BLOCK-END */
 186 &ANALYZE-RESUME
 187
 188
 189 /* **********************  Internal Procedures  *********************** */
 190
 191 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-style s-object
 192 PROCEDURE apply-style :
 193 /*------------------------------------------------------------------------------
 194   Purpose:     Create a control to show the options in. The type of control
 195                is based on the "Style" attribute.
 196   Parameters:  <none>
 197   Notes:       Create the handle, h_list, to show the option-list.
 198                     ***************************************************
 199                This is NOT a "use-style" method that is automatically called
 200                when the "style" attribute is set because we want explicit control
 201                over when the dynamic objects are created. The objects cannot be
 202                created until the parent frame has been parented and realized.
 203                     ***************************************************
 204 ------------------------------------------------------------------------------*/
 205   DEFINE VAR c_btns   AS CHAR    NO-UNDO.
 206   DEFINE VAR c_ibtn   AS CHAR    NO-UNDO.
 207   DEFINE VAR c_style  AS CHAR    NO-UNDO.
 208   DEFINE VAR ch       AS CHAR    NO-UNDO.
 209   DEFINE VAR i        AS INTEGER NO-UNDO.
 210   DEFINE VAR iCnt     AS INTEGER NO-UNDO.
 211   DEFINE VAR i_margin AS INTEGER NO-UNDO.
 212   DEFINE VAR l_dummy  AS LOGICAL NO-UNDO.
 213
 214   /* Delete the previous sample. */
 215   IF VALID-HANDLE(h_list) AND h_list:DYNAMIC THEN DELETE WIDGET h_list.
 216
 217   /* Create a new item. */
 218   RUN get-attribute ('Style':U).
 219   c_style = RETURN-VALUE.
 220   RUN get-attribute ('UIB-Mode':U).
 221   IF RETURN-VALUE eq 'Design':U THEN DO:
 222     /* Show sample lists at design time. Make sure we set the delimiter in
 223        the list correctly. */
 224     CASE c_style:
 225       WHEN 'Selection-List':U THEN
 226         c_options-list = 'Sample 1,Sample 2,Sample 3,Sample 4,Sample 5,Sample 6'.
 227       WHEN 'Horizontal Radio-Set':U THEN
 228         c_options-list = 'Sample 1,Sample 2'.
 229       OTHERWISE
 230         c_options-list = 'Sample 1,Sample 2,Sample 3'.
 231     END CASE.
 232     ASSIGN c_initial-case = ENTRY (1, c_options-list)
 233            c_options-list = REPLACE (c_options-list, ',':U, c_delimiter).
 234   END.
 235
 236   /* Create the list object based on the 'Style'. */
 237   CASE c_style:
 238     WHEN "SELECTION-LIST":U THEN
 239       /* NOTE: You can't set SCREEN-VALUE on Selection lists until they
 240          have been parented and realized. */
 241       CREATE SELECTION-LIST h_list ASSIGN
 242         SCROLLBAR-VERTICAL = yes
 243         DELIMITER  = c_delimiter
 244         LIST-ITEMS = c_options-list
 245         .
 246     WHEN "COMBO-BOX":U THEN
 247       CREATE COMBO-BOX h_list ASSIGN
 248         DELIMITER    = c_delimiter
 249         FORMAT       = 'x(256)':U     /* Otherwise items get truncated. */
 250         LIST-ITEMS   = c_options-list
 251         INNER-LINES  = MAX(3, MIN ( 1 + h_list:NUM-ITEMS, 10))
 252         SCREEN-VALUE = c_initial-case
 253         .
 254     WHEN "HORIZONTAL RADIO-SET":U OR WHEN "VERTICAL RADIO-SET":U THEN DO:
 255       /* Copy the options list into a form that a radio-set understands. */
 256       ASSIGN c_btns = '':U
 257              c_ibtn = ?
 258              iCnt   = NUM-ENTRIES (c_options-list, c_delimiter).
 259       DO i = 1 TO iCnt:
 260         /* Get each entry and remove any commas. Create a comma delimited
 261            list of the form "option,1,option,2,etc.". This will be used to
 262            set the radio-buttons.*/
 263         ASSIGN ch = ENTRY(i, c_options-list, c_delimiter)
 264                ch = REPLACE (ch, ",", '')
 265                c_btns = c_btns + (IF i > 1 THEN ',':U ELSE '':U) +
 266                         ch + ',':U + STRING(i).
 267         /* Remember the initial button. */
 268         IF c_initial-case eq ch THEN c_ibtn = STRING(i).
 269       END. /* DO i... */
 270       IF iCnt > 0 THEN
 271         CREATE RADIO-SET h_list ASSIGN
 272           HORIZONTAL    = (c_style BEGINS "H":U)
 273           RADIO-BUTTONS = c_btns
 274           SCREEN-VALUE  = c_ibtn.
 275     END.
 276   END CASE.
 277
 278   /* Parent the list to the frame and size it using the default behavior
 279      of the resize algorithm. */
 280   IF VALID-HANDLE (h_list) THEN DO:
 281     /* Parent the list, and give it a label (with accelerator key). */
 282     ASSIGN h_list:FRAME = FRAME {&FRAME-NAME}:HANDLE
 283            h_list:SIDE-LABEL-HANDLE = c-Label:HANDLE IN FRAME {&FRAME-NAME}
 284            .
 285
 286     /* Populate the list and add triggers (at run-time only). */
 287     RUN get-attribute ('UIB-Mode':U).
 288     IF RETURN-VALUE eq ? THEN DO:
 289       h_list:SENSITIVE = yes.
 290       ON VALUE-CHANGED OF h_list PERSISTENT
 291         RUN send-case-across-link IN THIS-PROCEDURE.
 292     END.
 293
 294     /* Resize everthing. */
 295     IF h_list:TYPE <> 'COMBO-BOX':U THEN
 296       RUN set-size ( FRAME {&FRAME-NAME}:HEIGHT-CHARS ,
 297         h_list:WIDTH-CHARS + RECT-1:COL * 4).
 298     ELSE
 299       RUN set-size( ?, ? ).
 300
 301     /* Make sure the options don't cover other controls on the frame
 302        (including the UIB-Mode "system" menu). */
 303     l_dummy = h_list:MOVE-TO-BOTTOM().
 304
 305   END.
 306 END PROCEDURE.
 307
 308 /* _UIB-CODE-BLOCK-END */
 309 &ANALYZE-RESUME
 310
 311 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI s-object  _DEFAULT-DISABLE
 312 PROCEDURE disable_UI :
 313 /*------------------------------------------------------------------------------
 314   Purpose:     DISABLE the User Interface
 315   Parameters:  <none>
 316   Notes:       Here we clean-up the user-interface by deleting
 317                dynamic widgets we have created and/or hide
 318                frames.  This procedure is usually called when
 319                we are ready to "clean-up" after running.
 320 ------------------------------------------------------------------------------*/
 321   /* Hide all frames. */
 322   HIDE FRAME F-Main.
 323   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 324 END PROCEDURE.
 325
 326 /* _UIB-CODE-BLOCK-END */
 327 &ANALYZE-RESUME
 328
 329 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-initialize s-object
 330 PROCEDURE local-initialize :
 331 /*------------------------------------------------------------------------------
 332   Purpose:     Override standard ADM method
 333   Notes:
 334 ------------------------------------------------------------------------------*/
 335
 336   /* Retrieve the list of options (at run-time). */
 337
 338   RUN get-attribute ('UIB-Mode':U).
 339   IF RETURN-VALUE eq ? THEN DO:
 340     RUN retrieve-options-list.
 341     RUN retrieve-style.
 342   END.
 343
 344   /* Make sure that there is some default style for the option list. */
 345   RUN get-attribute ('Style':U).
 346   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Style = Selection-List':U).
 347
 348   /* Dispatch standard ADM method.                             */
 349   RUN dispatch IN THIS-PROCEDURE ( INPUT 'initialize':U ) .
 350
 351   /* Apply the style - this will create the COMBO-BOX, SELECTION-LIST, etc.
 352      NOTE that we require that the frame is visible before we create any
 353      of the contained widgets. */
 354   RUN get-attribute ('Hide-On-Init':U).
 355   IF RETURN-VALUE NE "YES":U THEN
 356     VIEW FRAME {&FRAME-NAME}.
 357   RUN apply-style.
 358
 359   /* Code placed here will execute AFTER standard behavior.
 360      These attributes don't effect the visualization of the object, so we
 361      process them last. */
 362
 363   /* Selection-Lists cannot have their initial value set prior to visualization,
 364      so set those here. */
 365   IF VALID-HANDLE(h_list)
 366      AND h_list:TYPE eq 'SELECTION-LIST':U
 367      AND c_initial-case ne ?
 368   THEN h_list:SCREEN-VALUE = c_initial-case.
 369
 370 END PROCEDURE.
 371
 372 /* _UIB-CODE-BLOCK-END */
 373 &ANALYZE-RESUME
 374
 375 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-UIB-mode s-object
 376 PROCEDURE local-UIB-mode :
 377 /*------------------------------------------------------------------------------
 378   Purpose:     Override standard ADM method. If the object has just been drawn
 379                in the UIB, then make sure it is sized correctly.
 380
 381   Notes:
 382 ------------------------------------------------------------------------------*/
 383
 384   /* Code placed here will execute PRIOR to standard behavior. */
 385
 386   /* Dispatch standard ADM method.                             */
 387   RUN dispatch IN THIS-PROCEDURE ( INPUT 'UIB-mode':U ) .
 388
 389   /* Code placed here will execute AFTER standard behavior.    */
 390   RUN get-attribute ('Drawn-in-UIB':U).
 391   IF RETURN-VALUE eq ? THEN DO:
 392
 393     /* Mark this as having been drawn. */
 394     RUN set-attribute-list ('Drawn-in-UIB=yes':U).
 395
 396     RUN set-default-attributes.
 397
 398     /* Allow the developer to edit these initial values at Design time
 399        (i.e. when UIB-Mode ne "Preview".) */
 400     RUN get-attribute ('UIB-Mode':U).
 401     IF RETURN-VALUE eq 'Design':U THEN RUN dispatch ('edit-attribute-list':U).
 402
 403     /* Use the new values for these attributes. */
 404     RUN use-label.
 405
 406     /* Make sure the object has been sized correctly. (This will process
 407        edge-pixels and margin-pixels.) */
 408     RUN set-size IN THIS-PROCEDURE
 409         (FRAME {&FRAME-NAME}:HEIGHT, FRAME {&FRAME-NAME}:WIDTH).
 410
 411   END.
 412
 413 END PROCEDURE.
 414
 415 /* _UIB-CODE-BLOCK-END */
 416 &ANALYZE-RESUME
 417
 418 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE retrieve-options-list s-object
 419 PROCEDURE retrieve-options-list :
 420 /*------------------------------------------------------------------------------
 421   Purpose:     This procedure asks the relevant linked object to return the
 422                list of valid-options.
 423   Parameters:  <none>
 424   Notes:       Their can only be a single linked object.
 425 ------------------------------------------------------------------------------*/
 426   DEF VAR c_list       AS CHAR NO-UNDO.
 427   DEF VAR case-attr    AS CHAR NO-UNDO.
 428   DEF VAR h_linked-SmO AS HANDLE NO-UNDO.
 429   DEF VAR iCnt         AS INTEGER NO-UNDO.
 430   DEF VAR link-name    AS CHAR NO-UNDO.
 431   DEF VAR options-attr AS CHAR NO-UNDO.
 432
 433   /*
 434    * Get all the objects linked using "link-name". Set the option attribute in
 435    * those objects.
 436    */
 437
 438   /* STEP 1 - get the name of the link, and the attribute to set.
 439    *          Check for errors. */
 440   RUN get-attribute ('Link-Name':U).
 441   link-name = RETURN-VALUE.
 442   RUN get-attribute ('Options-Attribute':U).
 443   options-attr = RETURN-VALUE.
 444   RUN get-attribute ('Case-Attribute':U).
 445   case-attr = RETURN-VALUE.
 446   IF NOT (LENGTH(link-name) > 0         /* Check for UNKNOWN or blank */
 447           AND LENGTH(options-attr) > 0  /* Check for UNKNOWN or blank */
 448           AND LENGTH(case-attr) > 0)    /* Check for UNKNOWN or blank */
 449   THEN MESSAGE THIS-PROCEDURE:FILE-NAME SKIP
 450          "This SmartObject was not correctly initialized."
 451          IF NOT LENGTH(link-name) > 0    THEN CHR(10) + " - Link-Name not set"  ELSE ""
 452          IF NOT LENGTH(options-attr) > 0 THEN CHR(10) + " - Options-Attribute not set" ELSE ""
 453          IF NOT LENGTH(case-attr) > 0    THEN CHR(10) + " - Case-Attribute not set" ELSE ""
 454          VIEW-AS ALERT-BOX ERROR.
 455   ELSE DO:
 456     /* STEP 2 - get the linked object.
 457      *          Check for errors. */
 458     RUN get-link-handle IN adm-broker-hdl (THIS-PROCEDURE, link-name, OUTPUT c_list).
 459     iCnt = NUM-ENTRIES (c_list).
 460     IF iCnt > 1 THEN
 461       MESSAGE "Multiple" link-name + "s exist for this SmartObject."
 462               "Therefore the list of options cannot be retrieved."
 463               VIEW-AS ALERT-BOX WARNING.
 464     ELSE IF iCnt = 0 THEN RETURN.
 465     ELSE DO:
 466       /* STEP 3 - Get the option attribute and case attribute in the linked object.
 467        *          Check for errors. */
 468       h_linked-SmO = WIDGET-HANDLE (c_list).
 469       IF VALID-HANDLE (h_linked-SmO) THEN DO:
 470         RUN get-attribute IN h_linked-SmO (options-attr).
 471         c_options-list = RETURN-VALUE.
 472         IF c_options-list eq ?
 473         THEN MESSAGE 'The SmartObject,' THIS-PROCEDURE:FILE-NAME +
 474                      ', cannot retrieve the list of options from its'
 475                      link-name + ',' h_linked-SmO:FILE-NAME +
 476                      ', because that SmartObject does not define the'
 477                      options-attr 'attribute.'
 478                      VIEW-AS ALERT-BOX ERROR.
 479         ELSE DO:
 480           /* Get the initial value of the 'Case-Attribute'.
 481            * Assign the list of options, and this initial condition.
 482            */
 483           RUN get-attribute IN h_Linked-SmO (case-attr).
 484           c_initial-case = RETURN-VALUE.
 485         END.
 486         /* Look for a "Delimiter" attribute. If it is not there, then
 487          * guess at the delimiter. Assume it is ",", however also look for "|"
 488          * and CHR(10) if there are < 2 comma delimited options.
 489          */
 490         RUN get-attribute ('Delimiter':U).
 491         IF RETURN-VALUE eq ? OR RETURN-VALUE eq "" THEN DO:
 492           c_delimiter = ",":U.
 493           IF NUM-ENTRIES(c_options-list, c_delimiter) < 2 THEN DO:
 494             IF NUM-ENTRIES(c_options-list, "|":U) > 1 THEN
 495               c_delimiter = "|":U.
 496             ELSE IF NUM-ENTRIES(c_options-list, CHR(10)) > 1 THEN
 497               c_delimiter = CHR(10).
 498           END. /* IF...delimiter) < 2... */
 499         END.
 500         ELSE DO:
 501           /* Check for special values. */
 502           CASE RETURN-VALUE:
 503             WHEN "COMMA":U     THEN c_delimiter = ",":U.
 504             WHEN "LINE-FEED":U THEN c_delimiter = CHR(10).
 505             WHEN "SPACE":U     THEN c_delimiter = " ":U.
 506             OTHERWISE  c_delimiter = SUBSTRING(RETURN-VALUE, 1, 1, "CHARACTER":U).
 507           END CASE.
 508         END. /* IF RETURN-VALUE... */
 509       END. /* IF VALID...h_linked-SmO... */
 510     END. /* ELSE DO...STEP 3 ... */
 511   END. /* ELSE DO...STEP 2 ... */
 512 END PROCEDURE.
 513
 514 /* _UIB-CODE-BLOCK-END */
 515 &ANALYZE-RESUME
 516
 517 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE retrieve-style s-object
 518 PROCEDURE retrieve-style :
 519 /*------------------------------------------------------------------------------
 520   Purpose:     This procedure asks the relevant linked object to return the
 521                appropriate style attribute.
 522   Parameters:  <none>
 523   Notes:       Their can only be a single linked object.
 524 ------------------------------------------------------------------------------*/
 525   DEF VAR c_list       AS CHAR NO-UNDO.
 526   DEF VAR style-attr   AS CHAR NO-UNDO.
 527   DEF VAR c_style      AS CHAR NO-UNDO.
 528   DEF VAR h_linked-SmO AS HANDLE NO-UNDO.
 529   DEF VAR iCnt         AS INTEGER NO-UNDO.
 530   DEF VAR link-name    AS CHAR NO-UNDO.
 531
 532   /* STEP 1 - get the name of the link, and the attribute to retrieve.
 533    *          Check for errors. */
 534   RUN get-attribute ('Link-Name':U).
 535   link-name = RETURN-VALUE.
 536   RUN get-attribute ('Style-Attribute':U).
 537   style-attr = RETURN-VALUE.
 538
 539   IF NOT LENGTH( style-attr ) > 0 THEN RETURN.
 540
 541   IF NOT LENGTH(link-name) > 0         /* Check for UNKNOWN or blank */
 542   THEN
 543     MESSAGE THIS-PROCEDURE:FILE-NAME SKIP
 544       "This SmartObject was not correctly initialized."
 545         CHR(10) + " - Link-Name not set"
 546        VIEW-AS ALERT-BOX ERROR.
 547   ELSE DO:
 548     /* STEP 2 - get the linked object.
 549      *          Check for errors. */
 550     RUN get-link-handle IN adm-broker-hdl (THIS-PROCEDURE, link-name, OUTPUT c_list).
 551     iCnt = NUM-ENTRIES (c_list).
 552     IF iCnt > 1 THEN
 553       MESSAGE "Multiple" link-name + "s exist for this SmartObject."
 554               "Therefore the list of options cannot be retrieved."
 555               VIEW-AS ALERT-BOX WARNING.
 556     ELSE IF iCnt = 0 THEN RETURN.
 557     ELSE DO:
 558       /* STEP 3 - Get the style attribute in the linked object.
 559        *          Check for errors. */
 560       h_linked-SmO = WIDGET-HANDLE (c_list).
 561       IF VALID-HANDLE (h_linked-SmO) THEN DO:
 562         RUN get-attribute IN h_linked-SmO (style-attr).
 563         c_style = RETURN-VALUE.
 564         IF NOT c_style eq ? THEN
 565           RUN set-attribute-list ('Style = ' + c_style).
 566
 567       END. /* IF VALID...h_linked-SmO... */
 568     END. /* ELSE DO...STEP 3 ... */
 569   END. /* ELSE DO...STEP 2 ... */
 570
 571 END PROCEDURE.
 572
 573 /* _UIB-CODE-BLOCK-END */
 574 &ANALYZE-RESUME
 575
 576 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-case-across-link s-object
 577 PROCEDURE send-case-across-link :
 578 /*------------------------------------------------------------------------------
 579   Purpose:     Sends the option case to the linked target, and optionally
 580                dispatches and event (such as 'open-query') to it.
 581   Parameters:  <none>
 582   Notes:
 583 ------------------------------------------------------------------------------*/
 584   DEF VAR c_case       AS CHAR NO-UNDO.
 585   DEF VAR c_list       AS CHAR NO-UNDO.
 586   DEF VAR case-attr    AS CHAR NO-UNDO.
 587   DEF VAR h_linked-SmO AS HANDLE NO-UNDO.
 588   DEF VAR iCnt         AS INTEGER NO-UNDO.
 589   DEF VAR link-name    AS CHAR NO-UNDO.
 590
 591   /*
 592    * Get all the objects linked using "link-name". Set the option attribute in
 593    * those objects.
 594    */
 595
 596   /* STEP 1 - get the name of the link, and the attribute to set.
 597    *          Check for errors. */
 598   RUN get-attribute ('Link-Name':U).
 599   link-name = RETURN-VALUE.
 600   RUN get-attribute ('Case-Attribute':U).
 601   case-attr = RETURN-VALUE.
 602  /* Verify that everything is valid. [Errors would have been reported in
 603      the retrieve-options-list procedure.] */
 604   IF LENGTH(link-name) > 0        /* Check for UNKNOWN or blank */
 605      AND LENGTH(case-attr) > 0    /* Check for UNKNOWN or blank */
 606      AND VALID-HANDLE(h_list)
 607   THEN DO:
 608     /* STEP 2 - Get the list of linked objects.
 609      *          Check for errors. */
 610     RUN get-link-handle IN adm-broker-hdl (THIS-PROCEDURE, link-name, OUTPUT c_list).
 611     iCnt = NUM-ENTRIES (c_list).
 612     IF iCnt = 0 THEN
 613       MESSAGE "No" link-name "exists for this object." VIEW-AS ALERT-BOX WARNING.
 614     ELSE IF iCnt > 1 THEN
 615       MESSAGE "Multiple" link-name + "s exist for this object." SKIP(1)
 616               "Command cancelled."
 617               VIEW-AS ALERT-BOX WARNING.
 618     ELSE DO:
 619       /* STEP 3 - Set the option attribute in the linked object.
 620        *          Check for errors.  NOTE: the value of the option is
 621        *          currently set in the the h_list widget, except for
 622        *          radio-sets where we need to take the entry and look
 623        *          it up in the option list. */
 624       ASSIGN h_linked-SmO = WIDGET-HANDLE (c_list)
 625              c_case       = h_list:SCREEN-VALUE.
 626       IF h_list:TYPE eq 'RADIO-SET':U
 627       THEN c_case = ENTRY(INTEGER(c_case), c_options-list, c_delimiter).
 628       IF VALID-HANDLE (h_linked-SmO) THEN DO:
 629         RUN set-attribute-list IN h_linked-SmO
 630                 (case-attr + '=':U + c_case).
 631         /*
 632          * Dispatch any case processing event to the linked object (if necessary)
 633          */
 634         RUN get-attribute IN THIS-PROCEDURE ('Case-Changed-Event':U).
 635         IF NUM-ENTRIES(RETURN-VALUE) > 0 THEN RUN dispatch IN h_linked-SmO (RETURN-VALUE).
 636
 637         RUN dispatch IN h_linked-SmO ( 'apply-entry':U ).
 638
 639       END. /* IF VALID...h_linked-SmO... */
 640     END. /* ELSE DO...STEP 3 ... */
 641   END. /* ELSE DO...STEP 2 ... */
 642 END PROCEDURE.
 643
 644 /* _UIB-CODE-BLOCK-END */
 645 &ANALYZE-RESUME
 646
 647 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-default-attributes s-object
 648 PROCEDURE set-default-attributes :
 649 /*------------------------------------------------------------------------------
 650   Purpose:     Set the default attributes for this amrt panel
 651   Parameters:  <none>
 652   Notes:
 653 ------------------------------------------------------------------------------*/
 654
 655   /* Set default values for Parameters */
 656
 657   RUN get-attribute ('Case-Attribute':U).
 658   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Case-Attribute = SortBy-Case':U).
 659   RUN get-attribute ('Case-Changed-Event':U).
 660   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Case-Changed-Event = Open-Query':U).
 661   RUN get-attribute ('Dispatch-Open-Query':U).
 662   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Dispatch-Open-Query = yes':U).
 663   RUN get-attribute ('Edge-Pixels':U).
 664   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Edge-Pixels = 2':U).
 665   RUN get-attribute ('Label':U).
 666   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Label = &Sort By':U).
 667   RUN get-attribute ('Link-Name':U).
 668   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Link-Name = SortBy-Target':U).
 669   RUN get-attribute ('Margin-Pixels':U).
 670   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Margin-Pixels = 2':U).
 671   RUN get-attribute ('Options-Attribute':U).
 672   IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Options-Attribute = SortBy-Options':U).
 673
 674 END PROCEDURE.
 675
 676 /* _UIB-CODE-BLOCK-END */
 677 &ANALYZE-RESUME
 678
 679 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-size s-object
 680 PROCEDURE set-size :
 681 /*------------------------------------------------------------------------------
 682   Purpose: Changes the size and shape of the panel.  This routine
 683            spaces the buttons to fill the available space.
 684   Parameters:
 685            pd_height - the desired height (in rows)
 686            pd_width  - the desired width (in columns)
 687   Notes:
 688            If pd_width or pd_height are ? then use the current values.
 689            (i.e. RUN set-size (?,?) resets the current size).
 690 ------------------------------------------------------------------------------*/
 691   DEFINE INPUT PARAMETER pd_height AS DECIMAL NO-UNDO.
 692   DEFINE INPUT PARAMETER pd_width  AS DECIMAL NO-UNDO.
 693
 694   DEFINE VAR btn-height-p  AS INTEGER NO-UNDO.
 695   DEFINE VAR btn-width-p   AS INTEGER NO-UNDO.
 696   DEFINE VAR h             AS WIDGET  NO-UNDO.
 697   DEFINE VAR i_margin      AS INTEGER NO-UNDO. /* Margin from frame to buttons */
 698   DEFINE VAR i_border-h    AS INTEGER NO-UNDO. /* Horizontal frame border      */
 699   DEFINE VAR i_border-v    AS INTEGER NO-UNDO. /* Vertical frame border        */
 700   DEFINE VAR i_box-y       AS INTEGER NO-UNDO. /* Start of BOX-RECTANGLE       */
 701   DEFINE VAR i_lbl-hgt-p   AS INTEGER NO-UNDO. /* Height of (label) Font       */
 702   DEFINE VAR i_test        AS INTEGER NO-UNDO.
 703   DEFINE VAR i_height-p    AS INTEGER NO-UNDO. /* Desired frame height, pixels */
 704   DEFINE VAR i_width-p     AS INTEGER NO-UNDO. /* Desired frame width, pixels  */
 705   DEFINE VAR l_box-hidden  AS LOGICAL NO-UNDO.
 706   DEFINE VAR l_hidden      AS LOGICAL NO-UNDO.
 707   DEFINE VAR l_selected    AS LOGICAL NO-UNDO.
 708   DEFINE VAR min-height    AS DECIMAL NO-UNDO. /* Minumum frame height, chars  */
 709   DEFINE VAR min-width     AS DECIMAL NO-UNDO. /* Minumum frame width, chars   */
 710   DEFINE VAR num-rows      AS INTEGER NO-UNDO.
 711   DEFINE VAR num-cols      AS INTEGER NO-UNDO.
 712   DEFINE VAR p-width-p     AS INTEGER NO-UNDO. /* Width of all panel buttons   */
 713   DEFINE VAR p-height-p    AS INTEGER NO-UNDO. /* Height of all panel buttons  */
 714
 715   /* There is a case where we want to just run the resizing logic, without
 716      changing the size. If ? is passed in, use the current sizes. */
 717   IF pd_height eq ? THEN pd_height = FRAME {&FRAME-NAME}:HEIGHT.
 718   IF pd_width eq ?  THEN pd_width  = FRAME {&FRAME-NAME}:WIDTH.
 719
 720   DO WITH FRAME {&FRAME-NAME}:
 721     /* The margin is based on the standard column width, unless specified
 722        as an attribute. */
 723     RUN get-attribute IN THIS-PROCEDURE ('Margin-Pixels':U).
 724     IF RETURN-VALUE eq ?
 725     THEN i_margin = SESSION:PIXELS-PER-COLUMN.
 726     ELSE i_margin = INTEGER(RETURN-VALUE).
 727
 728     /* If there is a label, then this will move the top margin. */
 729     &IF "{&Label}" ne "" &THEN
 730       IF {&Label}:SCREEN-VALUE ne "":U THEN DO:
 731        i_lbl-hgt-p = FONT-TABLE:GET-TEXT-HEIGHT-P (FRAME {&FRAME-NAME}:FONT).
 732        &IF "{&Box-Rectangle}" ne ""
 733        &THEN i_box-Y = MAX(0, i_lbl-hgt-p - {&Box-Rectangle}:EDGE-PIXELS) / 2.
 734        &ELSE i_box-Y = i_lbl-hgt-p.
 735        &ENDIF
 736       END.
 737     &ELSE
 738     ASSIGN i_lbl-hgt-p = 0
 739            i_box-Y     = 0.
 740     &ENDIF
 741     /* Don't allow a size that won't hold the margins, the frame borders, the
 742        label and the UIB "affordance" menu (about 16 pixels square, located at
 743        (4,4)) [Add in an extra 2 pixels for a fudge factor].
 744        Note that if we need to increase the size based on a minumum,
 745        then we will need to verify that the frame will still fit in its parent.  One final check
 746        is to guarantee that each row and column is at least one pixel (this is only
 747        a problem if you have more than about 16 buttons). */
 748        ASSIGN min-height = (MAX (22, 1 + (2 * i_margin) + i_box-Y, i_lbl-hgt-p) / SESSION:PIXELS-PER-ROW) +
 749                            FRAME {&FRAME-NAME}:BORDER-TOP + FRAME {&FRAME-NAME}:BORDER-BOTTOM
 750               min-width  = (MAX (22, 1 + 2 * i_margin) / SESSION:PIXELS-PER-COLUMN) +
 751                            FRAME {&FRAME-NAME}:BORDER-LEFT + FRAME {&FRAME-NAME}:BORDER-RIGHT.
 752
 753     /* Hide the frame to reduce "flashing". Remember if it was already
 754        hidden, so we don't view it unnecessarily at the end of this
 755        procedure. (NOTE: Hiding a SELECTED frame turns off the Selection,
 756        so we save the value to use when we make the Frame visible again.) */
 757     ASSIGN l_selected = FRAME {&FRAME-NAME}:SELECTED
 758            l_hidden   = FRAME {&FRAME-NAME}:HIDDEN
 759            FRAME {&FRAME-NAME}:HIDDEN = yes
 760            NO-ERROR.
 761
 762     /* Do we need to adjust the size (and position). */
 763     IF min-height > pd_height OR min-width > pd_width THEN DO:
 764       /* Get the parent to insure that the frame will still fit inside it. */
 765       h = FRAME {&FRAME-NAME}:PARENT.
 766       IF h:TYPE ne "WINDOW":U THEN h = FRAME {&FRAME-NAME}:FRAME.
 767       /* Test width. */
 768       IF min-width > pd_width THEN DO:
 769         ASSIGN pd_width  = min-width
 770                i_width-p = 1 + (pd_width * SESSION:PIXELS-PER-COLUMN)
 771                i_test    = IF h:TYPE eq "WINDOW":U OR h:SCROLLABLE
 772                            THEN h:VIRTUAL-WIDTH-P
 773                            ELSE h:WIDTH-P - h:BORDER-LEFT-P - h:BORDER-RIGHT-P.
 774         IF i_test < FRAME {&FRAME-NAME}:X + i_width-p
 775         THEN ASSIGN FRAME {&FRAME-NAME}:X = MAX(0, i_test - i_width-p) NO-ERROR.
 776       END.
 777       /* Test height. */
 778       IF min-height > pd_height THEN DO:
 779         ASSIGN pd_height  = min-height
 780                i_height-p = 1 + (pd_height * SESSION:PIXELS-PER-ROW)
 781                i_test     = IF h:TYPE eq "WINDOW":U OR h:SCROLLABLE
 782                             THEN h:VIRTUAL-HEIGHT-P
 783                             ELSE h:HEIGHT-P - h:BORDER-TOP-P - h:BORDER-BOTTOM-P.
 784         IF i_test < FRAME {&FRAME-NAME}:Y + i_height-p
 785         THEN ASSIGN FRAME {&FRAME-NAME}:Y = MAX(0, i_test - i_height-p) NO-ERROR.
 786       END.
 787     END.
 788
 789     /* Resize the frame and determine values based on the desired size. */
 790     ASSIGN
 791         FRAME {&FRAME-NAME}:SCROLLABLE = yes
 792         FRAME {&FRAME-NAME}:WIDTH      = pd_width
 793         FRAME {&FRAME-NAME}:HEIGHT     = pd_height
 794         /* Convert from Decimal width and height be reading from the
 795            FRAME itself. */
 796         i_width-p    = FRAME {&FRAME-NAME}:WIDTH-P
 797         i_height-p   = FRAME {&FRAME-NAME}:HEIGHT-P
 798         /* Save the calculation of frame borders */
 799         i_border-v   = FRAME {&FRAME-NAME}:BORDER-TOP-P +
 800                        FRAME {&FRAME-NAME}:BORDER-BOTTOM-P
 801         i_border-h   = FRAME {&FRAME-NAME}:BORDER-LEFT-P +
 802                        FRAME {&FRAME-NAME}:BORDER-RIGHT-P
 803         /* Compute the total width/height of the objects in the panel.
 804            That is, subtract all the margins, decoration, and borders
 805            from the frame size. */
 806         p-width-p    = i_width-p - i_border-h - (2 * i_margin)
 807         p-height-p   = i_height-p - i_border-v - i_box-Y - (2 * i_margin)
 808       NO-ERROR.
 809
 810     /* Resize the list object. */
 811     IF VALID-HANDLE (h_list) THEN DO:
 812       ASSIGN h_list:HIDDEN   = yes
 813              h_list:WIDTH-P  = p-width-p
 814              h_list:X        = i_margin
 815              h_list:Y        = i_box-Y + i_margin
 816            NO-ERROR.
 817       /* Height (and visibility) conditions will depend on the type of object. */
 818       IF h_list:TYPE eq 'COMBO-BOX':U THEN DO:
 819         /* Hide combo-box if frame is too small. */
 820         ASSIGN h_list:HIDDEN = (p-height-p < h_list:HEIGHT-P) NO-ERROR.
 821       END. /*...combo-box... */
 822       ELSE IF h_list:TYPE eq 'RADIO-SET':U AND NOT h_list:HORIZONTAL THEN DO:
 823         /* Size the Radio-Buttons based on the text-height */
 824         ASSIGN h_list:HEIGHT-P = MIN (p-height-p,
 825                                       (FONT-TABLE:GET-TEXT-HEIGHT-P (FRAME {&FRAME-NAME}:FONT) + 4) *
 826                                       NUM-ENTRIES(h_list:RADIO-BUTTONS) / 2)
 827                h_list:HIDDEN   = no
 828              NO-ERROR.
 829       END.
 830       ELSE DO:
 831         ASSIGN h_list:HEIGHT-P = p-height-p
 832                h_list:HIDDEN   = no
 833              NO-ERROR.
 834       END. /* ELSE DO:... */
 835     END.
 836
 837     /* If defined, set the Bounding Rectangle size. */
 838     &IF "{&Box-Rectangle}" ne "" &THEN
 839       ASSIGN l_box-hidden              = {&Box-Rectangle}:HIDDEN
 840              {&Box-Rectangle}:HIDDEN   = yes
 841              {&Box-Rectangle}:X        = 0
 842              {&Box-Rectangle}:Y        = i_box-Y
 843              {&Box-Rectangle}:WIDTH-P  = i_width-p - i_border-h
 844              /* If the contained object is shorter than the frame (e.g. for
 845                 a combo-box, set the height of the rectangle based on the object. */
 846              {&Box-Rectangle}:HEIGHT-P =
 847                   MIN(i_height-p - i_border-v,
 848                       IF VALID-HANDLE(h_list)
 849                       THEN h_list:Y + h_list:HEIGHT-P + i_margin
 850                       ELSE i_height-p)
 851                    - i_box-Y
 852              {&Box-Rectangle}:HIDDEN   = l_box-hidden
 853             NO-ERROR.
 854     &ENDIF
 855
 856     /* If defined, set the LABEL width. */
 857     &IF "{&Label}" ne "" &THEN
 858       ASSIGN {&Label}:HIDDEN   = yes
 859              {&Label}:X        = i_margin
 860              {&Label}:Y        = 0
 861              {&Label}:WIDTH-P  = MIN(FONT-TABLE:GET-TEXT-WIDTH-P
 862                                      ({&Label}:SCREEN-VALUE, FRAME {&FRAME-NAME}:FONT),
 863                                     i_width-p - {&Label}:X - i_border-h)
 864              {&Label}:HEIGHT-P = MIN(i_lbl-hgt-p, i_height-p - i_border-v)
 865              {&Label}:HIDDEN   = ({&LABEL}:SCREEN-VALUE eq "":U)
 866             NO-ERROR.
 867     &ENDIF
 868
 869     /* Show the frame. Turn off SCROLLABLE to force virtual size to match
 870        viewport size.  We will turn SCROLLABLE back on so that the SmartPanel
 871        can be resized smaller. */
 872     ASSIGN FRAME {&FRAME-NAME}:SCROLLABLE       = NO
 873            FRAME {&FRAME-NAME}:WIDTH-P          = i_width-p
 874            FRAME {&FRAME-NAME}:HEIGHT-P         = i_height-p
 875            NO-ERROR .
 876     /* Frame must be SCROLLABLE if it is to be resized smaller than its
 877        contained buttons and rectangles. */
 878     ASSIGN FRAME {&FRAME-NAME}:SCROLLABLE = YES.
 879
 880     /* View, and select, the frame, if necessary. */
 881     IF NOT l_hidden THEN FRAME {&FRAME-NAME}:HIDDEN   = no NO-ERROR.
 882     IF l_selected   THEN FRAME {&FRAME-NAME}:SELECTED = yes.
 883   END.
 884
 885 END PROCEDURE.
 886
 887 /* _UIB-CODE-BLOCK-END */
 888 &ANALYZE-RESUME
 889
 890 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed s-object
 891 PROCEDURE state-changed :
 892 /* -----------------------------------------------------------
 893   Purpose:
 894   Parameters:  <none>
 895   Notes:
 896 -------------------------------------------------------------*/
 897   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 898   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 899
 900   CASE p-state:
 901       /* Object instance CASEs can go here to replace standard behavior
 902          or add new cases. */
 903   END CASE.
 904 END PROCEDURE.
 905
 906 /* _UIB-CODE-BLOCK-END */
 907 &ANALYZE-RESUME
 908
 909 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-font s-object
 910 PROCEDURE use-font :
 911 /*------------------------------------------------------------------------------
 912   Purpose:  Get the current value of 'font' and set the font of the FRAME to this value.
 913   Parameters:  <none>
 914   Notes:
 915 ------------------------------------------------------------------------------*/
 916 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 917
 918 DEFINE VAR iFont AS INTEGER NO-UNDO INITIAL ?.
 919 DEFINE VAR h AS WIDGET NO-UNDO.
 920
 921   /* Convert attribute string to an INTEGER font value. */
 922   iFont = IF p_attr-value eq "?" THEN ? ELSE INTEGER(p_attr-value) NO-ERROR.
 923
 924   /* Is the correct font set already? */
 925   IF iFont ne FRAME {&FRAME-NAME}:FONT THEN FRAME {&FRAME-NAME}:FONT = iFont.
 926   /* If there is a LABEL, then resize the frame. */
 927   IF {&Label}:SCREEN-VALUE ne '':U THEN RUN set-size IN THIS-PROCEDURE (?,?).
 928
 929 END PROCEDURE.
 930
 931 /* _UIB-CODE-BLOCK-END */
 932 &ANALYZE-RESUME
 933
 934 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-label s-object
 935 PROCEDURE use-label :
 936 /*------------------------------------------------------------------------------
 937   Purpose:     Get the current value of 'Label' and set the Label object to this
 938                value.
 939   Parameters:  <none>
 940   Notes:
 941 ------------------------------------------------------------------------------*/
 942 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 943
 944 DEFINE VAR h AS WIDGET NO-UNDO.
 945
 946   {&Label} = IF p_attr-value eq "?" THEN '':U ELSE p_attr-value NO-ERROR.
 947
 948   /* Reset the Label and its width. (If this FAILS, then we may need to run
 949      the whole resize logic again. */
 950   DO WITH FRAME {&FRAME-NAME}:
 951     ASSIGN {&Label}:SCREEN-VALUE = {&Label}
 952            {&Label}:HIDDEN = {&Label}:SCREEN-VALUE eq '':U
 953            {&Label}:WIDTH-P = FONT-TABLE:GET-TEXT-WIDTH-P
 954                                 ({&Label}, FRAME {&FRAME-NAME}:FONT)
 955        NO-ERROR.
 956     IF ERROR-STATUS:ERROR THEN RUN set-size IN THIS-PROCEDURE (?,?).
 957   END. /* DO WITH FRAME... */
 958 END PROCEDURE.
 959
 960 /* _UIB-CODE-BLOCK-END */
 961 &ANALYZE-RESUME
 962
 963 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-link-name s-object
 964 PROCEDURE use-link-name :
 965 /*------------------------------------------------------------------------------
 966   Purpose:  Get the current value of 'Link-Name' and set the supported-links to
 967             be the inverse of this link.
 968   Parameters:  <none>
 969   Notes:
 970 ------------------------------------------------------------------------------*/
 971 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 972
 973 DEF VAR ch          AS CHAR NO-UNDO.
 974 DEF VAR i           AS INTEGER NO-UNDO.
 975 DEF VAR new-link    AS CHAR NO-UNDO.
 976
 977   new-link = IF p_attr-value eq "?" THEN ? ELSE p_attr-value NO-ERROR.
 978
 979   ASSIGN i = NUM-ENTRIES (new-link,"-":U)
 980          ch = IF i < 2 THEN '':U ELSE ENTRY(i,new-link, "-":U)
 981          .
 982   IF ch eq 'Source':U THEN ENTRY(i,new-link,"-":U) = 'Target':U.
 983   ELSE IF ch eq 'Target' THEN ENTRY(i,new-link,"-":U) = 'Source':U.
 984   ELSE DO:
 985     new-link = IF LENGTH(new-link) > 0 /* Could be empty or ? */
 986                           THEN new-link + '-Source':U
 987                           ELSE 'Option-Source':U.
 988
 989     /* Whoops! The Link-Name seems invalid...set it to something reasonable. */
 990     MESSAGE 'The Link-Name of the SmartObject does not indicate direction.'
 991             '(It does not specify "Target" or "-Source".)' SKIP(1)
 992             'The ADM Supported Links will be set to' new-link + '.':U
 993             VIEW-AS ALERT-BOX WARNING.
 994   END.
 995
 996   RUN set-attribute-list ( 'SUPPORTED-LINKS = ':U + new-link ).
 997
 998 END PROCEDURE.
 999
1000 /* _UIB-CODE-BLOCK-END */
1001 &ANALYZE-RESUME
1002