Arithmetic with Locks

[jongpau]

Try this on your Progress version 9, it works on my 9.1C07 on Windows NT 4.0 (SP6):

/* ************************************************************ */
/* lockfun.p - Have some fun with locks                         */
/*             Works with Progress 9.1C on my Windows NT 4.0    */
/* ************************************************************ */
DEF VAR lvMult AS DEC FORMAT "ZZ,ZZZ,ZZZ,ZZZ,ZZ9-":U NO-UNDO.
DEF VAR lvDiv  AS DEC FORMAT "ZZZ,ZZ9.9999999999-":U NO-UNDO.
DEF VAR lvAdd  AS INT FORMAT "ZZ,ZZZ,ZZZ,ZZZ,ZZ9":U  NO-UNDO.

DEF BUTTON BtnOK AUTO-GO SIZE-PIXELS 75 BY 21 LABEL "OK?":L
                 TOOLTIP "Aren't locks great things to play with?":L.

/* ************************************************************ */
/* Here's the interesting stuff ;-)                             */
/* ************************************************************ */
ASSIGN lvMult = SHARE-LOCK * NO-LOCK * EXCLUSIVE-LOCK
       lvAdd  = SHARE-LOCK + NO-LOCK + EXCLUSIVE-LOCK
       lvDiv  = SHARE-LOCK / NO-LOCK / EXCLUSIVE-LOCK.

DISPLAY SHARE-LOCK     COLON 47 LABEL  "SHARE-LOCK":L     
                                FORMAT "ZZ,ZZZ,ZZZ,ZZZ,ZZ9":U SKIP
        NO-LOCK        COLON 47 LABEL  "NO-LOCK":L        
                                FORMAT "ZZ,ZZZ,ZZZ,ZZZ,ZZ9":U SKIP
        EXCLUSIVE-LOCK COLON 47 LABEL  "EXCLUSIVE-LOCK":L 
                                FORMAT "ZZ,ZZZ,ZZZ,ZZZ,ZZ9":U SKIP
        lvAdd          COLON 47 LABEL "SHARE-LOCK + NO-LOCK + EXCLUSIVE-LOCK":L SKIP
        lvDiv          COLON 47 LABEL "SHARE-LOCK / NO-LOCK / EXCLUSIVE-LOCK":L SKIP
        lvMult         COLON 47 LABEL "SHARE-LOCK * NO-LOCK * EXCLUSIVE-LOCK":L SKIP(1)
        SPACE(1) BtnOK
        WITH FRAME FrmFunny VIEW-AS DIALOG-BOX 
             WIDTH 80 SIDE-LABELS NO-ATTR-SPACE THREE-D
             TITLE "Lock Arithmetic":L.

ENABLE BtnOK WITH FRAME FrmFunny.
DO ON ENDKEY UNDO, LEAVE
   ON ERROR UNDO, LEAVE:
  WAIT-FOR GO OF FRAME FrmFunny. 
END. /* do on endkey, on error */
/* ************************************************************ */
/* That's all folks                                             */
/* ************************************************************ */

Paul de Jong
Axias CMS Development
http://www.axias.com