Tip!    Right-Aligning Checkboxes with PROGRESS 4GL

example of left and right aligned checkboxes

Introduction

This page shows how to use the Progress 4GL to change a checkbox to have the box on the right rather than the left of the label while maintaining the vertical alignment of the boxes. This is an extension of the code listed at Jurjen Dijkstra's GLOBAL SHARED web site: Toggle-box with label on the left . The example shows the Windows API to swap the label and the box. This may leave the boxes in unaligned columns. The additional PROCEDURE swaptoggle that is provided here, resizes and relocates the checkbox control so that the boxes remain aligned.

results of the 4GL program shiftdemo.w

Instructions for Downloading Source Code

The source code for the demonstration program is available for download. It is a zip file with a single file shiftdemo.w in it. This program demonstrates use of the PROCEDURE swaptoggle to resize and relocate the checkboxes.

The 4GL Program shiftdemo.w

The demonstration program shiftdemo.w creates 6 checkboxes. The first three are identical to the second three. The first checkbox has a single character label. The second checkbox is much longer. The third checkbox has a label which is longer than the allocated width of its checkbox. The program modifies each of the first three checkboxes so the checkbox is on the right of the label. The PROCEDURE swaptoggle is called to adjust the size and position of each of these boxes so they remain aligned vertically. The second group of checkboxes is unchanged, so you can easily compare the before and after look of the checkboxes.


Explanation of the PROCEDURE swaptoggle

The handle of the checkbox is used to retrieve the width of the checkbox in pixels. The handle is also used to retrieve the label text and the font of the frame. The font and label text are used to calculate the width of the label in pixels.

The checkbox and a small margin around it are 23 pixels wide. (&checkbox-size). So the exact width of the checkbox = label width+23. When the checkbox was on the left, the checkbox width was usually larger than the width of the label+box. (A checkbox is 30 characters wide by default).

The checkbox is resized to its exact dimensions (label+23) and then the checkbox is moved over by the number of pixels that its width was reduced. (iow - h-tog:width-p). This positions the box so that it is exactly at the end of the checkbox's original width.

If the label text and box are wider than the width of the checkbox control, then the procedure doesn't do anything. The label text will be truncated in the display since it is too long. The third checkbox in the demonstration program shows this effect.

Note: To maintain the vertical alignment of the checkboxes, this procedure assumes that the widths of the checkbox controls in the same columns are the same. Otherwise simply positioning the box at the end of the control is not adequate to maintain alignment.

PROCEDURE swaptoggle:
DEF INPUT PARAMETER h-tog  AS HANDLE  NO-UNDO.

DEF VAR ilabelwidth-p AS INTEGER NO-UNDO.
DEF VAR iow AS INT.

ASSIGN
    iow = h-tog:WIDTH-P /* original width */
    ilabelwidth-p =
     FONT-TABLE:GET-TEXT-WIDTH-P (h-tog:LABEL,h-tog:frame:FONT).

IF iow > ( ilabelwidth-p + {&checkbox-size} ) THEN
/* slide the label over if it is smaller than the widget width*/
ASSIGN
    iow = h-tog:WIDTH-P /* original width */

    /* new width is width of checkbox plus the width of the label*/
    h-tog:WIDTH-P = {&checkbox-size} + ilabelwidth-p

    /* new position is old position + old width - new width*/
    h-tog:X = h-tog:X + iow - h-tog:WIDTH-P.
END.

Program shiftdemo.w

Here is the demonstration program. Look at the very last procedure to see the PROCEDURE swaptoggle.

&GLOBAL-DEFINE GWL_STYLE -16
&GLOBAL-DEFINE BS_LEFTTEXT 32
&GLOBAL-DEFINE checkbox-size 23

&Scoped-define WINDOW-NAME C-Win

CREATE WIDGET-POOL.
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.

DEFINE BUTTON BUTTON-1
     LABEL "Exit" SIZE 15 BY 1.12.

DEFINE VARIABLE TOGGLE-1 AS LOGICAL INITIAL no
     LABEL "T"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE VARIABLE TOGGLE-2 AS LOGICAL INITIAL no
     LABEL "Long toggle-box name"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE VARIABLE TOGGLE-3 AS LOGICAL INITIAL no
     LABEL "Toggle-box name bigger than widget width"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE VARIABLE TOGGLE-4 AS LOGICAL INITIAL no
     LABEL "T"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE VARIABLE TOGGLE-5 AS LOGICAL INITIAL no
     LABEL "Long toggle-box name"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE VARIABLE TOGGLE-6 AS LOGICAL INITIAL no
     LABEL "Toggle-box name bigger than widget width"
     VIEW-AS TOGGLE-BOX SIZE 30 BY .77 NO-UNDO.

DEFINE FRAME DEFAULT-FRAME
     TOGGLE-1 AT ROW 3 COL 11
     TOGGLE-2 AT ROW 5 COL 11
     TOGGLE-3 AT ROW 7 COL 11
     TOGGLE-4 AT ROW 9 COL 11
     TOGGLE-5 AT ROW 11 COL 11
     TOGGLE-6 AT ROW 13 COL 11
     BUTTON-1 AT ROW 15 COL 11
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
         SIDE-LABELS NO-UNDERLINE THREE-D
         AT COL 1 ROW 1 SIZE 80 BY 20.

  CREATE WINDOW C-Win ASSIGN
         HIDDEN             = YES
         TITLE              = "Test aligning toggle-boxes"
         HEIGHT             = 16
         WIDTH              = 80
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 80
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 80
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.

  ASSIGN c-win:HIDDEN = NO.

ON WINDOW-CLOSE OF C-Win
DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

ON CHOOSE OF BUTTON-1 IN FRAME DEFAULT-FRAME
DO:
  APPLY "WINDOW-CLOSE" TO CURRENT-WINDOW.
END.

ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME}
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

ON CLOSE OF THIS-PROCEDURE
   RUN disable_UI.

PAUSE 0 BEFORE-HIDE.

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.


  RUN ToggleLeftText (toggle-1:HWND).
  RUN ToggleLeftText (toggle-2:HWND).
  RUN ToggleLeftText (toggle-3:HWND).
  RUN swaptoggle (toggle-1:HANDLE).
  RUN swaptoggle (toggle-2:HANDLE).
  RUN swaptoggle (toggle-3:HANDLE).

IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.

PROCEDURE disable_UI :
  IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
  THEN DELETE WIDGET C-Win.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

PROCEDURE enable_UI :
  DISPLAY TOGGLE-1 TOGGLE-2 TOGGLE-3 toggle-4  TOGGLE-5 TOGGLE-6
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE TOGGLE-1 TOGGLE-2 BUTTON-1 TOGGLE-3 toggle-4  TOGGLE-5 TOGGLE-6
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
  VIEW C-Win.
END PROCEDURE.

PROCEDURE ToggleLeftText :
/* -------------------------------------------------------------
purpose: place the label on the left side.
do not run this procedure more than once for each toggle-box
------------------------------------------------------------- */

DEFINE INPUT PARAMETER HWND AS INTEGER.

DEF VAR styles      AS INTEGER NO-UNDO.
DEF VAR returnvalue AS INTEGER NO-UNDO.

RUN GetWindowLongA(HWND, {&GWL_STYLE}, OUTPUT styles).
  styles = styles + {&BS_LEFTTEXT}.
RUN SetWindowLongA(HWND, {&GWL_STYLE}, styles, OUTPUT styles).

/* force a repaint */
RUN InvalidateRect(HWND,0,1,OUTPUT returnvalue).
END PROCEDURE.

PROCEDURE GetWindowLongA EXTERNAL "user32.dll" :
DEFINE INPUT  PARAMETER phwnd       AS LONG.
DEFINE INPUT  PARAMETER cindex      AS LONG.
DEFINE RETURN PARAMETER currentlong AS LONG.
END PROCEDURE.

PROCEDURE SetWindowLongA EXTERNAL "user32.dll" :
DEFINE INPUT  PARAMETER phwnd   AS LONG.
DEFINE INPUT  PARAMETER cindex  AS LONG.
DEFINE INPUT  PARAMETER newlong AS LONG.
DEFINE RETURN PARAMETER oldlong AS LONG.
END PROCEDURE.

PROCEDURE InvalidateRect EXTERNAL "user32.dll" :
DEFINE INPUT  PARAMETER HWND        AS LONG.
DEFINE INPUT  PARAMETER lpRect      AS LONG.
DEFINE INPUT  PARAMETER bErase      AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.

PROCEDURE swaptoggle:
/* -------------------------------------------------------------
purpose: align the label up against the checkbox which is on
the right.

algorithm:
The handle of the checkbox is used to retrieve the width of the
checkbox in pixels. The handle is also used to retrieve the label
text and the font of the frame. The font and label text are used
to calculate the width of the label in pixels.

The checkbox and a small margin around it are 23 pixels wide.
(&checkbox-size). So the exact width of the checkbox = label
width+23. When the checkbox was on the left, the checkbox width
was usually larger than the width of the label+box. (A checkbox
is 30 characters wide by default).

The checkbox is resized to its exact dimensions (label+23) and
then the checkbox is moved over by the number of pixels that its
width was reduced. (iow - h-tog:width-p). This positions the box
so that it is exactly at the end of the checkbox's original
width.

If the label text and box are wider than the width of the
checkbox control, then the procedure doesn't do anything. The
label text will be truncated in the display since it is too long.
------------------------------------------------------------- */
DEF INPUT PARAMETER h-tog  AS HANDLE  NO-UNDO.

DEF VAR ilabelwidth-p AS INTEGER NO-UNDO.
DEF VAR iow AS INT.

ASSIGN
    iow = h-tog:WIDTH-P /* original width */
    ilabelwidth-p =
      FONT-TABLE:GET-TEXT-WIDTH-P (h-tog:LABEL,h-tog:frame:FONT).

IF iow > ( ilabelwidth-p + {&checkbox-size} ) THEN
/* slide the label over if it is smaller than the widget width*/
ASSIGN
    iow = h-tog:WIDTH-P /* original width */

    /* new width is width of checkbox plus the width of the label*/
    h-tog:WIDTH-P = {&checkbox-size} + ilabelwidth-p

    /* new position is old position + old width - new width*/
    h-tog:X = h-tog:X + iow - h-tog:WIDTH-P.
END.