This example has some advantages over the older example. This example shows an easy way to create buttons that can have a "pushed" state. These buttons are actually toggle-box widgets with an alternative layout. That is convenient because you don't need any special code to read and set the logical value: the usual statement toggle-1=TRUE will be sufficient to show the button in pushed state.
Width and height are set high enough to fit the image. You can simply use the UIB/AB to do this.
You don't really need to put images on these buttons: just don't use the BS_ICON style (or BS_BITMAP) if you want to keep the label.
Note: I could not manage to get a NO-FOCUS effect. If you have ideas about this please let me know.
RUN ToggleToButton (toggle-1:HWND). /* show an icon or bitmap on the button. There are several ways of doing this. I got lazy so I chose this method for 32x32 icons. */ RUN SetIcon (toggle-1:HWND, 'winupd.ico').
PROCEDURE ToggleToButton : /* ------------------------------------------------------------------- purpose: convert a toggle-box widget to a button. note : don't call this more than once for each toggle-box widget ------------------------------------------------------------------- */ DEFINE INPUT PARAMETER HWND AS INTEGER. DEFINE VARIABLE styles AS INTEGER NO-UNDO. DEFINE VARIABLE returnvalue AS INTEGER NO-UNDO. /* find the current style and add some extra flags to it */ RUN GetWindowLongA(HWND, {&GWL_STYLE}, OUTPUT styles). styles = styles + {&BS_ICON} + {&BS_PUSHLIKE}. /* according to MSDN you should apply the new style using SendMessage(hwnd,BM_SETSTYLE,....) but it does not work for me */ RUN SetWindowLongA(HWND, {&GWL_STYLE}, styles, OUTPUT styles). /* force a repaint: */ RUN InvalidateRect(HWND,0,1,OUTPUT returnvalue). END PROCEDURE.
PROCEDURE SetIcon : DEFINE INPUT PARAMETER HWND AS INTEGER. DEFINE INPUT PARAMETER IconFilename AS CHARACTER. DEFINE VARIABLE hInstance AS INTEGER NO-UNDO. DEFINE VARIABLE OldIcon AS INTEGER NO-UNDO. DEFINE VARIABLE hIcon AS INTEGER NO-UNDO. RUN GetWindowLongA(HWND, {&GWL_HINSTANCE}, OUTPUT hInstance). RUN ExtractIconA (hInstance, IconFilename, 0, OUTPUT hIcon). RUN SendMessageA( HWND, {&BM_SETIMAGE}, {&IMAGE_ICON}, hIcon, OUTPUT OldIcon). /* free resources when the window closes, or earlier: run DestroyIcon (hIcon). */ IF OldIcon NE 0 THEN RUN DestroyIcon (OldIcon). END PROCEDURE.
Definitions used in this example:
&GLOBAL-DEFINE GWL_HINSTANCE -6 &GLOBAL-DEFINE GWL_STYLE -16 &GLOBAL-DEFINE BS_PUSHLIKE 4096 &GLOBAL-DEFINE BS_ICON 64 &GLOBAL-DEFINE BS_BITMAP 128 &GLOBAL-DEFINE BM_SETIMAGE 247 &GLOBAL-DEFINE IMAGE_ICON 1 &GLOBAL-DEFINE IMAGE_BITMAP 0 &GLOBAL-DEFINE BM_SETSTYLE 244 PROCEDURE ExtractIconA EXTERNAL "shell32.dll" : DEFINE INPUT PARAMETER hInst AS LONG. DEFINE INPUT PARAMETER lpszExeFileName AS CHARACTER. DEFINE INPUT PARAMETER nIconIndex AS LONG. DEFINE RETURN PARAMETER hIcon AS LONG. END PROCEDURE. PROCEDURE DestroyIcon EXTERNAL "user32.dll" : DEFINE INPUT PARAMETER hIcon AS LONG. 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 SendMessageA EXTERNAL "user32.dll" : DEFINE INPUT PARAMETER HWND AS LONG. DEFINE INPUT PARAMETER umsg AS LONG. DEFINE INPUT PARAMETER wparam AS LONG. DEFINE INPUT PARAMETER lparam AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE.
Comments
Large or Small Icon...
This is a version that allow you to choose between Large and Small icons...
PROCEDURE Toggle2Button:
/* -------------------------------------------------------------------
purpose: convert a toggle-box widget to a button.
note : don't call this more than once for each toggle-box widget
------------------------------------------------------------------- */
DEFINE INPUT PARAMETER piHWND AS INT NO-UNDO.
DEFINE INPUT PARAMETER piIconFilename AS CHAR NO-UNDO.
DEFINE INPUT PARAMETER piSize AS CHAR NO-UNDO. /* Large/Small */
DEFINE OUTPUT PARAMETER poIcon AS INT NO-UNDO.
DEF VAR styles AS INTEGER NO-UNDO.
DEF VAR returnvalue AS INTEGER NO-UNDO.
DEF VAR hInstance AS INTEGER NO-UNDO.
DEF VAR OldIcon AS INTEGER NO-UNDO.
DEF VAR lpLarge AS MEMPTR NO-UNDO.
DEF VAR lpSmall AS MEMPTR NO-UNDO.
DEF VAR nIcon AS INTEGER NO-UNDO.
ASSIGN FILE-INFO:FILE-NAME = piIconFileName
piIconFileName = FILE-INFO:FULL-PATHNAME.
/* find the current style and add some extra flags to it */
RUN GetWindowLongA(piHWND, {&GWL_STYLE}, OUTPUT styles).
styles = styles + (IF piIconFilename <> ? THEN {&BS_ICON} ELSE 0) + {&BS_PUSHLIKE} /*+ {&BS_FLAT}*/.
/* according to MSDN you should apply the new style
using SendMessage(hwnd,BM_SETSTYLE,....) but it does not work for me */
RUN SetWindowLongA(piHWND, {&GWL_STYLE}, styles, OUTPUT styles).
/* force a repaint: */
RUN InvalidateRect(piHWND,0,1,OUTPUT returnvalue).
IF piIconFilename <> ? /* show an icon or bitmap on the button. */
THEN DO:
RUN GetWindowLongA(piHWND,{&GWL_HINSTANCE},OUTPUT hInstance).
SET-SIZE(lpLarge) = 32.
SET-SIZE(lpSmall) = 32.
RUN ExtractIconEx(piIconFilename,0,GET-POINTER-VALUE(lpLarge),GET-POINTER-VALUE(lpSmall),0,OUTPUT nIcon).
CASE TRUE:
WHEN nIcon > 0 AND piSize = "SMALL":u THEN poIcon = GET-LONG(lpSmall,1).
WHEN nIcon > 0 AND piSize = "LARGE":u THEN poIcon = GET-LONG(lpLarge,1).
OTHERWISE RUN ExtractIconA (hInstance, piIconFilename, 0, OUTPUT poIcon).
END CASE.
RUN SendMessageA( piHWND, {&BM_SETIMAGE}, {&IMAGE_ICON}, poIcon, OUTPUT OldIcon).
SET-SIZE(lpLarge) = 0.
SET-SIZE(lpSmall) = 0.
/* free resources when the window closes, or earlier:
run DestroyIcon (hIcon). */
IF OldIcon NE 0 THEN RUN DestroyIcon (OldIcon).
END.
RETURN "".
END PROCEDURE. /* Toggle2Button */
PROCEDURE ExtractIconEx EXTERNAL {&SHELL} :
DEFINE INPUT PARAMETER lpszExeFileName AS CHAR.
DEFINE INPUT PARAMETER nIconIndex AS LONG.
DEFINE INPUT PARAMETER lpLarge AS LONG.
DEFINE INPUT PARAMETER lpSmall AS LONG.
DEFINE INPUT PARAMETER nIcon AS LONG.
DEFINE RETURN PARAMETER hIcon AS LONG.
END PROCEDURE.