2013-06-18 23:35

/* An example of FUNCDEF'ing various Windows OS functions
 * to subclass a REXX Dialog window. What is subclassing?
 *
 * There are certain features that REXX Dialog supports
 * in its windows. For example, it supports notifying you
 * when the user clicks upon one of the controls in the
 * window. It also notifies you when a menu item is selected.
 * It can notify you when a time-out occurs. Etc.
 *
 * In order to do what it does, REXX Dialog implements a
 * "Window procedure" inside of its DLL. This handles all of the
 * "messages" that the operating system sends as a result of
 * anything that happens to that window. REXX Dialog handles
 * all of these messages upon your script's behalf, and
 * reports only a small, useful subset of events whenever you
 * call RXMSG(). This alleviates you of a lot of work.
 *
 * But there are other things that REXX Dialog does not directly
 * support, such as notifying you of a change in the mouse
 * (pointer) position. Nor does REXX dialog support drawing
 * graphics primitives in a window.
 *
 * When you subclass a window, what you do is create your own
 * window procedure (ie, a subroutine in your script) that the
 * operating system will call whenever anything happens to this
 * window. It will call your own subroutine (instead of REXX
 * Dialog's internal Window procedure, even though REXX Dialog
 * still creates the window). The operating system will pass you
 * arguments that let you determine what event happened in that
 * window, and you can implement some instructions to do something
 * useful. For example, when receiving a WM_PAINT message, you can
 * draw your own text (in various fonts and colors) or graphics
 * primitives. When receiving a WM_MOUSEMOVE, you can determine
 * the new position of the mouse pointer, and even change its
 * shape (ie, image). You can pretty well do anything you want
 * with the window.
 *
 * And for messages where you just want REXX Dialog to do its
 * normal stuff, your subroutine calls REXX Dialog's internal
 * window procedure, passing those same arguments it received
 * from the OS. REXX Dialog will do what it normally does in
 * that case.
 *
 * This is what subclassing is -- intercepting a window's messages
 * (sent from the operating system) by installing your own window
 * procedure ahead of the window procedure of the entity that
 * created the window.
 *
 * Of course, there is a Windows operating system function to
 * subclass a window. It lets you tell which window you wish to
 * subclass, and what subroutine in your script you want to be
 * called whenever an event happens with that window. And this
 * OS function gives you the address of the original window
 * procedure so that you can call it when you want the default
 * handling.
 *
 * If you have several windows that all should respond to the
 * same messages in the same way, you can use one subroutine to
 * service them all.
 *
 * A drawback: Doing a lot of stuff in an interpreted language
 * like REXX from a window procedure could slow down your GUI.
 * Also, handling SYNTAX or HALT condition can be tricky.
 * But keeping it relatively simple should be ok.
 *
 * In this example, we'll let REXX Dialog create a simple window,
 * and we'll subclass it to detect when the mouse moves, and
 * print our own colored text to the window (instead of using
 * a REXX Dialog Text control).
 *
 * NOTE: Assumes REXX Dialog is autoloaded.
 */

/* Note: Since we're using Reginald exclusively, we'll also use
 * ADDRESS NULL so that we can eliminate the need for the CALL
 * keyword.
 */
ADDRESS null
NUMERIC DIGITS 10

/* ============== FUNCDEF some needed OS functions ============ */

/* Make things easy for us with WINFUNC option */
OPTIONS "WINFUNC NOSOURCE"

/* Trap ERROR, and ask REXX Dialog for ERROR raising */
SIGNAL ON ERROR
RXERR('ERROR')

/* Register the Windows OS function SetWindowLong(), callable
 * as SetWindowProc(). Define it to easily subclass a window
 * with our own Window procedure in REXX. We also need a
 * Definition string for our subroutine. We'll define it as
 * having a function type of WINDOWPROC. All Window procedures
 * have this same Definition string. We'll also specify
 * SetWindowProc as returning a func WINDOWPROC. This will be
 * the original window procedure. Now whatever variable we store
 * the return value in, that is also the function name we use to
 * call the original window procedure.
 */
windowproc = "void, void, 32u, void, void" /* Definition string for a Window procedure */
FUNCDEF("SetWindowProc", "func WINDOWPROC, void, 32, func WINDOWPROC", "user32", "SetWindowLong")


/* Register the Windows OS function SetWindowLong() again, this
 * time callable as UnsetWindowProc(). Define it to easily reset
 * the original window procedure which we stored in some REXX
 * variable.
 */
FUNCDEF("UnsetWindowProc", ", void, 32, void", "user32", "SetWindowLong")







/* ================== Create a REXX Dialog window ===================== */
/* First Group will be a text group with a groupbox. We'll use two of
 * the text controls to display the current mouse X and Y positions
 */
rxtype.1 = 'TEXT'
rxflags.1 = 'NOBORDER'
rxlabel.1 = 'X =||Y =||Mouse Position'
/* NOTE: 2 ControlsPerLine */
rxpos.1 = '2 10 20 50'
rx = ''
RXCREATE('RX', 1, 'Main Window', 'MIN')







/* ==================== Subclass the window ================== */
/* Now that the window is open, we can set "MyWindowProc" as the
 * subroutine to call for this window, and save the original Window
 * procedure (ie, REXX Dialog's internal procedure) in a variable
 * called OrigFunc so that we can call it when we want (using the
 * name "OrigFunc"). We do this once before our RXMSG() loop.
 *
 * The first arg is the window handle (gotten from some OS
 * function such as FindWindow, or if a REXX Dialog window,
 * it can be gotten via RXQUERY's "HANDLE" operation).
 *
 * The second arg tells which value (of the window) you wish
 * to set. It must be one of the following:
 *
 * -4 = Set the window's Window Procedure.
 * -6 = Set the window's Instance handle.
 * -8 = Set the handle of this window's parent window.
 * -12 = Set the window's ID (number).
 * -16 = Set the window style bits.
 * -20 = Set the window extra style bits.
 * -21 = Set some application specific data associated with the window.
 *
 * The third arg is the name of our subroutine for the window procedure.
 */
err = RXQUERY(, 'HANDLE', 'WindowHandle')
IF err == "" THEN DO
   origfunc = setwindowproc(windowhandle, -4, mywindowproc)
   IF origfunc == 0 THEN DO
      RXSAY("Error setting window procedure!")
      RETURN
   END
END
ELSE DO
   RXSAY("Can't get window handle!")
   RETURN
END






/* ===================== Do user interaction ==================== */
DO FOREVER

   /* NOTE: While we're inside this call to RXMSG(), and some event
    * happens with the above window, then our MyWindowProcess
    * function gets called.
    */
   RXMSG()

   /* Did user click on the CLOSE BOX? */
   IF rxid == '' THEN SIGNAL HALT

END








/* ============== Window Procedure written in REXX ==============
 * There are 4 args passed to this procedure. The first arg is the
 * handle of the window for which this message is applicable. For
 * a REXX Dialog window, it would be the same handle we got from
 * the RXQUERY "HANDLE" operation.
 *
 * The second arg is a number that tells us what kind of message
 * this is. For example, a WM_MOUSEMOVE message has a numeric
 * value of 512. A WM_CTLCOLORSTATIC has a value of 312. A
 * WM_PAINT is 15. Etc.
 *
 * The third and fourth args can be various things depending upon
 * what message is. For example, the third arg for WM_PAINT is a
 * device context handle (used with BeginPaint) and the fourth
 * arg is nothing. But, the third arg for a WM_MOUSEMOVE is a
 * numeric value that tells which keys (ie, CTRL, SHIFT) were
 * held down when the mouse was moved, and the fourth arg is the
 * mouse x and y position (in screen units) or'd together. So,
 * you may have to do different things with the third and fourth
 * args, or even sometimes use CONVERTDATA to convert data formats
 * between your REXX variables and some C structure.
 *
 * NOTE: It's very important that we trap SYNTAX or HALT here,
 * and do the default processing. Otherwise, if our script were
 * to be aborted here without doing that default processing, our
 * REXX Dialog window could be left hanging around, and we'd have
 * to use Windows Task Manager to stop the task.
 */

mywindowproc:

   SIGNAL ON SYNTAX NAME mywindowerror
   SIGNAL ON HALT NAME mywindowerror

   message = ARG(2)
   SELECT

      /* Is it a WM_MOUSEMOVE? */
      WHEN message == '512' THEN DO

         /* Let's store the new Mouse X and Y positions. One
          * tricky thing to remember is that if you use the
          * PROCEDURE keyword on MyWindowProc, but you want
          * these variables to be saved across calls to
          * MyWindowProc, then you would have to EXPOSE the
          * these variables. Otherwise, those variables would
          * disappear each time MyWindowProc RETURN'ed.
          * But we're not using PROCEDURE here.
          */

          /* We have to break up the X and Y values from
           * the one ARG(4). Essentially we're doing to X
           * what the C macro LOWORD() does, and to Y we're
           * doing HIWORD()
           */
          x = C2D(BITAND(D2C(ARG(4), 4), '0000FFFF'x, ' '))
          y = X2D(LEFT(D2X(ARG(4), 8), 4))

          /* Display the X and Y positions in our TEXT group */
          RXSET(, "VALUE", x, 1, 2)
          RXSET(, "VALUE", y, 1, 4)

      END

      /* For all other messages, we have no processing */
      OTHERWISE NOP
   END

mywindowerror2:
   /* For default handling, we need to call the original
    * window procedure, and return its return value.
    */
   RETURN origfunc(ARG(1), message, ARG(3), ARG(4))

mywindowerror:
   CONDITION('M')
   SIGNAL mywindowerror2





/* ======================= Error Handling ======================= */
syntax:
error:
    /* NOTE: CONDITION('D') fetches error message. CONDITION('E') fetches the
     * error number. SIGL is the line number where the error occurred.
     */
    CONDITION('M')

halt:

    /* If we subclassed the window, restore its original procedure. */
    IF SYMBOL(origfunc) == "VAR" THEN unsetwindowproc(windowhandle, -4, origfunc)

    RXMSG(,'END')
    RETURN

2013-06-18 23:35