panel/p-abc.w

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r11 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-abc.w
   8
   9   Description:
  10       A Filter-Source that has a button for every letter of the
  11       alphabet, and which sends requests to:
  12           RUN set-attribute-list IN <Filter-Target> ('FILTER-VALUE = <letter>':U)
  13       The Filter-Source will also automatically dispatch 'open-query'
  14       to the Filter-Target if the attribute "dispatch-open-query" is
  15       set to 'yes'.
  16
  17   Input Parameters:
  18       <none>
  19
  20   Output Parameters:
  21       <none>
  22
  23   Authors: Rick Kuzyk and Wm.T.Wood
  24   Created: November 1995
  25 ------------------------------------------------------------------------*/
  26 /*          This .W file was created with the Progress UIB.             */
  27 /*----------------------------------------------------------------------*/
  28
  29 /* Create an unnamed pool to store all the widgets created
  30      by this procedure. This is a good default which assures
  31      that this procedure's triggers and internal procedures
  32      will execute in this procedure's storage, and that proper
  33      cleanup will occur on deletion of the procedure. */
  34
  35 CREATE WIDGET-POOL.
  36
  37 /* ***************************  Definitions  ************************** */
  38
  39 /* Parameters Definitions ---                                           */
  40
  41 /* Local Variable Definitions ---                                       */
  42
  43 /* ADM Preprocessor Defintions ---                                      */
  44 &Scoped-define adm-attribute-dlg adm/support/abcd.w
  45
  46 /* _UIB-CODE-BLOCK-END */
  47 &ANALYZE-RESUME
  48
  49
  50 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  51
  52 /* ********************  Preprocessor Definitions  ******************** */
  53
  54 &Scoped-define PROCEDURE-TYPE SmartPanel
  55 &Scoped-define DB-AWARE no
  56
  57 &Scoped-define ADM-SUPPORTED-LINKS Filter-Source
  58
  59 /* Name of first Frame and/or Browse and/or first Query                 */
  60 &Scoped-define FRAME-NAME F-Main
  61
  62 /* Standard List Definitions                                            */
  63 &Scoped-Define ENABLED-OBJECTS b-a b-b b-c b-d b-e b-f b-g b-h b-i b-j b-k ~
  64 b-l b-m b-n b-o b-p b-q b-r b-s b-t b-u b-v b-w b-x b-y b-z b-all RECT-1
  65
  66 /* Custom List Definitions                                              */
  67 /* Box-Rectangle,List-2,List-3,List-4,List-5,List-6                     */
  68 &Scoped-define Box-Rectangle RECT-1
  69
  70 /* _UIB-PREPROCESSOR-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73
  74
  75 /* ***********************  Control Definitions  ********************** */
  76
  77
  78 /* Definitions of the field level widgets                               */
  79 DEFINE BUTTON b-a
  80      LABEL "A"
  81      SIZE 1.72 BY 1
  82      FONT 4.
  83
  84 DEFINE BUTTON b-all
  85      LABEL "*"
  86      SIZE 1.72 BY 1
  87      FONT 4.
  88
  89 DEFINE BUTTON b-b
  90      LABEL "B"
  91      SIZE 1.72 BY 1
  92      FONT 4.
  93
  94 DEFINE BUTTON b-c
  95      LABEL "C"
  96      SIZE 1.72 BY 1
  97      FONT 4.
  98
  99 DEFINE BUTTON b-d
 100      LABEL "D"
 101      SIZE 1.72 BY 1
 102      FONT 4.
 103
 104 DEFINE BUTTON b-e
 105      LABEL "E"
 106      SIZE 1.72 BY 1
 107      FONT 4.
 108
 109 DEFINE BUTTON b-f
 110      LABEL "F"
 111      SIZE 1.72 BY 1
 112      FONT 4.
 113
 114 DEFINE BUTTON b-g
 115      LABEL "G"
 116      SIZE 1.72 BY 1
 117      FONT 4.
 118
 119 DEFINE BUTTON b-h
 120      LABEL "H"
 121      SIZE 1.72 BY 1
 122      FONT 4.
 123
 124 DEFINE BUTTON b-i
 125      LABEL "I"
 126      SIZE 1.72 BY 1
 127      FONT 4.
 128
 129 DEFINE BUTTON b-j
 130      LABEL "J"
 131      SIZE 1.72 BY 1
 132      FONT 4.
 133
 134 DEFINE BUTTON b-k
 135      LABEL "K"
 136      SIZE 1.72 BY 1
 137      FONT 4.
 138
 139 DEFINE BUTTON b-l
 140      LABEL "L"
 141      SIZE 1.72 BY 1
 142      FONT 4.
 143
 144 DEFINE BUTTON b-m
 145      LABEL "M"
 146      SIZE 1.72 BY 1
 147      FONT 4.
 148
 149 DEFINE BUTTON b-n
 150      LABEL "N"
 151      SIZE 1.72 BY 1
 152      FONT 4.
 153
 154 DEFINE BUTTON b-o
 155      LABEL "O"
 156      SIZE 1.72 BY 1
 157      FONT 4.
 158
 159 DEFINE BUTTON b-p
 160      LABEL "P"
 161      SIZE 1.72 BY 1
 162      FONT 4.
 163
 164 DEFINE BUTTON b-q
 165      LABEL "Q"
 166      SIZE 1.72 BY 1
 167      FONT 4.
 168
 169 DEFINE BUTTON b-r
 170      LABEL "R"
 171      SIZE 1.72 BY 1
 172      FONT 4.
 173
 174 DEFINE BUTTON b-s
 175      LABEL "S"
 176      SIZE 1.72 BY 1
 177      FONT 4.
 178
 179 DEFINE BUTTON b-t
 180      LABEL "T"
 181      SIZE 1.72 BY 1
 182      FONT 4.
 183
 184 DEFINE BUTTON b-u
 185      LABEL "U"
 186      SIZE 1.72 BY 1
 187      FONT 4.
 188
 189 DEFINE BUTTON b-v
 190      LABEL "V"
 191      SIZE 1.72 BY 1
 192      FONT 4.
 193
 194 DEFINE BUTTON b-w
 195      LABEL "W"
 196      SIZE 1.72 BY 1
 197      FONT 4.
 198
 199 DEFINE BUTTON b-x
 200      LABEL "X"
 201      SIZE 1.72 BY 1
 202      FONT 4.
 203
 204 DEFINE BUTTON b-y
 205      LABEL "Y"
 206      SIZE 1.72 BY 1
 207      FONT 4.
 208
 209 DEFINE BUTTON b-z
 210      LABEL "Z"
 211      SIZE 1.72 BY 1
 212      FONT 4.
 213
 214 DEFINE RECTANGLE RECT-1
 215      EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
 216      SIZE 40 BY 1.25.
 217
 218
 219 /* ************************  Frame Definitions  *********************** */
 220
 221 DEFINE FRAME F-Main
 222      b-a AT ROW 1.1 COL 1.43
 223      b-b AT ROW 1.1 COL 2.86
 224      b-c AT ROW 1.1 COL 4.29
 225      b-d AT ROW 1.1 COL 5.72
 226      b-e AT ROW 1.1 COL 7.14
 227      b-f AT ROW 1.1 COL 8.57
 228      b-g AT ROW 1.1 COL 10
 229      b-h AT ROW 1.1 COL 11.43
 230      b-i AT ROW 1.1 COL 12.86
 231      b-j AT ROW 1.1 COL 14.29
 232      b-k AT ROW 1.1 COL 15.72
 233      b-l AT ROW 1.1 COL 17.14
 234      b-m AT ROW 1.1 COL 18.57
 235      b-n AT ROW 1.1 COL 20
 236      b-o AT ROW 1.1 COL 21.43
 237      b-p AT ROW 1.1 COL 22.86
 238      b-q AT ROW 1.1 COL 24.29
 239      b-r AT ROW 1.1 COL 25.72
 240      b-s AT ROW 1.1 COL 27.14
 241      b-t AT ROW 1.1 COL 28.57
 242      b-u AT ROW 1.1 COL 30
 243      b-v AT ROW 1.1 COL 31.43
 244      b-w AT ROW 1.1 COL 32.86
 245      b-x AT ROW 1.1 COL 34.29
 246      b-y AT ROW 1.1 COL 35.72
 247      b-z AT ROW 1.1 COL 37.14
 248      b-all AT ROW 1.1 COL 38.57
 249      RECT-1 AT ROW 1 COL 1
 250     WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
 251          SIDE-LABELS NO-UNDERLINE THREE-D
 252          AT COL 1 ROW 1 SCROLLABLE
 253          FGCOLOR 1 .
 254
 255
 256 /* *********************** Procedure Settings ************************ */
 257
 258 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 259 /* Settings for THIS-PROCEDURE
 260    Type: SmartPanel
 261    Allow: Basic
 262    Frames: 1
 263    Add Fields to: NEITHER
 264    Other Settings: PERSISTENT-ONLY COMPILE
 265  */
 266
 267 /* This procedure should always be RUN PERSISTENT.  Report the error,  */
 268 /* then cleanup and return.                                            */
 269 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
 270   MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
 271           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 272   RETURN.
 273 END.
 274
 275 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 276
 277 /* *************************  Create Window  ************************** */
 278
 279 &ANALYZE-SUSPEND _CREATE-WINDOW
 280 /* DESIGN Window definition (used by the UIB)
 281   CREATE WINDOW s-object ASSIGN
 282          HEIGHT             = 1.9
 283          WIDTH              = 53.86.
 284 /* END WINDOW DEFINITION */
 285                                                                         */
 286 &ANALYZE-RESUME
 287
 288 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB s-object
 289 /* ************************* Included-Libraries *********************** */
 290
 291 {src/adm/method/smart.i}
 292 {src/adm/method/panelsiz.i}
 293
 294 /* _UIB-CODE-BLOCK-END */
 295 &ANALYZE-RESUME
 296
 297
 298
 299
 300 /* ***********  Runtime Attributes and AppBuilder Settings  *********** */
 301
 302 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
 303 /* SETTINGS FOR WINDOW s-object
 304   VISIBLE,,RUN-PERSISTENT                                               */
 305 /* SETTINGS FOR FRAME F-Main
 306    NOT-VISIBLE Size-to-Fit                                              */
 307 ASSIGN
 308        FRAME F-Main:SCROLLABLE       = FALSE
 309        FRAME F-Main:HIDDEN           = TRUE.
 310
 311 /* SETTINGS FOR RECTANGLE RECT-1 IN FRAME F-Main
 312    1                                                                    */
 313 /* _RUN-TIME-ATTRIBUTES-END */
 314 &ANALYZE-RESUME
 315
 316
 317 /* Setting information for Queries and Browse Widgets fields            */
 318
 319 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
 320 /* Query rebuild information for FRAME F-Main
 321      _Options          = "NO-LOCK"
 322      _Query            is NOT OPENED
 323 */  /* FRAME F-Main */
 324 &ANALYZE-RESUME
 325
 326
 327
 328
 329
 330 /* ************************  Control Triggers  ************************ */
 331
 332 &Scoped-define SELF-NAME b-a
 333 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b-a s-object
 334 ON CHOOSE OF b-a IN FRAME F-Main /* A */
 335 OR CHOOSE OF b-all, b-b, b-c, b-d, b-e, b-f, b-g, b-h, b-i, b-j, b-k, b-l, b-m,
 336              b-n, b-o, b-p, b-q, b-r, b-s, b-t, b-u, b-v, b-w, b-x, b-y, b-z
 337 DO:
 338   DEF VAR c-list   AS CHAR NO-UNDO.
 339   DEF VAR h_target AS HANDLE NO-UNDO.
 340   DEF VAR i        AS INTEGER NO-UNDO.
 341   DEF VAR iCnt     AS INTEGER NO-UNDO.
 342
 343   /*
 344    * Get all the FILTER-TARGETS - Tell them to set their filter value.
 345    */
 346   RUN get-link-handle IN adm-broker-hdl
 347              (THIS-PROCEDURE, 'Filter-Target':U, OUTPUT c-list).
 348   iCnt = NUM-ENTRIES (c-list).
 349   IF iCnt = 0
 350   THEN MESSAGE "No Filter-Target exists for this object."  VIEW-AS ALERT-BOX WARNING.
 351   ELSE
 352     DO i = 1 TO iCnt:
 353       h_target = WIDGET-HANDLE (ENTRY(i,c-list)).
 354       IF VALID-HANDLE (h_target) THEN DO:
 355         RUN set-attribute-list IN h_target
 356                ('Filter-Value =':U + (IF SELF:LABEL eq '*':U THEN '':U ELSE SELF:LABEL)).
 357         /*
 358          * Only open the query in the Filter-Target if necessary.
 359          */
 360         RUN get-attribute IN THIS-PROCEDURE ('Dispatch-Open-Query':U).
 361         IF RETURN-VALUE eq 'yes':U THEN DO:
 362           RUN dispatch IN h_target ('open-query':U).
 363           RUN dispatch IN h_target ('apply-entry':U).
 364         END.
 365
 366       END.
 367     END.
 368 END.
 369
 370 /* _UIB-CODE-BLOCK-END */
 371 &ANALYZE-RESUME
 372
 373
 374 &UNDEFINE SELF-NAME
 375
 376 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK s-object
 377
 378
 379 /* ***************************  Main Block  *************************** */
 380
 381   &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
 382     /* Code needed to test this object (when run directly from the UIB) */
 383     RUN dispatch IN THIS-PROCEDURE ('initialize').
 384   &ENDIF
 385
 386 /* _UIB-CODE-BLOCK-END */
 387 &ANALYZE-RESUME
 388
 389
 390 /* **********************  Internal Procedures  *********************** */
 391
 392 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI s-object  _DEFAULT-DISABLE
 393 PROCEDURE disable_UI :
 394 /*------------------------------------------------------------------------------
 395   Purpose:     DISABLE the User Interface
 396   Parameters:  <none>
 397   Notes:       Here we clean-up the user-interface by deleting
 398                dynamic widgets we have created and/or hide
 399                frames.  This procedure is usually called when
 400                we are ready to "clean-up" after running.
 401 ------------------------------------------------------------------------------*/
 402   /* Hide all frames. */
 403   HIDE FRAME F-Main.
 404   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
 405 END PROCEDURE.
 406
 407 /* _UIB-CODE-BLOCK-END */
 408 &ANALYZE-RESUME
 409
 410 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-initialize s-object
 411 PROCEDURE local-initialize :
 412 /*------------------------------------------------------------------------------
 413   Purpose:     Override standard ADM method
 414   Notes:
 415 ------------------------------------------------------------------------------*/
 416
 417   /* Code placed here will execute PRIOR to standard behavior. */
 418   RUN use-button-font(?).
 419
 420   /* Dispatch standard ADM method.                             */
 421   RUN dispatch IN THIS-PROCEDURE ( INPUT 'initialize':U ) .
 422
 423   /* Code placed here will execute AFTER standard behavior.    */
 424
 425 END PROCEDURE.
 426
 427 /* _UIB-CODE-BLOCK-END */
 428 &ANALYZE-RESUME
 429
 430 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-UIB-mode s-object
 431 PROCEDURE local-UIB-mode :
 432 /*------------------------------------------------------------------------------
 433   Purpose:     Override standard ADM method. If the object has just been drawn
 434                in the UIB, then make sure it is sized correctly.
 435
 436   Notes:
 437 ------------------------------------------------------------------------------*/
 438
 439   /* Code placed here will execute PRIOR to standard behavior. */
 440
 441   /* Dispatch standard ADM method.                             */
 442   RUN dispatch IN THIS-PROCEDURE ( INPUT 'UIB-mode':U ) .
 443
 444   /* Code placed here will execute AFTER standard behavior.    */
 445   RUN get-attribute ('Drawn-in-UIB':U).
 446   IF RETURN-VALUE eq ? THEN DO:
 447     /* Set default values for Parameters */
 448     RUN get-attribute ('Button-Font':U).
 449     IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Button-Font = 4':U).
 450     RUN get-attribute ('Dispatch-Open-Query':U).
 451     IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Dispatch-Open-Query = yes':U).
 452     RUN get-attribute ('Edge-Pixels':U).
 453     IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Edge-Pixels = 2':U).
 454     RUN get-attribute ('Margin-Pixels':U).
 455     IF RETURN-VALUE eq ? THEN RUN set-attribute-list ('Margin-Pixels = 5':U).
 456
 457     /* Set the FONT and SIZE. */
 458     RUN use-button-font(?).
 459
 460     /* Make sure the object has been sized correctly. (This will process
 461        edge-pixels and margin-pixels. */
 462     RUN set-size IN THIS-PROCEDURE
 463         (FRAME {&FRAME-NAME}:HEIGHT, FRAME {&FRAME-NAME}:WIDTH).
 464
 465     /* Mark this as having been drawn. */
 466     RUN set-attribute-list ('Drawn-in-UIB=yes':U).
 467   END.
 468
 469 END PROCEDURE.
 470
 471 /* _UIB-CODE-BLOCK-END */
 472 &ANALYZE-RESUME
 473
 474 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed s-object
 475 PROCEDURE state-changed :
 476 /* -----------------------------------------------------------
 477   Purpose:
 478   Parameters:  <none>
 479   Notes:
 480 -------------------------------------------------------------*/
 481   DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE    NO-UNDO.
 482   DEFINE INPUT PARAMETER p-state      AS CHARACTER NO-UNDO.
 483
 484   CASE p-state:
 485       /* Object instance CASEs can go here to replace standard behavior
 486          or add new cases. */
 487   END CASE.
 488 END PROCEDURE.
 489
 490 /* _UIB-CODE-BLOCK-END */
 491 &ANALYZE-RESUME
 492
 493 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-button-font s-object
 494 PROCEDURE use-button-font :
 495 /*------------------------------------------------------------------------------
 496   Purpose:  Get the current value of 'button-font' and set the font of all
 497             buttons to this value.
 498   Parameters:  p_attr-value -- the new Button Font
 499   Notes: The desired font is checked against Button b-a. If b-a has the desired
 500          font then no change is made.
 501 ------------------------------------------------------------------------------*/
 502 DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 503
 504 DEFINE VAR iFont AS INTEGER INITIAL ? NO-UNDO.
 505 DEFINE VAR h AS WIDGET NO-UNDO.
 506
 507   /* Convert attribute string to an INTEGER font value. */
 508   iFont = IF p_attr-value eq "?" THEN ? ELSE INTEGER(p_attr-value) NO-ERROR.
 509   IF ERROR-STATUS:ERROR THEN DO:
 510
 511   RUN get-attribute IN THIS-PROCEDURE ('button-font':U).
 512   iFont = IF RETURN-VALUE eq "?":U THEN ? ELSE INTEGER(RETURN-VALUE) NO-ERROR.
 513
 514   END.
 515
 516   DO WITH FRAME {&FRAME-NAME}:
 517     /* Is the correct font set already? */
 518     IF iFont ne b-a:FONT THEN DO:
 519       /* Walk the widget tree and set the font of all buttons in this frame . */
 520       ASSIGN h = FRAME {&FRAME-NAME}:CURRENT-ITERATION
 521              h = h:FIRST-CHILD.
 522       DO WHILE VALID-HANDLE (h):
 523         IF h:TYPE eq 'BUTTON':U THEN h:FONT = iFont.
 524         h = h:NEXT-SIBLING.
 525       END. /* DO WHILE...h... */
 526     END. /* IF iFont ne b-a:FONT... */
 527   END. /* DO WITH FRAME... */
 528 END PROCEDURE.
 529
 530 /* _UIB-CODE-BLOCK-END */
 531 &ANALYZE-RESUME
 532
 533 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE use-edge-pixels s-object
 534 PROCEDURE use-edge-pixels :
 535 /*------------------------------------------------------------------------------
 536   Purpose:     Use the current value of 'Edge-Pixels' in the {&Box-Rectangle}.
 537   Parameters:  p_attr-value - (CHAR) the new value of the 'Font' Attribute
 538   Notes:       Default to 2 if unknown.)
 539 ------------------------------------------------------------------------------*/
 540   DEFINE INPUT PARAMETER p_attr-value AS CHAR NO-UNDO.
 541
 542   /* We need do nothing is there is no box rectangle. */
 543   &IF NUM-ENTRIES("{&Box-Rectangle}") eq 1 &THEN
 544     DEFINE VAR iEdge AS INTEGER NO-UNDO.
 545
 546     /* Get the desired Edge-Pixels. */
 547     iEdge = INTEGER(p_attr-value) NO-ERROR.
 548     /* Is the correct font set already? */
 549     DO WITH FRAME {&FRAME-NAME}:
 550       IF iEdge ne {&Box-Rectangle}:EDGE-PIXELS
 551       THEN {&Box-Rectangle}:EDGE-PIXELS = iEdge.
 552     END.
 553
 554   &ENDIF
 555 END PROCEDURE.
 556
 557 /* _UIB-CODE-BLOCK-END */
 558 &ANALYZE-RESUME
 559