Widgets
.
Associated icon
Chris Herring submitted the following code to draw the associated icon for any document on a button. For example: you created a button to open a file like "c:\invoices\abc001.doc", the file extension "doc" is associated with MS-Word so you want the icon for Word-documents displayed on the Progress button.
The remainder of the text is from Chris. As you see, he has some issues left. If you know the solution, please click the "Edit"-link near the bottom of this page to help out.
There were two ways I found to add the icon, using SendMessageA and ImageList_Draw. SendMessageA works ok except it suffers from the same limitations and the toggle button - can't remove focus. ImageList_Draw seems to be able to draw the icon on progress widgets that have the HWND attribute( at least the button and frame anyway ) but the image is release whenever the display for the image is refreshed. On the plus side it would work with flat buttons if you could get the image to stay. Anyway I've put some of my code below. Only thing that I'm aware of that is not entirely correct is the size of the fileinfo memptr regarding the last two string parameters. I wasn't sure of the size so I set them to 1 which only returns the first char of the string if the display name and type tags are added to the flag.
&GLOBAL-DEFINE GWL_STYLE -16
&GLOBAL-DEFINE BM_SETIMAGE 247
&GLOBAL-DEFINE IMAGE_ICON 1
&GLOBAL-DEFINE SHGFI_ICON 256
&GLOBAL-DEFINE SHGFI_SYSICONINDEX 16384
&GLOBAL-DEFINE SHGFI_USEFILEATTRIBUTES 16
&GLOBAL-DEFINE FILE_ATTRIBUTE_NORMAL 128
&GLOBAL-DEFINE BS_ICON 64
PROCEDURE SHGetFileInfo EXTERNAL 'shell32':
DEFINE INPUT PARAMETER pszPath AS CHARACTER.
DEFINE INPUT PARAMETER dwFileAttributes AS LONG.
DEFINE OUTPUT PARAMETER SBFileInfo AS MEMPTR.
DEFINE INPUT PARAMETER cbSizeFileInfo AS LONG.
DEFINE INPUT PARAMETER uFlags AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
PROCEDURE ImageList_Draw EXTERNAL "comctl32":
DEFINE INPUT PARAMETER himl AS LONG.
DEFINE INPUT PARAMETER iIndex AS LONG.
DEFINE INPUT PARAMETER hdc AS LONG.
DEFINE INPUT PARAMETER X AS LONG.
DEFINE INPUT PARAMETER Y AS LONG.
DEFINE INPUT PARAMETER iStyle AS LONG.
DEFINE RETURN PARAMETER lBool AS LONG.
END PROCEDURE.
PROCEDURE setButton :
/*-- Purpose: gets the icon from a program, file, or extension and draws the icon
on the specified button
Notes: the button must not be flat or no-focus
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER iHwnd AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER iphButton AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER pcProgram AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER plExtension AS LOGICAL NO-UNDO.
DEFINE VARIABLE iSize AS INTEGER NO-UNDO.
DEFINE VARIABLE fileinfo AS MEMPTR NO-UNDO.
DEFINE VARIABLE iFlags AS INTEGER NO-UNDO.
DEFINE VARIABLE iReturn AS INTEGER NO-UNDO.
DEFINE VARIABLE hIcon AS INTEGER NO-UNDO.
DEFINE VARIABLE iIcon AS INTEGER NO-UNDO.
DEFINE VARIABLE iAttr AS INTEGER NO-UNDO.
DEFINE VARIABLE cDName AS CHARACTER NO-UNDO.
DEFINE VARIABLE cType AS CHARACTER NO-UNDO.
DEFINE VARIABLE iStyles AS INTEGER NO-UNDO.
DEFINE VARIABLE iOldIcon AS INTEGER NO-UNDO.
SET-SIZE(fileinfo) = 4 + 4 + 4 + 1 + 1.
iSize = GET-SIZE(fileinfo).
IF iSize NE 0 THEN DO:
/*RUN SHGetFileInfo( "C:\Program Files\Internet Explorer\IEXPLORE.EXE", 0, OUTPUT fileinfo, iSize, iFlags, OUTPUT lReturn ).*/
/*RUN SHGetFileInfo( ".html", 128, OUTPUT fileinfo, iSize, iFlags, OUTPUT lReturn ).*/
IF plExtension THEN DO:
iFlags = {&SHGFI_ICON} + {&SHGFI_USEFILEATTRIBUTES}.
RUN SHGetFileInfo( pcProgram, {&FILE_ATTRIBUTE_NORMAL}, OUTPUT fileinfo, iSize, iFlags, OUTPUT iReturn ).
END.
ELSE DO:
iFlags = {&SHGFI_ICON}.
RUN SHGetFileInfo( pcProgram, 0, OUTPUT fileinfo, iSize, iFlags, OUTPUT iReturn ).
END.
hIcon = GET-LONG(fileinfo, 1).
iIcon = GET-LONG(fileinfo, 5).
iAttr = GET-LONG(fileinfo, 9).
cDName = GET-STRING(fileinfo, 13).
cType = GET-STRING(fileinfo, 14).
SET-SIZE(fileinfo) = 0.
END.
RUN GetWindowLongA(iHwnd, {&GWL_STYLE}, OUTPUT iStyles).
IF iphButton:PRIVATE-DATA EQ ?
THEN ASSIGN iStyles = iStyles + {&BS_ICON}
iphButton:PRIVATE-DATA = "loaded".
ELSE ASSIGN iStyles = iStyles.
RUN SetWindowLongA(iHwnd, {&GWL_STYLE}, iStyles, OUTPUT iStyles).
RUN SendMessageA( iHwnd, {&BM_SETIMAGE}, {&IMAGE_ICON}, hIcon, OUTPUT iOldIcon).
END PROCEDURE.
Buttons in pushed state
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.
Buttons in pushed state
See for an improved version: Buttons in pushed state
This example works best with Progress version 9.
When you create a 'toolbar' with buttons, you may sometimes want to keep a button in a 'pushed' state indicating if the functionality for the button is toggled 'on'.
In that case you could run the following ToggleButton procedure during the ON CHOOSE event of the button widget:
{windows.i}
PROCEDURE ToggleButton :
DEFINE INPUT PARAMETER hbutton AS HANDLE.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
&SCOP BM_SETSTATE 243
IF hbutton:TYPE NE 'button' THEN RETURN.
IF hbutton:PRIVATE-DATA = 'pushed' THEN DO:
hbutton:PRIVATE-DATA = ''.
RUN SendMessageA IN hpApi ( hbutton:HWND,
{&BM_SETSTATE},
0, /* FALSE, remove BST_PUSHED style */
0,
OUTPUT ReturnValue).
END.
ELSE DO:
hbutton:PRIVATE-DATA = 'pushed'.
RUN SendMessageA IN hpApi ( hbutton:HWND,
{&BM_SETSTATE},
1, /* TRUE, set BST_PUSHED style */
0,
OUTPUT ReturnValue).
END.
END PROCEDURE.
Notes
There are several button types in Progress: flat, no-focus, buttons with images and 'normal' buttons with text. In version 9 this procedure works for all button types, but in version 8 it works only for buttons with no images.
This enhancement is undocumented.
I have used the private-data attribute to store the current state of the button. It would also be possible to use the BM_GETSTATE message to query if the button is in it's 'pushed' state, but this is not useful during the ON CHOOSE event. After all, the button is always pushed during the ON CHOOSE event!
There is a however a problem: when focus moves away to another (non-Progress) application, all pushed buttons become 'unpushed'. This problem is reported to PSC and may be fixed in the future, but unfortunately it has a very low priority.
Changing the shape of a window
example by Simon de Kraa
This example program replaces the rectangular region of a window by a polygon. The technique is basically the same as described on page round widgets. You can download the example source from the attachments table.
A polygon is an array of points. The coordinates for the points in this example are calculated using the trigonometry functions sin and cos (found in the Visual C runtime module which is available on almost every PC). The number of points can be selected using the slider control; selecting a large number of points is somewhat slow but gives an interesting result as shown in the picture.
API declarations used in this example:
PROCEDURE CreatePolygonRgn EXTERNAL "gdi32.dll": DEFINE INPUT PARAMETER lpPoint AS MEMPTR. DEFINE INPUT PARAMETER nCount AS LONG. DEFINE INPUT PARAMETER nPolyFillMode AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE sin EXTERNAL "MSVCRT40.DLL" CDECL: DEFINE INPUT PARAMETER dblValue AS DOUBLE NO-UNDO. DEFINE RETURN PARAMETER dblResult AS DOUBLE NO-UNDO. END PROCEDURE. PROCEDURE cos EXTERNAL "MSVCRT40.DLL" CDECL: DEFINE INPUT PARAMETER dblValue AS DOUBLE NO-UNDO. DEFINE RETURN PARAMETER dblResult AS DOUBLE NO-UNDO. END PROCEDURE.
Attachments
polygon.zip : demo source
Combo-box with item-data
Page Selection-list with item-data shows how and when to use itemdata with a selection list. The same works for a combo-box, except the message constants are different.
Let's skip the background info and go right to the source:
{windows.i}
PROCEDURE AddComboItem :
/*------------------------------------------------------------------------------
Purpose: add an item to the combo-box. Each item can be associated with
itemdata (is low-level implementation of PRIVATE-DATA).
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER ip_hCombobox AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER ip_ItemText AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ip_ItemData AS INTEGER NO-UNDO.
DEFINE VARIABLE lpString AS MEMPTR NO-UNDO.
DEFINE VARIABLE SelIndex AS INTEGER NO-UNDO.
DEFINE VARIABLE retval AS INTEGER NO-UNDO.
SET-SIZE(lpString) = 0.
SET-SIZE(lpString) = LENGTH(ip_ItemText) + 1.
PUT-STRING(lpString,1) = ip_ItemText.
RUN SendMessageA IN hpAPi
(ip_hCombobox:HWND,
323, /* = CB_ADSTRING */
0,
GET-POINTER-VALUE(lpString),
OUTPUT selIndex).
RUN SendMessageA IN hpApi
(ip_hCombobox:HWND IN FRAME frame-tools ,
337, /* = CB_SETITEMDATA */
SelIndex,
ip_ItemData,
OUTPUT retval).
SET-SIZE(lpString)=0.
RETURN.
END PROCEDURE.
The first call to SendMessage adds a text to the combo-box, so it does the same as combo-1:ADD-LAST(ip_ItemText). However it also returns a SelIndex, which is the unique and constant index number for the new combo item. This SelIndex is used in the second call to SendMessage.
The second call to SendMessage adds an integer data value to the combo-item.
{windows.i}
ON VALUE-CHANGED OF COMBO-1 IN FRAME FRAME-tools /* Procedure */
DO:
DEFINE VARIABLE SelIndex AS INTEGER NO-UNDO.
DEFINE VARIABLE ItemData AS INTEGER NO-UNDO.
RUN SendMessageA (combo-1:HWND,
327, /* = CB_GETCURSEL */
0,
0,
OUTPUT SelIndex).
RUN SendMessageA (combo-1:HWND,
336, /* = CB_GETITEMDATA */
SelIndex,
0,
OUTPUT ItemData).
RUN Whatever(ItemData).
END.
Notes
Normally I would prefer to use the Progress 9 feature of ITEM-DATA-PAIRS instead of this API solution. But ITEM-DATA-PAIRS are designed to work only if the screen-values are unique!
cut, copy and paste
A typical Windows application has an Edit menu with options for Undo, Cut, Copy and Paste. There are 4GL methods for making such a menu. This site usually does not cover 4GL methods, but I would like to make an exception this time because these 4GL methods are not documented. This was posted by email to PEG by Matt Gilarde:
Starting in 8.2A, Progress supports several new attributes and methods which make implementing the Edit menu very simple. Unfortunately, these features were added in the late stage of 8.2 development and were not adequately documented. Briefly, the new attributes and methods are: Editor only: EDIT-CAN-UNDO - TRUE if editor can undo last operation EDIT-UNDO() - undo last operation Fill-in and Editor: EDIT-CAN-PASTE - TRUE if the clipboard contains pastable text EDIT-PASTE() - paste clipboard text into editor or fill-in EDIT-CLEAR() - delete contents of selection in editor or fill-in EDIT-CUT() - cut selected contents of editor or fill-in to clipboard EDIT-COPY() - copy selected contents of editor or fill-in to clipboard The following methods and attributes will work for fill-ins in Skywalker (they currently work only for editors): CLEAR-SELECTION() SELECTION-END SELECTION-START SELECTION-TEXT SET-SELECTION() TEXT-SELECTED READ-ONLY Matt Gilarde - PSC Development
Force Combo-box drop down
by Stuart Morris
Suppose you have a combo-box widget (named combo-box-1) and you want to drop down its built-in selection-list on some event. The following source will do just that.
{windows.i}
&GLOBAL-DEFINE CB_SHOWDROPDOWN 335
DEFINE VARIABLE retval AS INTEGER NO-UNDO.
RUN SendMessage{&A} IN hpApi (INPUT COMBO-BOX-1:HWND,
{&CB_SHOWDROPDOWN},
1, /* True */
0,
OUTPUT retval
)
NO-ERROR /* Stop C Stack Errors */.
Round widgets
changing the shape of a widget
based on an example by Sturla Johnsen
The animated gif shows an impression of Rounddemo.w.
Rounddemo, written by Sturla Johnsen, creates a normal Progress dialog box with some widgets on it (a frame, two fill-ins and two buttons) and demonstrates how the default rectangular region of any widget can be replaced by a different shaped region. In this case by elliptic regions.
Rounddemo.w calls procedure Roundwidget.p from within the CHOOSE trigger of the button. Both procedures are attched (see table near end of this topic) and can be downloaded from here to see for yourself.
ON CHOOSE OF BUTTON-1 IN FRAME Dialog-Frame /* Press me (several times) */
DO:
IF SELF:PRIVATE-DATA = ? THEN
ASSIGN SELF:PRIVATE-DATA = "1".
DEFINE VARIABLE HANDLE AS HANDLE.
CASE INT(SELF:PRIVATE-DATA):
WHEN 1 THEN ASSIGN HANDLE = FRAME {&FRAME-NAME}:HANDLE.
WHEN 2 THEN ASSIGN HANDLE = FILL-IN-1:HANDLE.
WHEN 3 THEN ASSIGN HANDLE = FILL-IN-2:HANDLE.
WHEN 4 THEN ASSIGN HANDLE = FRAME FRAME-A:HANDLE.
WHEN 5 THEN ASSIGN HANDLE = SELF.
WHEN 6 THEN ASSIGN HANDLE = Btn_Close:HANDLE
SELF:SENSITIVE = NO.
OTHERWISE RETURN NO-APPLY.
END CASE.
RUN roundwidget.p (HANDLE).
ASSIGN SELF:PRIVATE-DATA = STRING(INT(SELF:PRIVATE-DATA) + 1).
END.
/*******************************************
* roundwidget.p *
* Sturla Johnsen *
*******************************************/
DEFINE INPUT PARAMETER hWidget AS HANDLE.
DEFINE VARIABLE hrgn AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
IF NOT VALID-HANDLE(hWidget) THEN RETURN ERROR.
RUN CreateEllipticRgn (1, /* Start Xpos */
1, /* Start Ypos */
hWidget:WIDTH-PIXELS,
hWidget:HEIGHT-PIXELS,
OUTPUT hrgn).
RUN SetWindowRgn(hWidget:HWND,
hrgn,
1, /* 1 = Redraw */
OUTPUT ReturnValue).
PROCEDURE SetWindowRgn EXTERNAL "user32.dll" :
DEFINE INPUT PARAMETER HWND AS LONG.
DEFINE INPUT PARAMETER hRgn AS LONG.
DEFINE INPUT PARAMETER bRedraw AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
PROCEDURE CreateEllipticRgn EXTERNAL "gdi32.dll" :
DEFINE INPUT PARAMETER StartX AS LONG.
DEFINE INPUT PARAMETER StartY AS LONG.
DEFINE INPUT PARAMETER HEIGHT AS LONG.
DEFINE INPUT PARAMETER WIDTH AS LONG.
DEFINE RETURN PARAMETER hrgn AS LONG.
END PROCEDURE.
notes
CreateEllipticRgn creates a region which is a GDI object. A program should delete all the GDI objects it creates (using procedure DeleteObject). But not this time, because it is passed to SetWindowRgn. From now on this region is owned by the operating system and will eventually be deleted automatically.
There are many more API functions for creating regions with different shapes, like CreatePolygonRgn, CreateRectRgn, CreateRoundRectRgn. You can also create several regions and combine them using CombineRgn to create every shape you can imagine.
Attachments
rounddemo.zip : Example code
Selection-list with item-data
Every widget can have private-data, but it is less commonly known that each list-item in a selection list can have its own private data.
The itemdata for a list-item is of type integer, or actually a DWORD.
Perhaps it is best to think of a selection list as a container of list-items, where each list-item is uniquely identified by a SelIndex. Each list-item contains two data members: the (visible) character string and the itemdata. The itemdata has no meaning to Windows so you can safely use it for storing application-specific information.
Normally I would prefer to use the Progress 9 feature of LIST-ITEM-PAIRS instead of this API solution. But LIST-ITEM-PAIRS are designed to work only if the LIST-ITEMs (e.g. screen-values) are unique!
The following example populates a selection-list widget with each customer.name. When the user chooses a selection-list item, the customer is fetched and its details are displayed. This would normally not be possible because:
* There is no index on customer.name so it would be slow to FIND CUSTOMER WHERE customer.name=screen-value
* There may be several customers with the same name, so the FIND statement may be ambiguous
The solution is to add an identifying value to each list-item. This example stores RECID(customer) in the itemdata. I know RECID is an obsolete function, but I have used it anyway in this example because RECIDs are unique and compatible with Integers.
{windows.i}
PROCEDURE Populate :
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE lpString AS MEMPTR.
DEFINE VARIABLE selindex AS INTEGER NO-UNDO.
FOR EACH customer NO-LOCK :
SET-SIZE(lpString) = 0.
SET-SIZE(lpString) = LENGTH(TRIM(customer.NAME)) + 1.
PUT-STRING(lpString,1) = TRIM(customer.NAME).
RUN SendMessageA IN hpApi
(select-1:HWND IN FRAME {&frame-name},
384, /* LB_ADSTRING */
0,
GET-POINTER-VALUE(lpString),
OUTPUT selIndex).
RUN SendMessageA IN hpApi
(select-1:HWND IN FRAME {&frame-name},
410, /* LB_SETITEMDATA */
SelIndex,
INTEGER(RECID(customer)),
OUTPUT ReturnValue).
END.
SET-SIZE(lpString)=0.
END PROCEDURE.
The first call to SendMessage adds a text to the selection list, so it does the same as select-1:ADD-LAST(TRIM(customer.name)). However it also returns a SelIndex, which is the unique and constant index number for the new list-item. This SelIndex is used in the second call to SendMessage.
The second call to SendMessage adds an integer data value to the list-item.
{windows.i}
ON VALUE-CHANGED OF SELECT-1 IN FRAME DEFAULT-FRAME
DO:
DEFINE VARIABLE SelIndex AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
RUN SendMessageA (select-1:HWND,
392, /* LB_GETCURSEL */
0,
0,
OUTPUT SelIndex).
RUN SendMessageA (select-1:HWND,
409, /* LB_GETITEMDATA */
SelIndex,
0,
OUTPUT ReturnValue).
FIND customer WHERE RECID(customer)=ReturnValue NO-LOCK NO-ERROR.
IF AVAIL customer THEN DO:
DISPLAY
cust-num
NAME
city
country
WITH FRAME {&frame-name}.
END.
END.
Instead of looking at the screen-value I call SendMessage to get the unique SelIndex, and call SendMessage again to get the value of the item-data connected to that SelIndex. Because this item-data value was actually a RECID, I can now identify the customer and display its details.
Notes
The SelIndex value for a list-item never changes even when list-items are deleted or inserted, whether or not the selection-list is sorted.
Instead of storing an Integer value in Itemdata, you can also store a POINTER-VALUE pointing to some string or structure. However when you do this you will have to implement some kind of destructor.
Statusbar and Progressbar common controls
Source by Todd Nist, Protech Systems Inc.
Modified by Simon Sweetman
The library COMCTL32.DLL contains common controls like the Status Bar control. This example, provided by Todd Nist, shows how to use the Status Bar control in a Progress window. Simon Sweetman added the progressbar. The example will produce a window that looks like this:
The Status Bar in this example is divided in three parts: the first part contains a progressbar which displays the value of the slider, the second part is shown with SBT_POPOUT style so it appears raised.
Button WriteStatusBar results in sending window-messages to the Status Bar control, in this case message SB_SETTEXT. The control also accepts other messages like SB_SETPARTS (to change the size or count of parts), SB_SETICON (to show an icon in a part) or SB_SETTIPTEXT (to set a tooltip for a part). However SB_SETICON and SB_SETTIPTEXT are only available in comctl32.dll version 4.71 or newer.
/*------------------------------------------------------------------------
File: StatusExample.p
Author: Todd Nist, Protech Systems Inc.
Created: 5/19/98
Modifications:
28/11/00 Simon Sweetman - Added progress meter control
------------------------------------------------------------------------*/
&SCOP WINDOW-NAME C-Win
&SCOP FRAME-NAME DEFAULT-FRAME
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Local Variable Definitions --- */
{windows.i}
&SCOPE WM_USER 1024
&SCOPE SB_SETPARTS {&WM_USER} + 4
&SCOPE SB_SETTEXT {&WM_USER} + 1
&SCOPE SB_GETRECT {&WM_USER} + 10
&SCOPE PBM_SETRANGE {&WM_USER} + 1
&SCOPE PBM_SETPOS {&WM_USER} + 2
&SCOPE SBT_NORMAL 0
&SCOPE SBT_POPOUT 512
&SCOPE SBT_NOBORDERS 256
/* variables to hold handle control objects */
DEFINE VARIABLE hStatusBar AS INTEGER NO-UNDO.
DEFINE VARIABLE progHWND AS INTEGER NO-UNDO.
PROCEDURE CreateStatusWindow EXTERNAL "comctl32.dll":
DEFINE INPUT PARAMETER lStyle AS LONG.
DEFINE INPUT PARAMETER lpctStr AS CHARACTER.
DEFINE INPUT PARAMETER hwndParent AS LONG.
DEFINE INPUT PARAMETER wId AS LONG.
DEFINE RETURN PARAMETER hStatusArea AS LONG.
END PROCEDURE.
PROCEDURE InitCommonControls EXTERNAL "comctl32.dll":
END PROCEDURE.
/* Standard preprocessor definitions */
&SCOPED-DEFINE PROCEDURE-TYPE WINDOW
&SCOPED-DEFINE ENABLED-OBJECTS BtnCreateStatus BtnWriteStatus SLIDER-1
/* ************************ Function Prototypes ********************** */
FUNCTION CreateProgressArea RETURNS INTEGER
( INPUT phStatusBar AS INTEGER,
INPUT piStatusArea AS INTEGER,
INPUT piMaxValue AS INTEGER) FORWARD.
FUNCTION CreateStatusBar RETURNS INTEGER
( /* parameter-definitions */ ) FORWARD.
FUNCTION SetProgressArea RETURNS LOGICAL
( INPUT phProgressArea AS INTEGER,
INPUT piValue AS INTEGER ) FORWARD.
FUNCTION WriteStatusArea RETURNS LOGICAL
( INPUT phStatusBar AS INTEGER,
INPUT piStatusArea AS INTEGER,
INPUT piSBTextMode AS INTEGER,
INPUT pcText AS CHARACTER ) FORWARD.
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VARIABLE C-Win AS WIDGET-HANDLE NO-UNDO.
/* Menu Definitions */
DEFINE SUB-MENU m_File
MENU-ITEM m_Exit LABEL "E&xit" .
DEFINE MENU MENU-BAR-C-Win MENUBAR
SUB-MENU m_File LABEL "File" .
/* Definitions of the field level widgets */
DEFINE BUTTON BtnCreateStatus
LABEL "Create Status Bar"
SIZE 25 BY 1.
DEFINE BUTTON BtnWriteStatus
LABEL "WriteStatusBar"
SIZE 25 BY 1.
DEFINE VARIABLE SLIDER-1 AS INTEGER INITIAL 0
VIEW-AS SLIDER MIN-VALUE 0 MAX-VALUE 100 HORIZONTAL
SIZE 45 BY 2 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME {&FRAME-NAME}
SLIDER-1 AT ROW 1 COL 7 NO-LABEL
BtnCreateStatus AT ROW 6 COL 6
BtnWriteStatus AT ROW 6 COL 50
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1 ROW 1
SIZE 80 BY 8.
/* ************************* Create Window ************************** */
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
CREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "StatusBar Example"
HEIGHT = 8
WIDTH = 80
MAX-HEIGHT = 8
MAX-WIDTH = 80
VIRTUAL-HEIGHT = 8
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.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
ASSIGN {&WINDOW-NAME}:MENUBAR = MENU MENU-BAR-C-Win:HANDLE.
/* *************** Runtime Attributes and UIB Settings ************** */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = NO.
/* ************************ Control Triggers ************************ */
ON END-ERROR OF C-Win /* */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
END.
ON WINDOW-CLOSE OF C-Win /* */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
ON VALUE-CHANGED OF SLIDER-1 IN FRAME {&FRAME-NAME} /* Create Status Bar */
DO:
IF ProgHWND NE 0
THEN SetProgressArea(progHWND, INT(SELF:SCREEN-VALUE) * 10).
END.
ON CHOOSE OF BtnCreateStatus IN FRAME {&FRAME-NAME} /* Create Status Bar */
DO:
hStatusBar = CreateStatusBar().
END.
ON CHOOSE OF BtnWriteStatus IN FRAME {&FRAME-NAME} /* WriteStatusBar */
DO:
DEFINE VARIABLE i AS i NO-UNDO.
DO i = 1 TO 2.
WriteStatusArea(hStatusBar,
i,
IF i = 1 THEN {&SBT_POPOUT} ELSE {&SBT_NORMAL},
SUBSTITUTE('Message &1 here...', STRING(i,'9'))).
END.
progHWND = CreateProgressArea(hStatusBar, 0, 1000).
END.
ON CHOOSE OF MENU-ITEM m_Exit /* Exit */
DO:
APPLY 'WINDOW-CLOSE':U TO {&WINDOW-NAME}.
END.
/* *************************** Main Block *************************** */
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:
{win32/struct/rect.i} /* Used by CreateProgressArea function */
RUN enable_UI.
IF NOT THIS-PROCEDURE:PERSISTENT THEN
WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* ********************** Internal Procedures *********************** */
PROCEDURE disable_UI :
/*-----------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters:
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
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 :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: none
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
ENABLE BtnCreateStatus BtnWriteStatus SLIDER-1
WITH FRAME {&FRAME-NAME} IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-{&FRAME-NAME}}
VIEW C-Win.
END PROCEDURE.
FUNCTION CreateProgressArea RETURNS INTEGER
(INPUT phStatusBar AS INTEGER,
INPUT piStatusArea AS INTEGER,
INPUT piMaxValue AS INTEGER):
/*------------------------------------------------------------------------------
Purpose: Create status bar progress meter control
Notes: Return value is window handle of control
------------------------------------------------------------------------------*/
DEFINE VARIABLE hwndParent AS INTEGER NO-UNDO.
DEFINE VARIABLE hInstance AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnHwnd AS INTEGER NO-UNDO.
SET-SIZE(lpRect) = 16. /* allocate space for rect object */
/* Get screen postion of required status bar area */
RUN SendMessageA IN hpApi(INPUT phStatusBar,
INPUT {&SB_GETRECT},
INPUT piStatusArea,
INPUT GET-POINTER-VALUE(lpRect),
OUTPUT ReturnValue).
RUN mem2buf_lpRect.
SET-SIZE(lpRect) = 0. /* release allocated space */
RUN GetParent IN hpApi({&WINDOW-NAME}:HWND,
OUTPUT hwndParent).
RUN GetWindowLongA IN hpApi(hwndParent,
-6, /* GWL_HINSTANCE */
OUTPUT hInstance).
/* Create the progress meter window control and parent it to status window */
RUN CreateWindowExA IN hpApi(
8, /* extended style */
"msctls_progress32":U, /* progress meter class name */
"", /* window name */
1073741824 /* = WS_CHILD */
+ 1 /* = PBS_SMOOTH */
+ 268435456, /* = WS_VISIBLE */ /* window styles */
lpRect.LEFT,
lpRect.TOP,
lpRect.RIGHT - lpRect.LEFT,
lpRect.BOTTOM - lpRect.TOP, /* window position & size */
phStatusBar, /* parent window */
0, /* menu pointer */
hInstance, /* instance */
0, /* parameters */
OUTPUT ReturnHwnd).
/* set maximum value of progress meter control */
RUN SendMessageA IN hpApi(INPUT ReturnHwnd,
INPUT {&PBM_SETRANGE},
INPUT 0,
INPUT piMaxValue * 65536,
OUTPUT ReturnValue).
RETURN ReturnHwnd.
END FUNCTION.
FUNCTION CreateStatusBar RETURNS INTEGER
( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
Purpose:
Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE hwndMenu AS INTEGER NO-UNDO.
DEFINE VARIABLE hwndParent AS INTEGER NO-UNDO.
DEFINE VARIABLE hInstance AS INTEGER NO-UNDO.
DEFINE VARIABLE hWindowMenu AS INTEGER NO-UNDO.
DEFINE VARIABLE hStatusArea AS INTEGER NO-UNDO.
DEFINE VARIABLE lpParam AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
/*---------------------------------------------------------------------
Allocate memory and define the array to support the segments of the
status area.
-----------------------------------------------------------------------*/
ASSIGN
SET-SIZE(lpParam) = 256
PUT-LONG(lpParam,1) = 120
PUT-BYTE(lpParam,5) = 240
PUT-LONG(lpParam,9) = -1. /* extend to the right edge of the window */
/* find handle to the Parent handle of the Window */
RUN GetParent IN hpApi({&WINDOW-NAME}:HWND,
OUTPUT hwndParent).
RUN GetWindowLongA IN hpApi(hwndParent,
-6, /* GWL_HINSTANCE */
OUTPUT hInstance).
/* Call InitCommonControls to ensure that the comctl32.dll is loaded */
RUN InitCommonControls.
/* hwndParent */
/* Create the status window control and parent it to the window */
RUN CreateStatusWindow
( 1073741824 /* = WS_CHILD */
+ 268435456 /* = WS_VISIBLE */ /* window styles */
+ 8388608, /* = WS_BORDER */
'', /* default text */
hwndParent, /* parent window */
101, /* ID_STATUS */
OUTPUT hStatusArea).
IF hStatusArea = 0 THEN
MESSAGE 'Unable to create the status bar...' VIEW-AS ALERT-BOX.
ELSE
/* create the multiple segments based on the data in lpParam */
RUN SendMessageA IN hpApi( INPUT hStatusArea,
INPUT {&SB_SETPARTS},
INPUT 3, /* number of parts */
INPUT GET-POINTER-VALUE(lpParam),
OUTPUT ReturnValue).
/* deallocate the memory */
ASSIGN
SET-SIZE(lpParam) = 0.
RETURN hStatusArea. /* Function return value. */
END FUNCTION.
FUNCTION SetProgressArea RETURNS LOGICAL
( INPUT phProgressArea AS INTEGER,
INPUT piValue AS INTEGER ) :
/*------------------------------------------------------------------------------
Purpose: Update progress indicator value and redisplay
Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
RUN SendMessageA IN hpApi(INPUT phProgressArea,
INPUT {&PBM_SETPOS},
INPUT piValue,
INPUT 0,
OUTPUT ReturnValue).
RETURN TRUE.
END FUNCTION.
FUNCTION WriteStatusArea RETURNS LOGICAL
( INPUT phStatusBar AS INTEGER,
INPUT piStatusArea AS INTEGER,
INPUT piSBTextMode AS INTEGER,
INPUT pcText AS CHARACTER ) :
/*------------------------------------------------------------------------------
Purpose: Write the text in the appropriat format to the appropriate area
Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE lpParam AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
ASSIGN
SET-SIZE(lpParam) = 256
PUT-STRING(lpParam,1) = pcText.
RUN SendMessageA IN hpApi(INPUT phStatusBar,
INPUT {&SB_SETTEXT},
INPUT piStatusArea + piSBTextMode,
INPUT GET-POINTER-VALUE(lpParam),
OUTPUT ReturnValue).
/* deallocate the memory */
ASSIGN
SET-SIZE(lpParam) = 0.
RETURN TRUE.
END FUNCTION.
Explanations
message SB_SETTEXT has the following parameters:
* wParam = iPart + uType
* lParam = text. The text for each part is limited to 127 characters.
* iPart is the index of the part to set. If iPart=255 you will get a 'simple' status bar with only one part.
uType can be:
* {&SBT_NORMAL} : border, appears lower
* {&SBT_NOBORDERS} : no border, no 3D effect
* {&SBT_POPOUT} : border, appears higher
Note
The Status Bar has a sizing grip because it is parented to the resizable window. It will not have a sizing grip when you parent it to the frame :
/* Create the status window control and parent it to the frame */
RUN CreateStatusWindow
( 1073741824 /* = WS_CHILD */
+ 268435456 /* = WS_VISIBLE */ /* window styles */
+ 8388608, /* = WS_BORDER */
'', /* default text */
FRAME {&frame-name}:HWND, /* parent */
101, /* ID_STATUS */
OUTPUT hStatusArea).
This also solves the repaint problem: if the status bar is parented to the window, it will appear to be invisible after the window is repainted.
Note
There's another way to solve the repaint problem, and to keep the StatusBar parented to the window (and therefore keep the "sizing grip").
Simply run:
RUN SendMessageA IN hpApi(INPUT phStatusBar,
INPUT 5, /* WM_SIZE */
INPUT 0,
INPUT 0,
OUTPUT ReturnValue).
For instance, at the end of a WINDOW-RESIZED event (or after a "ShowScrollBar")
System colors
The functions GetSysColor and SetSysColors can be used to access the system colors.
This is for example useful for displaying text in disabled native fill-in widgets.
Text in a disabled native fill-in is rendered in the system-color COLOR_GRAYTEXT, which is gray. The background color of a disabled fill-in is also gray (but not COLOR_GRAYTEXT) so it is difficult to read the text.
To make the text more readable you may want to change the RGB-value of the COLOR_GRAYTEXT system color.
There are several ways to change COLOR_GRAYTEXT:
You can set or modify the registry key
"HKEY_CURRENT_USER\Control Panel\Colors\GrayText"
but that will only take effect after you reboot the system.
You can also consider using the SetSysColors function to modify the RGB-value of COLOR_GRAYTEXT. The advantage is that it will take effect immediately, no need to reboot the system.
The disadvantage is that it won't be written to registry so the original value is reset after reboot. Well, actually I think this is another advantage.
What I would try to do is:
on startup of the Progress session: read the current value of COLOR_GRAYTEXT
if COLOR_GRAYTEXT is not acceptable set it to something you prefer.
on close of the Progress session: restore the original value to respect other applications.
After you call SetSysColors, Windows sends a notification message to all open windows so they can repaint themselves. This takes a little time.
Read COLOR_GRAYTEXT
{windows.i}
DEFINE VARIABLE rgbGrayText AS INTEGER NO-UNDO.
RUN GetSysColor IN hpApi (17, /* = COLOR_GRAYTEXT */
OUTPUT rgbGrayText).
set COLOR_GRAYTEXT
{windows.i}
DEFINE VARIABLE lpElements AS MEMPTR.
DEFINE VARIABLE lpRgb AS MEMPTR.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpElements) = 4. /* = sizeof(long) */
SET-SIZE(lpRgb) = 4.
PUT-LONG(lpElements,1) = 17. /* = COLOR_GRAYTEXT */
PUT-LONG(lpRgb,1) = RGB-VALUE(192,192,192).
RUN SetSysColors IN hpApi (1, /* = number of elements */
GET-POINTER-VALUE(lpElements),
GET-POINTER-VALUE(lpRgb),
OUTPUT ReturnValue).
SET-SIZE(lpElements) = 0.
SET-SIZE(lpRgb) = 0.
Notes
Credits to Julian Lyndon Smith who discovered the value 192,192,192. Although it is the RGB-value for a shade of gray, it will render the text in disabled native fill-in widgets black but still does little harm to other screen-elements that are coloured in COLOR_GRAYTEXT.
Notes
(May 1999).
It now appears that setting GrayText to RGB(192,192,192) makes disabled SELECTION-LIST widgets really hard to read. Don't know why it was not noticed before... perhaps it depends on Windows 98, video card or other display settings? Anyway, GrayText=RGB(192,192,192) does not seem to be a good idea anymore.
Notes
KeithGernert 19 Jan 2004: We've found that an RGB setting of 80,80,80 looks pretty good and is less destructive to other Windows controls.
Toggle-box with labels on the left
A standard toggle-box widget has its label on the right. This example applies the BS_LEFTTEXT style to bring the label to the left.
As you can see in the picture, the checkboxes are not vertically aligned anymore. Tex Texin wrote a
procedure to fix this: see http:www.xencraft.com/resources/rightside-checkbox.html
RUN ToggleLeftText (toggle-1:HWND). RUN ToggleLeftText (toggle-2:HWND).
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.
DEFINE VARIABLE styles AS INTEGER NO-UNDO.
DEFINE VARIABLE 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.
Definitions used in this example:
&GLOBAL-DEFINE GWL_STYLE -16 &GLOBAL-DEFINE BS_LEFTTEXT 32 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.