XenCraft Making e-business work around the world!
Tip! Right-Aligning Checkboxes with PROGRESS 4GL
IntroductionThis 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. |
Instructions for Downloading Source CodeThe 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.wThe 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 swaptoggleThe 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.wHere 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.
|