panel/p-search.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-search.w
   8
   9   Description:
  10       A SmartPanel that the user can type a text string into. The default string is
  11       retrieved from the linked object at initialization.:
  12
  13       RUN get-attribute IN <link> ('<Options-Attribute>':U).
  14
  15       When the user changes the value of the string and a timeout period
  16       expires, then the linked object is sent  the new value:
  17           RUN set-attribute-list IN <link> ('<Value-Attribute> = <value>':U)
  18
  19       This panel will also automatically dispatch an additional event to
  20       the linked object if the 'Value-Changed-Event' is also set:
  21           RUN dispatch IN <link> ('<Value-Changed-Event>').
  22
  23   Input Parameters:
  24       <none>
  25
  26   Output Parameters:
  27       <none>
  28
  29   Authors: Tyrone McAuley
  30   Created: July 1997
  31 ------------------------------------------------------------------------*/
  32 CREATE WIDGET-POOL.
  33
  34 /* Parameters Definitions ---                                           */
  35
  36 /* Local Variable Definitions ---                                       */
  37 DEF VAR c_text AS CHAR NO-UNDO.                    /* List of options.         */
  38 DEF VAR c_initial-text AS CHAR NO-UNDO.            /* Initial Text             */
  39 DEF VAR c_delimiter AS CHAR NO-UNDO INITIAL ",":U. /* The delimiter to use.    */
  40
  41 /* ADM Preprocessor Defintions ---                                      */
  42 &Scoped-define adm-attribute-dlg adm/support/optiond.w
  43
  44 DEF VAR key-pressed AS LOGI NO-UNDO INIT No.
  45 DEF VAR text-sent   AS LOGI NO-UNDO INIT Yes.
  46
  47 /* _UIB-CODE-BLOCK-END */
  48 &ANALYZE-RESUME
  49
  50
  51 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  52
  53 /* ********************  Preprocessor Definitions  ******************** */
  54
  55 &Scoped-define PROCEDURE-TYPE SmartPanel
  56 &Scoped-define DB-AWARE no
  57
  58 /* Name of first Frame and/or Browse and/or first Query                 */
  59 &Scoped-define FRAME-NAME F-Main
  60
  61 /* Standard List Definitions                                            */
  62 &Scoped-Define ENABLED-OBJECTS RECT-1 fil_value btn_Search
  63 &Scoped-Define DISPLAYED-OBJECTS fil_value
  64
  65 /* Custom List Definitions                                              */
  66 /* Box-Rectangle,Label,List-3,List-4,List-5,List-6                      */
  67 &Scoped-define Box-Rectangle RECT-1
  68 &Scoped-define Label c-Label
  69
  70 /* _UIB-PREPROCESSOR-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73
  74 /* ************************  Function Prototypes ********************** */
  75
  76 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD is-null s-object
  77 FUNCTION is-null RETURNS LOGICAL
  78   ( INPUT str AS CHAR )  FORWARD.
  79
  80 /* _UIB-CODE-BLOCK-END */
  81 &ANALYZE-RESUME
  82
  83
  84 /* ***********************  Control Definitions  ********************** */
  85
  86
  87 /* Definitions of the field level widgets                               */
  88 DEFINE BUTTON btn_Search
  89      LABEL "Search"
  90      SIZE 5.72 BY 1 TOOLTIP "Type in a value and press 'Search'"
  91      FONT 10.
  92
  93 DEFINE VARIABLE c-Label AS CHARACTER FORMAT "X(256)":U INITIAL "&Options"
  94       VIEW-AS TEXT
  95      SIZE 8 BY .6 NO-UNDO.
  96
  97 DEFINE VARIABLE fil_value AS CHARACTER FORMAT "X(256)":U
  98      VIEW-AS FILL-IN
  99      SIZE 8 BY 1 TOOLTIP "Type in a value and press 'Search'" NO-UNDO.
 100
 101 DEFINE RECTANGLE RECT-1
 102      EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
 103      SIZE 16 BY 1.5.
 104
 105
 106 /* ************************  Frame Definitions  *********************** */
 107
 108 DEFINE FRAME F-Main
 109      fil_value AT ROW 1.6 COL 2.14 NO-LABEL
 110      btn_Search AT ROW 1.6 COL 10.14
 111      c-Label AT ROW 1 COL 2 NO-LABEL
 112      RECT-1 AT ROW 1.3 COL 1
 113     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 114          SIDE-LABELS NO-UNDERLINE THREE-D
 115          AT COL 1 ROW 1 SCROLLABLE
 116          FGCOLOR 1 .
 117
 118
 119 /* *********************** Procedure Settings ************************ */
 120
 121 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 122 /* Settings for THIS-PROCEDURE
 123    Type: SmartPanel
 124    Allow: Basic
 125    Frames: 1
 126    Add Fields to: NEITHER
 127    Other Settings: PERSISTENT-ONLY COMPILE
 128  */
 129
 130 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 131 /* then cleanup and return.                                            */
 132 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 133   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
 134           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 135   RETURN.
 136 END.
 137
 138 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 139
 140 /* *************************  Create Window  ************************** */
 141
 142 &ANALYZE-SUSPEND _CREATE-WINDOW
 143 /* DESIGN Window definition (used by the UIB)
 144   CREATE WINDOW s-object ASSIGN
 145          HEIGHT             = 2.3
 146          WIDTH              = 34.43.
 147 /* END WINDOW DEFINITION */
 148                                                                         */
 149 &ANALYZE-RESUME
 150
 151 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB s-object
 152 /* ************************* Included-Libraries *********************** */
 153
 154 {src/adm/method/smart.i}
 155
 156 /* _UIB-CODE-BLOCK-END */
 157 &ANALYZE-RESUME
 158
 159
 160
 161
 162 /* ***********  Runtime Attributes and AppBuilder Settings  *********** */
 163
 164 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 165 /* SETTINGS FOR WINDOW s-object
 166   VISIBLE,,RUN-PERSISTENT                                               */
 167 /* SETTINGS FOR FRAME F-Main
 168    NOT-VISIBLE Size-to-Fit                                              */
 169 ASSIGN
 170        FRAME F-Main:SCROLLABLE       = FALSE
 171        FRAME F-Main:HIDDEN           = TRUE.
 172
 173 /* SETTINGS FOR FILL-IN c-Label IN FRAME F-Main
 174    NO-DISPLAY NO-ENABLE ALIGN-L 2                                       */
 175 ASSIGN
 176        c-Label:HIDDEN IN FRAME F-Main           = TRUE.
 177
 178 /* SETTINGS FOR FILL-IN fil_value IN FRAME F-Main
 179    ALIGN-L                                                              */
 180 /* SETTINGS FOR RECTANGLE RECT-1 IN FRAME F-Main
 181    1                                                                    */
 182 /* _RUN-TIME-ATTRIBUTES-END */
 183 &ANALYZE-RESUME
 184
 185
 186 /* Setting information for Queries and Browse Widgets fields            */
 187
 188 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 189 /* Query rebuild information for FRAME F-Main
 190      _Options          = "NO-LOCK"
 191      _Query            is NOT OPENED
 192 */  /* FRAME F-Main */
 193 &ANALYZE-RESUME
 194
 195
 196
 197
 198
 199 /* ************************  Control Triggers  ************************ */
 200
 201 &Scoped-define SELF-NAME btn_Search
 202 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_Search s-object
 203 ON CHOOSE OF btn_Search IN FRAME F-Main /* Search */
 204 DO:
 205   IF NOT text-sent THEN RUN send-case-across-link.
 206   text-sent = Yes.
 207   RETURN NO-APPLY.
 208 END.
 209
 210 /* _UIB-CODE-BLOCK-END */
 211 &ANALYZE-RESUME
 212
 213
 214 &Scoped-define SELF-NAME fil_value
 215 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fil_value s-object
 216 ON ANY-PRINTABLE OF fil_value IN FRAME F-Main
 217 OR "DELETE-CHARACTER" OF {&SELF-NAME}
 218 OR "BACKSPACE" OF {&SELF-NAME}
 219 DO:
 220   APPLY LASTKEY TO SELF.
 221   text-sent = No.
 222   key-pressed    = Yes.
 223   RETURN NO-APPLY.
 224 END.
 225
 226 /* _UIB-CODE-BLOCK-END */
 227 &ANALYZE-RESUME
 228
 229
 230 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fil_value s-object
 231 ON RETURN OF fil_value IN FRAME F-Main
 232 OR "ENTER" OF {&SELF-NAME}
 233 DO:
 234   APPLY 'LEAVE':U TO {&SELF-NAME}.
 235   APPLY 'CHOOSE':U TO btn_Search.
 236 END.
 237
 238 /* _UIB-CODE-BLOCK-END */
 239 &ANALYZE-RESUME
 240
 241
 242 &UNDEFINE SELF-NAME
 243
 244 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK s-object
 245
 246
 247 /* ***************************  Main Block  *************************** */
 248
 249   &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
 250     /* Code needed to test this object (when run directly from the UIB) */
 251     RUN set-default-attributes.
 252     RUN dispatch IN THIS-PROCEDURE ('initialize').
 253   &ENDIF
 254
 255   RUN set-default-attributes.
 256
 257 /* _UIB-CODE-BLOCK-END */
 258 &ANALYZE-RESUME
 259
 260
 261 /* **********************  Internal Procedures  *********************** */
 262
 263 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI s-object  _DEFAULT-DISABLE
 264 PROCEDURE disable_UI :
 265 /*------------------------------------------------------------------------------
 266   Purpose:     DISABLE the User Interface
 267   Parameters:  <none>
 268   Notes:       Here we clean-up the user-interface by deleting
 269                dynamic widgets we have created and/or hide
 270                frames.  This procedure is usually called when
 271                we are ready to "clean-up" after running.
 272 ------------------------------------------------------------------------------*/
 273   /* Hide all frames. */
 274   HIDE FRAME F-Main.
 275   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 276 END PROCEDURE.
 277
 278 /* _UIB-CODE-BLOCK-END */
 279 &ANALYZE-RESUME
 280
 281 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-initialize s-object
 282 PROCEDURE local-initialize :
 283 /*------------------------------------------------------------------------------
 284   Purpose:     Override standard ADM method
 285   Notes:
 286 ------------------------------------------------------------------------------*/
 287
 288 DO WITH FRAME {&FRAME-NAME}:
 289
 290   /* Retrieve the list of options (at run-time). */
 291
 292   RUN get-attribute ('UIB-Mode':U).
 293   IF RETURN-VALUE eq ? THEN DO:
 294     RUN retrieve-text.
 295   END.
 296
 297   /* Dispatch standard ADM method.                             */
 298   RUN dispatch IN THIS-PROCEDURE ( INPUT 'initialize':U ) .
 299   RUN get-attribute ('Hide-On-Init':U).
 300   IF RETURN-VALUE NE "YES":U THEN VIEW FRAME {&FRAME-NAME}.
 301
 302   /* Code placed here will execute AFTER standard behavior.
 303      These attributes don't effect the visualization of the object, so we
 304      process them last. */
 305
 306 END.
 307
 308 END PROCEDURE.
 309
 310 /* _UIB-CODE-BLOCK-END */
 311 &ANALYZE-RESUME
 312
 313 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-UIB-mode s-object
 314 PROCEDURE local-UIB-mode :
 315 /*------------------------------------------------------------------------------
 316   Purpose:     Override standard ADM method. If the object has just been drawn
 317                in the UIB, then make sure it is sized correctly.
 318
 319   Notes:
 320 ------------------------------------------------------------------------------*/
 321
 322   /* Code placed here will execute PRIOR to standard behavior. */
 323
 324   /* Dispatch standard ADM method.                             */
 325   RUN dispatch IN THIS-PROCEDURE ( INPUT 'UIB-mode':U ) .
 326
 327   /* Code placed here will execute AFTER standard behavior.    */
 328   RUN get-attribute ('Drawn-in-UIB':U).
 329   IF RETURN-VALUE eq ? THEN DO:
 330
 331     /* Mark this as having been drawn. */
 332     RUN set-attribute-list ('Drawn-in-UIB=yes':U).
 333
 334     RUN set-default-attributes.
 335
 336     /* Allow the developer to edit these initial values at Design time
 337        (i.e. when UIB-Mode ne "Preview".) */
 338     RUN get-attribute ('UIB-Mode':U).
 339     IF RETURN-VALUE eq 'Design':U THEN RUN dispatch ('edit-attribute-list':U).
 340
 341     /* Use the new values for these attributes. */
 342     RUN use-label.
 343
 344     /* Make sure the object has been sized correctly. (This will process
 345        edge-pixels and margin-pixels.) */
 346     RUN set-size IN THIS-PROCEDURE
 347         (FRAME {&FRAME-NAME}:HEIGHT, FRAME {&FRAME-NAME}:WIDTH).
 348
 349   END.
 350
 351 END PROCEDURE.
 352
 353 /* _UIB-CODE-BLOCK-END */
 354 &ANALYZE-RESUME
 355
 356 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE retrieve-text s-object
 357 PROCEDURE retrieve-text :
 358 /*------------------------------------------------------------------------------
 359   Purpose:     This procedure asks the relevant linked object to return the
 360                current text string.
 361   Parameters:  <none>
 362   Notes:       Their can only be a single linked object.
 363 ------------------------------------------------------------------------------*/
 364
 365   DEF VAR c_list       AS CHAR NO-UNDO.
 366   DEF VAR value-attr   AS CHAR NO-UNDO.
 367   DEF VAR h_target     AS HANDLE NO-UNDO.
 368   DEF VAR link-name    AS CHAR NO-UNDO.
 369
 370   /* STEP 1 - Get the name of the link, and the attribute to set.
 371    *          Check for errors. */
 372
 373   RUN get-attribute ('Link-Name':U).          link-name    = RETURN-VALUE.
 374   RUN get-attribute ('Value-Attribute':U).    value-attr   = RETURN-VALUE.
 375
 376   IF is-null( link-name ) OR is-null( value-attr ) THEN
 377
 378     MESSAGE THIS-PROCEDURE:FILE-NAME SKIP
 379       "This SmartObject was not correctly initialized."
 380       IF is-null( link-name)   THEN CHR(10) + " - Link-Name not set"  ELSE ""
 381       IF is-null( value-attr ) THEN CHR(10) + " - Value-Attribute not set" ELSE ""
 382        VIEW-AS ALERT-BOX ERROR.
 383
 384   ELSE
 385   DO:
 386
 387     /* STEP 2 - get the linked object.
 388      *          Check for errors. */
 389
 390     RUN get-link-handle IN adm-broker-hdl (THIS-PROCEDURE, link-name, OUTPUT c_list).
 391
 392     IF NUM-ENTRIES( c_list ) > 1 THEN
 393       MESSAGE "Multiple" link-name + "s exist for this SmartObject."
 394               "Therefore the list of options cannot be retrieved."
 395               VIEW-AS ALERT-BOX WARNING.
 396     ELSE IF NUM-ENTRIES( c_list ) = 0 THEN RETURN.
 397     ELSE
 398     DO WITH FRAME {&FRAME-NAME}:
 399
 400       /* STEP 3 - Get the option attribute and case attribute in the linked object.
 401        *          Check for errors. */
 402       h_target = WIDGET-HANDLE (c_list).
 403       IF VALID-HANDLE (h_target) THEN DO:
 404
 405           /* Get the initial value of the 'Value-Attribute'.
 406            * Assign the list of options, and this initial condition.
 407            */
 408           RUN get-attribute IN h_target (value-attr).
 409           c_initial-text = RETURN-VALUE.
 410           fil_value:SCREEN-VALUE = c_initial-text.
 411
 412       END. /* IF VALID...h_target... */
 413     END. /* ELSE DO...STEP 3 ... */
 414   END. /* ELSE DO...STEP 2 ... */
 415
 416 END PROCEDURE.
 417
 418 /* _UIB-CODE-BLOCK-END */
 419 &ANALYZE-RESUME
 420
 421 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-case-across-link s-object
 422 PROCEDURE send-case-across-link :
 423 /*------------------------------------------------------------------------------
 424   Purpose:     Sends the curren text to the linked target, and optionally
 425                dispatches and event (such as 'open-query') to it.
 426   Parameters:  <none>
 427   Notes:
 428 ------------------------------------------------------------------------------*/
 429
 430   DEF VAR c_value        AS CHAR NO-UNDO.
 431   DEF VAR c_list        AS CHAR NO-UNDO.
 432   DEF VAR value-attr    AS CHAR NO-UNDO.
 433   DEF VAR h_target  AS HANDLE NO-UNDO.
 434   DEF VAR link-name     AS CHAR NO-UNDO.
 435
 436   /* STEP 1 - get the name of the link, and the attribute to set.
 437    *          Check for errors. */
 438   RUN get-attribute ('Link-Name':U).        link-name  = RETURN-VALUE.
 439   RUN get-attribute ('Value-Attribute':U).  value-attr = RETURN-VALUE.
 440
 441  /* Verify that everything is valid. [Errors would have been reported in
 442      the retrieve-options-list procedure.] */
 443
 444   IF NOT ( is-null( link-name ) OR is-null( value-attr ) ) THEN
 445   DO:
 446
 447     /* STEP 2 - Get the list of linked objects.
 448      *          Check for errors. */
 449     RUN get-link-handle IN adm-broker-hdl (THIS-PROCEDURE, link-name, OUTPUT c_list).
 450
 451     IF NUM-ENTRIES( c_list ) = 0 THEN
 452       MESSAGE "No" link-name "exists for this object." VIEW-AS ALERT-BOX WARNING.
 453
 454     ELSE IF NUM-ENTRIES( c_list ) > 1 THEN
 455       MESSAGE "Multiple" link-name + "s exist for this object." SKIP(1)
 456               "Command cancelled."
 457               VIEW-AS ALERT-BOX WARNING.
 458     ELSE
 459     DO WITH FRAME {&FRAME-NAME}:
 460
 461       /* STEP 3 - Set the value attribute in the linked object. */
 462
 463       ASSIGN h_target = WIDGET-HANDLE (c_list).
 464
 465       IF VALID-HANDLE (h_target) THEN
 466       DO:
 467         RUN set-attribute-list IN h_target (value-attr + '=':U + INPUT fil_value ).
 468         RUN get-attribute IN THIS-PROCEDURE ('Value-Changed-Event':U).
 469         IF NUM-ENTRIES(RETURN-VALUE) > 0 THEN RUN dispatch IN h_target (RETURN-VALUE).
 470         /* RUN dispatch IN h_target ( 'apply-entry':U ). */
 471
 472       END. /* IF VALID...h_target... */
 473     END. /* ELSE DO...STEP 3 ... */
 474   END. /* ELSE DO...STEP 2 ... */
 475
 476   text-sent = Yes.
 477
 478 END PROCEDURE.
 479
 480 /* _UIB-CODE-BLOCK-END */
 481 &ANALYZE-RESUME
 482
 483 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-default-attributes s-object
 484 PROCEDURE set-default-attributes :
 485 /*------------------------------------------------------------------------------
 486   Purpose:     Set the default attributes for this amrt panel
 487   Parameters:  <none>
 488   Notes:
 489 ------------------------------------------------------------------------------*/
 490
 491   /* Set default values for Parameters */
 492   RUN get-attribute ('Edge-Pixels':U).
 493   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Edge-Pixels = 2':U).
 494   RUN get-attribute ('Margin-Pixels':U).
 495   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Margin-Pixels = 2':U).
 496
 497   RUN get-attribute ('Width':U).
 498   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Width = 15':U).
 499   RUN get-attribute ('Width':U).
 500   RUN set-size( 1, INT(RETURN-VALUE) ).
 501
 502   RUN get-attribute ('Value-Attribute':U).
 503   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Value-Attribute = SearchBy-Case':U).
 504   RUN get-attribute ('Value-Changed-Event':U).
 505   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Value-Changed-Event = Open-Query':U).
 506   RUN get-attribute ('Dispatch-Open-Query':U).
 507   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Dispatch-Open-Query = yes':U).
 508   RUN get-attribute ('Label':U).
 509   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Label = &Search By':U).
 510   RUN get-attribute ('Link-Name':U).
 511   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Link-Name = SearchBy-Target':U).
 512   RUN get-attribute ('Font':U).
 513   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Font = 10':U).
 514   RUN get-attribute ('Label':U).
 515   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Label = Search':U).
 516   RUN get-attribute ('Link-Name':U).
 517   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Link-Name = SearchBy':U).
 518   RUN get-attribute ('Tick-Interval':U).
 519   IF is-null( RETURN-VALUE ) THEN RUN set-attribute-list ('Tick-Interval = 350':U).
 520
 521 END PROCEDURE.
 522
 523 /* _UIB-CODE-BLOCK-END */
 524 &ANALYZE-RESUME
 525
 526 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-size s-object
 527 PROCEDURE set-size :
 528 /*------------------------------------------------------------------------------
 529   Purpose: Changes the size and shape of the panel.  This routine
 530            spaces the buttons to fill the available space.
 531   Parameters:
 532            pd-height - the desired height (in rows)
 533            pd-width  - the desired width (in columns)
 534   Notes:
 535            If pd-width or pd-height are ? then use the current values.
 536            (i.e. RUN set-size (?,?) resets the current size).
 537 ------------------------------------------------------------------------------*/
 538   DEFINE INPUT PARAMETER pd-height AS DECIMAL NO-UNDO.
 539   DEFINE INPUT PARAMETER pd-width  AS DECIMAL NO-UNDO.
 540
 541   IF pd-height eq ? THEN pd-height = FRAME {&FRAME-NAME}:HEIGHT.
 542   IF pd-width  eq ? THEN pd-width  = FRAME {&FRAME-NAME}:WIDTH.
 543
 544   DO WITH FRAME {&FRAME-NAME}:
 545     FRAME {&FRAME-NAME}:SCROLLABLE = No.
 546     ASSIGN FRAME {&FRAME-NAME}:WIDTH-C  = pd-width NO-ERROR.
 547     RUN get-attribute( 'Edge-Pixels':U ).
 548     ASSIGN  pd-width = (FRAME {&FRAME-NAME}:WIDTH-P) - (INT(RETURN-VALUE) * 2)
 549             RECT-1:WIDTH-P = pd-width
 550             RECT-1:X = (FRAME {&FRAME-NAME}:X) + INT(RETURN-VALUE).
 551
 552     RUN get-attribute( 'Margin-Pixels':U ).
 553     ASSIGN  pd-width = pd-width - (INT(RETURN-VALUE) * 2)
 554             pd-width = pd-width - btn_Search:WIDTH-P
 555             fil_Value:WIDTH-P = pd-width.
 556             fil_Value:X = RECT-1:X + INT(RETURN-VALUE) .
 557     ASSIGN  btn_Search:X = fil_Value:X + fil_Value:WIDTH-P.
 558
 559     FRAME {&FRAME-NAME}:SCROLLABLE = Yes.
 560   END.
 561
 562 END PROCEDURE.
 563
 564 /* _UIB-CODE-BLOCK-END */
 565 &ANALYZE-RESUME
 566
 567 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed s-object
 568 PROCEDURE state-changed :
 569 /* -----------------------------------------------------------
 570   Purpose:
 571   Parameters:  <none>
 572   Notes:
 573 -------------------------------------------------------------*/
 574   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 575   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 576
 577   CASE p-state:
 578       /* Object instance CASEs can go here to replace standard behavior
 579          or add new cases. */
 580   END CASE.
 581 END PROCEDURE.
 582
 583 /* _UIB-CODE-BLOCK-END */
 584 &ANALYZE-RESUME
 585
 586 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-font s-object
 587 PROCEDURE use-font :
 588 /*------------------------------------------------------------------------------
 589   Purpose:  Get the current value of 'font' and set the font of the FRAME to this value.
 590   Parameters:  <none>
 591   Notes:
 592 ------------------------------------------------------------------------------*/
 593 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 594
 595 DEFINE VAR iFont AS INTEGER NO-UNDO INITIAL ?.
 596 DEFINE VAR h AS WIDGET NO-UNDO.
 597
 598   /* Convert attribute string to an INTEGER font value. */
 599   iFont = IF p_attr-value eq "?" THEN ? ELSE INTEGER(p_attr-value) NO-ERROR.
 600
 601   /* Is the correct font set already? */
 602   IF iFont ne FRAME {&FRAME-NAME}:FONT THEN FRAME {&FRAME-NAME}:FONT = iFont.
 603   /* If there is a LABEL, then resize the frame. */
 604   IF {&Label}:SCREEN-VALUE ne '':U THEN RUN set-size IN THIS-PROCEDURE (?,?).
 605
 606 END PROCEDURE.
 607
 608 /* _UIB-CODE-BLOCK-END */
 609 &ANALYZE-RESUME
 610
 611 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-label s-object
 612 PROCEDURE use-label :
 613 /*------------------------------------------------------------------------------
 614   Purpose:     Get the current value of 'Label' and set the Label object to this
 615                value.
 616   Parameters:  <none>
 617   Notes:
 618 ------------------------------------------------------------------------------*/
 619 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 620
 621 DEFINE VAR h AS WIDGET NO-UNDO.
 622
 623   {&Label} = IF p_attr-value eq "?" THEN '':U ELSE p_attr-value NO-ERROR.
 624
 625   /* Reset the Label and its width. (If this FAILS, then we may need to run
 626      the whole resize logic again. */
 627   DO WITH FRAME {&FRAME-NAME}:
 628     ASSIGN {&Label}:SCREEN-VALUE = {&Label}
 629            {&Label}:HIDDEN = {&Label}:SCREEN-VALUE eq '':U
 630            {&Label}:WIDTH-P = FONT-TABLE:GET-TEXT-WIDTH-P
 631                                 ({&Label}, FRAME {&FRAME-NAME}:FONT)
 632        NO-ERROR.
 633     IF ERROR-STATUS:ERROR THEN RUN set-size IN THIS-PROCEDURE (?,?).
 634   END. /* DO WITH FRAME... */
 635 END PROCEDURE.
 636
 637 /* _UIB-CODE-BLOCK-END */
 638 &ANALYZE-RESUME
 639
 640 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-link-name s-object
 641 PROCEDURE use-link-name :
 642 /*------------------------------------------------------------------------------
 643   Purpose:  Get the current value of 'Link-Name' and set the supported-links to
 644             be the inverse of this link.
 645   Parameters:  <none>
 646   Notes:
 647 ------------------------------------------------------------------------------*/
 648 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 649
 650 DEF VAR ch          AS CHAR NO-UNDO.
 651 DEF VAR i           AS INTEGER NO-UNDO.
 652 DEF VAR new-link    AS CHAR NO-UNDO.
 653
 654   new-link = IF p_attr-value eq "?" THEN ? ELSE p_attr-value NO-ERROR.
 655
 656   ASSIGN i = NUM-ENTRIES (new-link,"-":U)
 657          ch = IF i < 2 THEN '':U ELSE ENTRY(i,new-link, "-":U)
 658          .
 659   IF ch eq 'Source':U THEN ENTRY(i,new-link,"-":U) = 'Target':U.
 660   ELSE IF ch eq 'Target' THEN ENTRY(i,new-link,"-":U) = 'Source':U.
 661   ELSE DO:
 662     new-link = IF LENGTH(new-link) > 0 /* Could be empty or ? */
 663                           THEN new-link + '-Source':U
 664                           ELSE 'Option-Source':U.
 665
 666     /* Whoops! The Link-Name seems invalid...set it to something reasonable. */
 667     MESSAGE 'The Link-Name of the SmartObject does not indicate direction.'
 668             '(It does not specify "Target" or "-Source".)' SKIP(1)
 669             'The ADM Supported Links will be set to' new-link + '.':U
 670             VIEW-AS ALERT-BOX WARNING.
 671   END.
 672
 673   RUN set-attribute-list ( 'SUPPORTED-LINKS = ':U + new-link ).
 674
 675 END PROCEDURE.
 676
 677 /* _UIB-CODE-BLOCK-END */
 678 &ANALYZE-RESUME
 679
 680 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-tick-interval s-object
 681 PROCEDURE use-tick-interval :
 682 /*------------------------------------------------------------------------------
 683   Purpose:
 684   Parameters:  <none>
 685   Notes:
 686 ------------------------------------------------------------------------------*/
 687
 688 DO WITH FRAME {&FRAME-NAME}:
 689   DEF INPUT PARAMETER millisec AS CHAR NO-UNDO.
 690
 691   DEF VAR ch-timer AS COM-HANDLE NO-UNDO.
 692   DEF VAR interval AS INT NO-UNDO.
 693
 694   interval = INT( millisec ).
 695
 696   /* The following code for some reason does not work under 8.2!!! */
 697   /*
 698   ch-timer = Timer:COM-HANDLE.
 699   ch-timer:Interval = interval.
 700   */
 701
 702 END.
 703
 704 END PROCEDURE.
 705
 706 /* _UIB-CODE-BLOCK-END */
 707 &ANALYZE-RESUME
 708
 709 /* ************************  Function Implementations ***************** */
 710
 711 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION is-null s-object
 712 FUNCTION is-null RETURNS LOGICAL
 713   ( INPUT str AS CHAR ) :
 714 /*------------------------------------------------------------------------------
 715   Purpose:
 716     Notes:
 717 ------------------------------------------------------------------------------*/
 718
 719   RETURN (str = "" OR str = ?).
 720
 721 END FUNCTION.
 722
 723 /* _UIB-CODE-BLOCK-END */
 724 &ANALYZE-RESUME
 725