Appearance
.
Center a window to the working area
A window is not automatically centered to the screen, but is cascaded.
This procedure takes the widget-handle of a window as input parameter and centers the window to the 'working area'.
The working area is the portion of the screen not overlapped by the taskbar. So the result will differ when you move the taskbar to either of the 4 edges of the screen.
Windows 98 and Windows 2000 support multiple monitors. The monitors share a virtual desktop but each monitor has its own working area. This procedure is improved to center the window to the monitor where it is positioned at that time. That is, if the window is positioned somewhere on the secondary monitor it will be centered to the secondary monitor too.
The window will not dynamically stay centered using this procedure: if the size of the window changes or if the size/position of the taskbar changes, you will have to run this procedure again.
{windows.i}
PROCEDURE CenterWindow :
/*------------------------------------------------------------------------------
Purpose: centers window to the working area.
("working area" is portion of screen not obscured by taskbar)
Parameters: winhandle : progress widget-handle of a window widget
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER winhandle AS HANDLE NO-UNDO.
IF LOOKUP(winhandle:TYPE , "window,dialox-box":U ) = 0 THEN RETURN.
/* calculate coordinates and dimensions of working area */
DEFINE VARIABLE workingleft AS INTEGER NO-UNDO.
DEFINE VARIABLE workingtop AS INTEGER NO-UNDO.
DEFINE VARIABLE workingwidth AS INTEGER NO-UNDO.
DEFINE VARIABLE workingheight AS INTEGER NO-UNDO.
DEFINE VARIABLE lpWorkingRect AS MEMPTR. /* RECT structure */
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpWorkingRect)=4 * {&INTSIZE}.
RUN GetWorkingArea (winhandle:HWND, lpWorkingRect).
/* RECT is filled with left,top,right,bottom */
workingleft = get-{&INT}(lpWorkingRect,1 + 0 * {&INTSIZE}).
workingtop = get-{&INT}(lpWorkingRect,1 + 1 * {&INTSIZE}).
workingwidth = get-{&INT}(lpWorkingRect,1 + 2 * {&INTSIZE}) - workingleft.
workingheight = get-{&INT}(lpWorkingRect,1 + 3 * {&INTSIZE}) - workingtop.
/* calculate current coordinates and dimensions of window */
DEFINE VARIABLE windowleft AS INTEGER NO-UNDO.
DEFINE VARIABLE windowtop AS INTEGER NO-UNDO.
DEFINE VARIABLE windowwidth AS INTEGER NO-UNDO.
DEFINE VARIABLE windowheight AS INTEGER NO-UNDO.
DEFINE VARIABLE hParent AS INTEGER NO-UNDO.
DEFINE VARIABLE lpWinRect AS MEMPTR.
SET-SIZE(lpWinRect)=4 * {&INTSIZE}.
hParent = GetParent(winhandle:HWND).
RUN GetWindowRect IN hpApi(hParent,
GET-POINTER-VALUE(lpWinRect),
OUTPUT ReturnValue).
windowleft = get-{&INT}(lpWinRect,1 + 0 * {&INTSIZE}).
windowtop = get-{&INT}(lpWinRect,1 + 1 * {&INTSIZE}).
windowwidth = get-{&INT}(lpWinRect,1 + 2 * {&INTSIZE}) - windowleft.
windowheight = get-{&INT}(lpWinRect,1 + 3 * {&INTSIZE}) - windowtop.
/* calculate new x and y for window */
windowleft = workingleft + INTEGER((workingwidth - windowwidth ) / 2 ).
windowtop = workingtop + INTEGER((workingheight - windowheight ) / 2 ).
/* perhaps you should ensure that the upper-left corner of the window
stays visible, e.g. user can reach system-menu to close the window: */
windowleft = MAXIMUM(workingleft, windowleft).
windowtop = MAXIMUM(workingtop, windowtop).
/* assign these values. No need to use API: */
ASSIGN winhandle:X = windowleft
winhandle:Y = windowtop.
/* free memory */
SET-SIZE(lpWorkingRect) = 0.
SET-SIZE(lpWinRect) = 0.
END PROCEDURE.
PROCEDURE GetWorkingArea :
DEFINE INPUT PARAMETER HWND AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER lpRect AS MEMPTR NO-UNDO.
DEFINE VARIABLE hMonitor AS INTEGER NO-UNDO.
DEFINE VARIABLE lpMonitorInfo AS MEMPTR.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE SimpleArea AS LOGICAL NO-UNDO INITIAL NO.
IF NOT (RunningWindows98() OR RunningWindows2000()) THEN
SimpleArea = YES.
ELSE DO:
RUN MonitorFromWindow(HWND, 2, OUTPUT hMonitor).
IF hMonitor = 0 THEN
SimpleArea = YES.
ELSE DO:
SET-SIZE(lpMonitorInfo) = 4 + 16 + 16 + 4.
PUT-LONG(lpMonitorInfo, 1) = GET-SIZE(lpMonitorInfo).
RUN GetMonitorInfoA(hMonitor,
GET-POINTER-VALUE(lpMonitorInfo),
OUTPUT ReturnValue).
IF ReturnValue = 0 THEN
SimpleArea = YES.
ELSE DO:
PUT-LONG(lpRect, 1) = GET-LONG(lpMonitorInfo, 21).
PUT-LONG(lpRect, 5) = GET-LONG(lpMonitorInfo, 25).
PUT-LONG(lpRect, 9) = GET-LONG(lpMonitorInfo, 29).
PUT-LONG(lpRect,13) = GET-LONG(lpMonitorInfo, 33).
END.
SET-SIZE(lpMonitorInfo) = 0.
END.
END.
IF SimpleArea THEN
RUN SystemParametersInfo{&A} IN hpApi
( 48, /* 48 = SPI_GETWORKAREA */
0,
GET-POINTER-VALUE(lpRect),
0,
OUTPUT ReturnValue).
END PROCEDURE.
PROCEDURE MonitorFromWindow EXTERNAL "user32" :
DEFINE INPUT PARAMETER HWND AS LONG.
DEFINE INPUT PARAMETER dwFlags AS LONG.
DEFINE RETURN PARAMETER hMonitor AS LONG.
END PROCEDURE.
PROCEDURE GetMonitorInfoA EXTERNAL "user32" :
DEFINE INPUT PARAMETER hMonitor AS LONG.
DEFINE INPUT PARAMETER lpMonitorInfo AS LONG.
DEFINE RETURN PARAMETER ReturnValue AS LONG.
END PROCEDURE.
Explanation
Can probably do with less variables but I wanted a certain degree of readability.
The procedure has to rely that the input parameter is indeed of type "window". In other procedures (in winstyle.p) I used to traverse up the GetParent chain until a window with a caption was found. That would not work for a Splash screen.
Can't use 4GL attributes to find the size of a window, because winhandle:width-pixels and winhandle:height-pixels return the dimensions of the Client area. It is convenient but confusing that winhandle:x and winhandle:y are the coordinates of the NonClient area.
procedure SystemParametersInfo is highly interesting: it can return or change many many configuration settings from the 'Control Panel'. However it only returns the working area for the primary display monitor.
Functions RunningWindows98() and RunningWindows2000() are listed on page which version of Windows is running
Creating a Palette or floating toolwindow
This example uses the source in procedure winstyle.p available in WinStyle.p.
A palette, or floating toolwindow should have these three features:
* a small title bar
* no associated button on the Taskbar because it is considered a popup-window of its 'client'
* stays on top, at least relative to the window it is 'serving'
The first two features are done automatically when pushing the WS_EX_PALETTEWINDOW style. Controlling the behavior of 'stay-on-top' requires some extra work in P4GL.
Controlling the Stay-on-top behavior
When a window has the Topmost style it will always be visible in front of all other windows that don't have the Topmost style. That is practically on top of all other windows. So when you create a palette in Progress with the Topmost style and switch to a different application (say, a web browser) you will still see the palette on top of the web browser. That is more than you bargained for and can not be tolerated.
What you really want is a window that is only Topmost relative to other windows in the same application (or in the same thread or in the same process, that's all pretty similar) and it is surprising that Windows does not support that requirement. So we will have to code it ourselves.
A floating toolbar is typically invoked by and working for one particular window. The same can be assumed for a palette window although the Progress UIB shows an exception to this 'rule'. For simplicity sake I will work with the assumption there are two windows involved: the Main window and its Palette window. The goal is: if win-Main is active we must assure that win-Palette has the Topmost style, if focus moves to a different window we must assure that the Topmost style gets removed from win-Palette.
So we will use the ON ENTRY and ON LEAVE triggers of win-Main.
This approach has one documented bug: if you leave win-Main to activate a different application you get no ON LEAVE event. Oh well, the user will click the win-Palette in an impulse and thus trigger the ON LEAVE of win-Main... it's not great but better than before.
To get a reliable ON LEAVE you should have to subclass the win-Main, but that's too far from 4GL for now. If required you might try the MsgBlaster control.
Examples
There are at least three procedure files involved: winmain.w implementing win-Main as mentioned above, palette.w implementing the palette window and winstyle.p being a library of procedures where the WS_EX_PALETTEWINDOW style is applied. Let's go:
/* some fragments from winmain.w */
DEFINE VARIABLE hPalette AS HANDLE un-undo.
ON ENTRY OF win-Main
DO:
RUN SetTopMost IN hPalette(YES) NO-ERROR.
END.
ON LEAVE OF win-Main
DO:
RUN SetTopMost IN hPalette(NO) NO-ERROR.
END.
ON CHOOSE OF BUTTON-palette IN FRAME DEFAULT-FRAME /* Show Palette */
DO:
RUN SetTopMost IN hPalette(YES) NO-ERROR.
IF ERROR-STATUS:ERROR THEN DO:
RUN Palette.w PERSISTENT SET hPalette.
RUN SetTopMost IN hPalette(YES) NO-ERROR.
END.
END.
/* some fragments from palette.w */
{windows.i}
/* add to Mainblock: */
DEFINE VARIABLE hStyle AS HANDLE NO-UNDO.
RUN WinStyle.p PERSISTENT SET hStyle.
RUN AddPaletteStyle IN hStyle ({&window-name}:HWND).
DELETE PROCEDURE hStyle.
/* add internal procedure: */
PROCEDURE SetTopMost :
/*------------------------------------------------------------------------------
Purpose: prevents overlapping on other applications
Parameters: logical TopMost : yes = switch TopMost on
no = switch TopMost off
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER TopMost AS LOGICAL NO-UNDO.
DEFINE VARIABLE hNonClient AS INTEGER NO-UNDO.
DEFINE VARIABLE hwndInsertAfter AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
hNonClient = GetParent({&window-name}:HWND).
IF TopMost THEN
hwndInsertAfter = {&HWND_TOPMOST}.
ELSE
hwndInsertAfter = {&HWND_NOTOPMOST}.
RUN SetWindowPos IN hpApi
( hNonClient,
hwndInsertAfter,
0,0,0,0, /* x,y,width,height : will be ignored */
{&SWP_NOMOVE} + {&SWP_NOSIZE} + {&SWP_NOACTIVATE},
OUTPUT ReturnValue
).
END PROCEDURE.
Explanation
The above source is pretty straightforward, I think. The contents of procedure AddPaletteStyle is another cup of tea, let's take a look:
First, the procedure needs to determine the hwnd of the NonClient-area because that's the window that owns the title bar (or 'Caption' in ms-talk). It finds it by repeatedly calling GetParent until it finds a window with a caption.
It is very weird to set the WS_EX_PALETTEWINDOW style when the window is already realized. To make it easier for Windows we first hide the window by calling ShowWindow(hwnd,0,output RetVal), this results also in the hiding of the Taskbar button. If you would not hide the window it would get the WS_EX_PALETTEWINDOW style alright but the Taskbar would become a mess, since Windows didn't really anticipate this.
Since we used ShowWindow to hide the window you might expect that we also use ShowWindow in the end to show it again. No need, because we already needed SetWindowPos we might as well give it the extra SWP_SHOWWINDOW option.
Because the caption shrinks, the entire window must shrink or else there will be a gap between the caption and the client-area. Procedure 'FitFrame' implements api-calls for calculating the required size for the NonClient-area.
Disabling the Close button
Introduction
Author: Todd G. Nist, Protech Systems Inc.
The source code for the window as shown in the picture is attached: w-disablex.w.
When you want to disable the [X]-button in the title bar and also want to remove the 'Close'-option from the system menu, you only have to call this function from within the main block of the window:
{windows.i}
FUNCTION DisableWindowClose RETURNS LOGICAL
( /* parameter-definitions */ ) :
/*---------------------------------------
Purpose:
Notes:
-----------------------------------------*/
DEFINE VARIABLE hSysMenu AS INTEGER NO-UNDO.
DEFINE VARIABLE hParent AS INTEGER NO-UNDO.
DEFINE VARIABLE hInstance AS INTEGER NO-UNDO.
DEFINE VARIABLE iRetCode AS INTEGER NO-UNDO.
DEFINE VARIABLE iCnt AS INTEGER NO-UNDO.
RUN GetParent IN hpApi(INPUT {&window-name}:HWND,
OUTPUT hParent).
/* Get handle to the window's system menu
(Restore, Maximize, Move, close etc.) */
RUN GetSystemMenu IN hpApi(INPUT hParent,
INPUT 0,
OUTPUT hSysMenu).
IF hSysMenu NE 0 THEN
DO:
/* Get System menu's menu count */
RUN GetMenuItemCount IN hpApi(INPUT hSysMenu,
OUTPUT iCnt).
IF iCnt NE 0 THEN
DO:
/* Menu count is based on 0 (0, 1, 2, 3...) */
/* remove the "close option" */
RUN RemoveMenu IN hpApi(INPUT hSysMenu,
INPUT iCnt - 1,
INPUT {&MF_BYPOSITION} + {&MF_REMOVE},
OUTPUT iRetCode).
/* remove the seperator */
RUN RemoveMenu IN hpApi(INPUT hSysMenu,
INPUT iCnt - 2,
INPUT {&MF_BYPOSITION} + {&MF_REMOVE},
OUTPUT iRetCode).
/* Force caption bar's refresh which
will disable the window close ("X") button */
RUN DrawMenuBar IN hpApi(INPUT hParent,
OUTPUT iRetCode).
{&window-name}:TITLE = "Try to close me!".
END. /* if iCnt NE 0... */
END. /* if hSysMenu NE 0... */
RETURN FALSE. /* Function return value. */
END FUNCTION.
Notes
Because you now have restricted the user from closing the window you will have to close it yourself from within 4GL. This statement will do it:
apply "window-close" to {&window-name}.
There are many ways for doing things. To refresh the title bar, instead of running DrawMenuBar, you could also
run FlashWindow in hpApi(hParent,0, output iRetCode).
FlashWindowEx
You can use this function when you want the taskbar button to flash.
run FlashTray. PROCEDURE FlashTray : DEFINE VARIABLE pfwi AS MEMPTR NO-UNDO. DEFINE VARIABLE hwndParent AS INTEGER NO-UNDO. RUN GetParent (CURRENT-WINDOW:HWND, OUTPUT hwndParent). SET-SIZE (pfwi) = 20. PUT-LONG (pfwi, 1) = GET-SIZE(pfwi). PUT-LONG (pfwi, 5) = hwndParent. PUT-LONG (pfwi, 9) = 2. /* = FLASW_TRAY */ PUT-LONG (pfwi,13) = 3. /* number of times to blink */ PUT-LONG (pfwi,17) = 0. /* blink rate in msec, 0=use system default */ RUN FlashWindowEx ( pfwi ). SET-SIZE(pfwi) = 0. END PROCEDURE. PROCEDURE GetParent EXTERNAL "user32.dll" : DEFINE INPUT PARAMETER ipWindow AS LONG. DEFINE RETURN PARAMETER ipParent AS LONG. END PROCEDURE. PROCEDURE FlashWindowEx EXTERNAL "user32.dll": DEFINE INPUT PARAMETER ipWindow AS MEMPTR. END PROCEDURE.
GetDeviceCaps
Procedure GetDeviceCaps allows you to find many device capabilities, like: how many colors can be displayed, can a font be scaled or rotated, is the device capable of drawing lines or circles.
The "Device" can be the display but the procedure is also important for measuring the capabilities of a printer device, because your print routine may have to use different logic for penplotters or laserprinters or matrixprinters. Of course Windows can not actually measure the device but has to rely on the the device driver written by the manufacturer of the device.
You will use this procedure often together with GetSystemMetrics (to find out the dimensions of scrollbars or other objects) and with DeviceCapabilities (for printers only, to find info about paper sizes, orientation, number of bins and more)
How many colors can be displayed on screen?
A TrueColor picture can not be displayed when the display is configured for only 16 colors. At least not nicely. Suppose you have different sets of pictures for different display settings and now you want your program to decide which ones to use. You can do this by calling GetDeviceCaps, asking for the value on the BITSPIXEL index.
{windows.i}
&GLOBAL-DEFINE BITSPIXEL 12
DEFINE VARIABLE ncolors AS INTEGER NO-UNDO.
DEFINE VARIABLE txt AS CHARACTER NO-UNDO.
RUN GetDisplayCaps( INPUT {&BITSPIXEL}, OUTPUT ncolors).
CASE ncolors :
WHEN 1 THEN txt = "16 colors".
WHEN 8 THEN txt = "256 colors".
WHEN 16 THEN txt = "High Color (16 bits per pixel)".
WHEN 24 THEN txt = "True Color (24 bits per pixel)".
WHEN 32 THEN txt = "True Color (32 bits per pixel)".
OTHERWISE txt = "an unusual color depth!".
END CASE.
MESSAGE "your display is configured for " txt
VIEW-AS ALERT-BOX.
Procedure GetDisplayCaps is a wrapper for the GetDeviceCaps and only works for the Display device. That's because the HDC (handle to device context) is used for a window. Any window will do, because all windows are on the same screen... This procedure uses the Progress DEFAULT-WINDOW because it always exists. If you want to find capabilities of a printer, you don't use GetDC but CreateDC.
PROCEDURE GetDisplayCaps : /* Wrapper for GetDeviceCaps when Device=display */ DEFINE INPUT PARAMETER cap-index AS INTEGER NO-UNDO. DEFINE OUTPUT PARAMETER capability AS INTEGER NO-UNDO. DEFINE VARIABLE hdc AS INTEGER NO-UNDO. DEFINE VARIABLE OK AS INTEGER NO-UNDO. RUN GetDC IN hpApi(INPUT DEFAULT-WINDOW:HWND, OUTPUT hdc). RUN GetDeviceCaps IN hpApi(INPUT hdc,INPUT cap-index, OUTPUT capability). RUN ReleaseDC IN hpApi(INPUT DEFAULT-WINDOW:HWND, INPUT hdc, OUTPUT OK). END PROCEDURE.
Hiding the taskbar button
or actually: window parenting
Warning:
Reparenting windows affects messaging. There is no way of knowing if this confuses the internals of the Progress runtime module. I would personally not dare to use something like this in a production environment.
One of the most Frequently Asked Questions is: "Every window has a taskbar button, how can I make those buttons invisible?"
The answer is that every unowned window or every window that does not have a parent has a taskbar button, except windows that have the 'toolwindow' style. So all you have to do is give your window a parent... easier said than done, because a parented window is normally glued to its parents client area and can't be moved away from that parent...
The solution was found by accident, it is actually a bug but is seems to work without negative side effects, as far as I can see. In fact, I see some cool side effects...
If you want window A to be parent of window B, you should normally use SetParent(B,A) but I accidently used SetWindowLong(B, -8, A). This was a silly mistake, nothing seemed to happen except the taskbar button for window B was gone!
I wonder if this is a bug or a feature. If it is a bug, it might not work in future Windows versions (mine is 95 with Service Pack 1).
By the way: I love taskbar buttons. I hate windows without taskbar buttons... but since it is a FAQ:
Example source
Suppose the project has one main window (a typical UIB-like menu tool) and this mainwin launches a couple of other windows. You only accept one taskbar button.
The main window uses this procedure to start a window:
{windows.i}
{winfunc.i}
ON CHOOSE OF btnLaunch IN FRAME DEFAULT-FRAME /* Start window without Taskbar button */
DO:
DEFINE VARIABLE hp AS HANDLE NO-UNDO.
DEFINE VARIABLE hWindow AS HANDLE NO-UNDO.
DEFINE VARIABLE hOldParent AS INTEGER NO-UNDO.
RUN noTaskBar.w PERSISTENT SET hp.
RUN GetWindowHandle IN hp (OUTPUT hWindow).
RUN SetWindowLongA IN hpApi (GetParent(hWindow:HWND),
-8,
GetParent({&WINDOW-NAME}:HWND), /* or DEFAULT-WINDOW:HWND */
OUTPUT hOldParent).
END.
The launched window must have an internal procedure "GetWindowHandle" that returns the Progress widget handle for the newly created window:
PROCEDURE GetWindowHandle :
DEFINE OUTPUT PARAMETER hWindow AS HANDLE NO-UNDO.
hWindow = {&WINDOW-NAME}:HANDLE.
END PROCEDURE.
Cool side effects:
As shown in the above example, you can parent the new window to
GetParent({&WINDOW-NAME}:HWND) or to
DEFAULT-WINDOW:HWND
or to any other window. There is a strange but great bonus in the first choice:
The main window can not overlap the child windows. In a normal UIB-like application you get to see a lot of pieces of desktop and other underlying programs between your Progress windows, with the risc of activating one of them when you click one by accident.
Now you can safely maximize your main window - it hides the background but will never hide any other project windows. It has like a 'stay-on-bottom' effect.
If you minimize the mainwin, all other windows will be minimized too. If you restore the minimized mainwin, all open child windows will appear again.
If you use DEFAULT-WINDOW:HWND you have the benefit of an always available handle but the mainwin will not control the others.
Problem ON CLOSE:
When you close the parent window, all child windows seem to be closed as well (which is fine). I am not sure if Progress knows about that: if the child window procedure has an 'ON WINDOW-CLOSE' event handler it will not be called. To play safe, you should catch the 'close' in the parent procedure and notify all children.
LockWindowUpdate
If you use dynamic widgets, or if you dynamically resize or reposition widgets, you simply have to use function LockWindowUpdate especially on NT Terminal Server.
This is probably the most widely used API function, covered in every presentation and every publication. Actually that's why I didn't bother to cover LockWindowsUpdate before, but here it is at last...
PROCEDURE LockWindowUpdate EXTERNAL "user32.dll" : DEFINE INPUT PARAMETER hWndLock AS LONG. DEFINE RETURN PARAMETER IsLocked AS LONG. END PROCEDURE.
- hWndLock specify a windows handle to request a lock for that window. Specify 0 to clear the lock.
- IsLocked returns 0 if the function fails, nonzero if the function succeeds.
LockWindowUpdate temporarily disables drawing in the specified window. While a window is locked you can change the appearance of the window or the appearance and/or positions of its child windows (widgets). These changes will not be drawn until the window is unlocked. When the window is unlocked its area will be invalidated and will eventually receive a WM_PAINT message. LockWindowUpdate will improve the overall performance of a drawing operation when you need to modify several widgets.
You should not move, resize, or hide/view the locked window while it has a lock. If you do you will see the desktop or other surrounding windows flash.
Only one window at a time can be locked.
If LockWindowUpdate failed (returned IsLocked=0) it may be because an other window owns the lock. This means you should not call LockWindowUpdate(0,..) if you didn't get the lock in the first place, because you may inadvertently unlock a different window.
a demo program
Procedure LockWindowUpdate.w, which is attached, shows a window with a whole lot of widgets in it. When you press button "Move Widgets" each widget will be moved and resized a random amount of pixels. This operation is very slow and flashy if "use LockWindowUpdate" is not toggled.
The demo also shows the effect of hiding the frame during LockWindowUpdate: the window itself will behave quite nicely but all other visible windows, including the desktop will accidently be redrawn.
Attachments
lockwindowupdate.w.zip : example source
Manipulating scrollbars
Progress frames and windows show both scrollbars or none.
It would be better if the scrollbars were shown independently.
The procedure ShowScrollbarsWhenNeeded is to be called 'on end-size' or during initialize.
The procedure HideScrollbars does simply that: hide both scrollbars whether or not the virtual size is larger than the actual size. The procedure is mainly a demonstration of the {&SB_BOTH} constant.
{windows.i}
PROCEDURE ShowScrollbarsWhenNeeded :
/* purpose : to be called from "on end-size" or whenever. */
DEFINE INPUT PARAMETER hFrame AS HANDLE.
DEFINE VARIABLE retval AS INTEGER NO-UNDO.
IF hFrame:VIRTUAL-WIDTH-PIXELS > hFrame:WIDTH-PIXELS THEN
RUN ShowScrollBar IN hpApi (hFrame:HWND,
{&SB_HORZ},
-1,
OUTPUT retval).
ELSE
RUN ShowScrollBar IN hpApi (hFrame:HWND,
{&SB_HORZ},
0,
OUTPUT retval).
IF hFrame:VIRTUAL-HEIGHT-PIXELS > hFrame:HEIGHT-PIXELS THEN
RUN ShowScrollBar IN hpApi (hFrame:HWND,
{&SB_VERT},
-1,
OUTPUT retval).
ELSE
RUN ShowScrollBar IN hpApi (hFrame:HWND,
{&SB_VERT},
0,
OUTPUT retval).
END PROCEDURE.
PROCEDURE HideScrollbars :
/* purpose : hide both scrollbars */
DEFINE INPUT PARAMETER hFrame AS HANDLE.
DEFINE VARIABLE retval AS INTEGER NO-UNDO.
RUN ScrollUpperLeft(hFrame).
RUN ShowScrollBar IN hpApi (hFrame:HWND,
{&SB_BOTH},
0,
OUTPUT retval).
END PROCEDURE.
PROCEDURE ScrollUpperLeft :
/* purpose : move both scrollbars to their 0% position */
DEFINE INPUT PARAMETER hFrame AS HANDLE.
DEFINE VARIABLE wParam AS INTEGER NO-UNDO.
DEFINE VARIABLE nPos AS INTEGER NO-UNDO.
DEFINE VARIABLE RetVal AS INTEGER NO-UNDO.
nPos = 0.
wParam = (nPos * 256) + {&SB_THUMBPOSITION}.
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_HSCROLL}, wParam, 0, OUTPUT RetVal).
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_VSCROLL}, wParam, 0, OUTPUT RetVal).
END PROCEDURE.
Explanation:
In procedure ScrollUpperleft, wParam has SB_THUMBPOSITION in its low byte to let windows know that you want to do something with the thumb position. The wanted position (nPos=0) is placed in the high byte by multiplying it by 256.
Frankly I only tried the value nPos=0 so I might as well have assigned
wParam = {&SB_THUMBPOSITION}.
For any other value for nPos you should test if the factor '256' is adequate for both 16-bits and 32-bits versions! (I guess not).
Easier ways to scroll
{windows.i}
DEFINE VARIABLE RetVal AS INTEGER NO-UNDO.
&GLOBAL-DEFINE SB_PAGEUP 2
&GLOBAL-DEFINE SB_PAGEDOWN 3
&GLOBAL-DEFINE SB_TOP 6
PROCEDURE ScrollUpperLeft :
/* purpose : move both scrollbars to their 0% position */
DEFINE INPUT PARAMETER hFrame AS HANDLE.
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_HSCROLL}, {&SB_TOP}, 0, OUTPUT RetVal).
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_VSCROLL}, {&SB_TOP}, 0, OUTPUT RetVal).
END PROCEDURE.
PROCEDURE PageDown :
DEFINE INPUT PARAMETER hFrame AS HANDLE.
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_VSCROLL}, {&SB_PAGEDOWN}, 0, OUTPUT RetVal).
END PROCEDURE.
PROCEDURE PageUp :
DEFINE INPUT PARAMETER hFrame AS HANDLE.
RUN SendMessage{&A} IN hpApi (hFrame:HWND, {&WM_VSCROLL}, {&SB_PAGEUP}, 0, OUTPUT RetVal).
END PROCEDURE.
Maximize, minimize a window
Ever tried to maximize a Progress window, with respect to the size and position of the Windows Taskbar? It is easy if you know about this not-well-documented feature (in 8.2A and up):
ASSIGN
{&WINDOW-NAME}:MAX-HEIGHT = ?
{&WINDOW-NAME}:MAX-WIDTH = ?
{&WINDOW-NAME}:WINDOW-STATE = WINDOW-MAXIMIZED.
The fun part is assigning the unknown value to max-height/width. This results in dynamic resizing even when the user moves the Taskbar or changes the display resolution!
Minimize and Restore
To restore a Window to its original state, use the following code:
ASSIGN {&WINDOW-NAME}:WINDOW-STATE = WINDOW-NORMAL.
To minimize a Window, use the following code:
ASSIGN {&WINDOW-NAME}:WINDOW-STATE = WINDOW-MINIMIZED.
Minimizing a window to the System Tray
by Rob den Boer
The attached example procedure creates a Progress window. When the window is minimized, it shows an icon in the system tray (that's in the corner of the taskbar, next to the clock). Features of this tray icon are:
* on left mouse click, the window is restored
* on right mouse click a popup-menu appears (as shown on picture)
* the icon has a tooltip
* the icon can be animated
Installing the example
Download systray.zip (12 kilobyte) and unzip it to a directory in your PROPATH.
The example was created using the AppBuilder in Progress 9, it will have to be rewritten to run in Progress 8. The example uses the PSTimer ActiveX control and also the MsgBlaster control.
How it works
Run procedure ip-systray-init when the window gets initialized.
This procedure takes three input parameters: a unique ID for the icon, a comma-separated list of .ico filenames and a tooltip string.
Procedure ip-systray-init shows the icon and sets the MsgBlaster OCX to pass mouse-messages from the icon on to the Progress procedure. The event-handler for the MsgBlaster contains the code for showing the popup-menu (on mouse-menu-click) or for restoring the window (on mouse-select-click).
The icon can be animated only by using a PSTimer control: on pstimer.tick simply run ip-next-icon. This procedure fetches the next name from a comma-separated list of .ico filenames and updates the taskbar icon. You may refine this procedure by using an Imagelist control.
Don't forget to call procedure ip-systray-exit when the program ends.
API-procedures used in this example are listed here to be included in the search index: PROCEDURE SHGetFileInfoA EXTERNAL "shell32" PROCEDURE Shell_NotifyIconA EXTERNAL "shell32" PROCEDURE SendMessageA EXTERNAL "user32"
More Progress examples available on the homepage of Rob den Boer: http:home.hccnet.nl/rc.den.boer/progress/index.html
Attachments
systray.zip : (by Rob den Boer, improved by Peter Kiss)
Painting in Progress frames
Sometimes you may want to do some extra painting on a Progress frame or window, for example some circles, dotted lines, dashed area's or just lines that are not horizontal or vertical. Or how about right-aligned text?
The actual drawing can be done with GDI functions, but the result will be erased whenever Progress repaints the frame (or window). This topic is about preventing that.
Let's start with a simple example: drawing an ellipse on a Progress frame.
create a Progress window (doesn't have to be Smart) and place a button on it. On choose of this button: run Paint.
PROCEDURE PAINT :
/*----------------------------------------------------
Purpose: do some custom painting, in this case:
draw a circle as large as the window
------------------------------------------------------ */
DEFINE VARIABLE hdc AS INTEGER NO-UNDO.
DEFINE VARIABLE Okay AS INTEGER NO-UNDO.
RUN GetDC IN hpApi (INPUT FRAME {&frame-name}:HWND,
OUTPUT hdc).
RUN Ellipse IN hpApi (hdc,
0,
0,
FRAME {&frame-name}:WIDTH-PIXELS,
FRAME {&frame-name}:HEIGHT-PIXELS,
OUTPUT Okay ).
RUN ReleaseDC IN hpApi (INPUT FRAME {&frame-name}:HWND,
INPUT hdc,
OUTPUT Okay).
END PROCEDURE.
Now when you run the window and press the button you will see a large ellipse. When you drag any other window over the surface of your window, you will see that overlapped regions of the ellipse will be erased. To repaint the ellipse you can just press the button again, but you want a way to do this automatically.
When should you repaint your drawings?
A (region of a) window will be painted again when it has been overlapped by another window, or whenever the (region of the) window has become invalidated. MS-Windows sends a series of messages to the window when it is invalidated and Progress responds to it by painting the region again. Among those messages are WM_ERASEBKGND and WM_PAINT.
I have always believed that WM_PAINT was the proper message to wait for, but there are occasions when you see that progress repaints the window without ever having trapped a WM_PAINT message. Result: your custom drawing is erased.
Matt Gilarde at PSC Development explains what's going on:
Progress doesn't repaint a frame when it gets a WM_PAINT message; we do it when we get a WM_ERASEBKGND. Why? I believe the idea was to avoid flashing during repaints. Instead of wiping out the background in the WM_ERASEBKGND and then repainting widgets in the WM_PAINT, Progress does all the painting during WM_ERASEBKGND. Painting a frame consists of the following steps:
* Fill the frame with the background color
* Draw the grid if it is on
* Paint rectangles and images
* Paint all other widgets
* Highlight selected widgets
Since the painting is handled in WM_ERASEBKGND, the WM_PAINT message is not always generated (Windows removes the WM_PAINT from the message queue if there is no invalid region to be painted). So you may have better luck trapping WM_ERASEBKGND. Or you may run into other problems.
So you will have to set up your MessageBlaster to trap WM_ERASEBKGND instead WM_PAINT.
Let's do it:
Drop a MessageBlaster ActiveX control on your window and set it up as follows:
PROCEDURE CtrlFrame.Msgblst32.MESSAGE .
DEFINE INPUT PARAMETER p-MsgVal AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER p-wParam AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER p-lParam AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p-lplRetVal AS INTEGER NO-UNDO.
CASE p-MsgVal :
WHEN 20 /* = WM_ERASEBKGND */ THEN RUN paint.
END CASE.
END PROCEDURE.
PROCEDURE initialize-controls :
/*------------------------------------------------------------------------------
Purpose: listen for WM_ERASEBKGND messages
------------------------------------------------------------------------------*/
chCtrlFrame:Msgblst32:MsgList(0) = 20. /* = WM_ERASEBKGND */
chCtrlFrame:Msgblst32:MsgPassage(0) = -1. /* = let PSC handle the message first */
chCtrlFrame:Msgblst32:hWndTarget = FRAME {&frame-name}:HWND.
END PROCEDURE.
How to force a repaint?
If you want Progress to repaint the entire frame (or window), for example to erase your custom painting, you can not just send it a WM_ERASEBKGND message. Here's another excellent explanation from Matt Gilarde:
Sending WM_ERASEBKGND won't cause any repainting to be done since it requires the wParam to be the handle to a device context for the area which is to be repainted. To force a repaint, you need to invalidate all or part of the window or frame. Windows will then generate the proper WM_ERASEBKGND and WM_PAINT messages. You can use the InvalidateRect() API to invalidate a window.
BOOL InvalidateRect(HWND hWnd, RECT *lpRect, BOOL bErase);
Calling InvalidateRect(hWnd, 0, 1) will force the entire window to repaint. You can call UpdateWindow(hWnd) to force the repaint to occur immediately (otherwise the paint messages will sit in the message queue until Progress gets around to looking for them). The result may not be what you want, however, since there may be lots of flashing when you force the repaint.
Removing min/max buttons from the title bar
This example uses the source in procedure winstyle.p, available on page WinStyle.
A normal window can be maximized to full-screen but a Progress window doesn't grow much unless you specifically set virtual sizes. Maximizing (or resizing at all) isn't very useful for a window that has a fixed amount of widgets, so you might prefer to hide the Maximize button. And while we are at it let's also hide the Minimize button.
Here's how you do it:
Create a Progress window and place this code fragment somewhere in the source:
ASSIGN {&window-name} :MIN-BUTTON = NO
{&window-name} :MAX-BUTTON = NO.
Explanation
Let's take a look at the source in winstyle.p.
The title bar is on the NonClient-area of the window, but the input parameter {&window-name}:hWnd is the Client-area. So the first task is to find the hWnd of the NonClient-area, this is simply done by repeatedly calling GetParent until a window is found that owns a caption. This method allows that the input parameter can be any widget:hWnd.
Now the style flags are fetched from the already existing NonClient-window, some style bits are set to zero and the new style is pushed back into the window. The min/max buttons are now invalid so I figured it's reasonable to make resizing of the window impossible.
The standard frame of type WS_THICKFRAME is sensitive for the mouse; users can drag the frame to resize it, so I also deleted the WS_THICKFRAME style. This means you now get a frame that is slightly less thick. Because of that you get to see a narrow transparent area between the new thin frame and the Client-area. This must be solved by shrinking the NonClient window until it tightly fits around the Client window.
The api function AdjustWindowRect is designed to calculate the required size of a window, given a certain size for the Client-area. So that's what we call. The size of the client-area is found by calling GetClientRect.
The new dimensions for the NonClient window are assigned by the SetWindowPos function.
We're done!
The menu-items in the system-menu for 'Size', 'Minimize' and 'Maximize' are automatically disabled as a result of the new window style. Disabled menu-items imply they may become enabled, so I decided to delete them.
Splash window
Splash is the name for a window that is shown during startup of an application. It masks a long loading time (for example during establishing connections to remote databases) and is often used to show the application title, 'licensed to'-info, author name and often a nice picture.
A Splash has no user interaction; a user must simply wait until the show begins. Therefore a Splash should not have a title bar and especially no 'close' button. It's common to display the Splash in the exact center of the screen and it also usually 'stays-on-top'.
Most people use third-party 3GL languages to create a Splash screen because it seems impossible to create one in Progress. The downside of using an external program is that it's hard to determine the proper time to close. This would be lots easier if the Splash was created in Progress and then it would also be possible to give status information (like "now connecting to system.db").
The next procedure accepts the hWnd of a Progress window (not a Frame or Dialog!) and makes it look like a Splash by removing the title bar and the thick frame, centering it to the screen and making it topmost.
/* ===================================================================
file : MkSplash.p
by : Jurjen Dijkstra, 1997
language : Progress 8.2A on Windows 95
purpose : changes the appearance of a normal Progress window
into a Splash window, e.g. no caption, no border,
centered to screen, stay-on-top.
params : hClient = HWND of a client window
ThinBorder = YES if a WS_BORDER style is wanted
NO creates no border at all
usage : during mainblock:
run MkSplash.p ({&WINDOW-NAME}:HWND, YES).
=================================================================== */
DEFINE INPUT PARAMETER hClient AS INTEGER.
DEFINE INPUT PARAMETER ThinBorder AS LOGICAL.
{windows.i}
{ProExtra.i}
DEFINE VARIABLE hNonclient AS INTEGER NO-UNDO.
DEFINE VARIABLE style AS INTEGER NO-UNDO.
DEFINE VARIABLE oldstyle AS INTEGER NO-UNDO.
hNonclient = GetParent(hClient).
/* delete the caption and the thickframe */
RUN GetWindowLong{&A} IN hpApi(hNonclient, {&GWL_STYLE}, OUTPUT style).
RUN Bit_Remove IN hpExtra(INPUT-OUTPUT style, {&WS_CAPTION}).
RUN Bit_Remove IN hpExtra(INPUT-OUTPUT style, {&WS_THICKFRAME}).
RUN SetWindowLong{&A} IN hpApi(hNonclient, {&GWL_STYLE}, style, OUTPUT oldstyle).
/* the next block creates a thin border around the window.
This has to be done in a second SetWindowLong */
IF ThinBorder THEN DO:
RUN GetWindowLong{&A} IN hpApi(hNonclient, {&GWL_STYLE}, OUTPUT style).
RUN Bit_Or IN hpExtra(INPUT-OUTPUT style, {&WS_BORDER}).
RUN SetWindowLong{&A} IN hpApi(hNonclient, {&GWL_STYLE}, style, OUTPUT oldstyle).
END.
/* The above changes in window styles are usually done before the window is
created. Now we are actually too late, windows will not respond with an
automatic redraw of the window. We will have to force it. This is done by
calling SetWindowPos with the SWP_FRAMECHANGED flag.
Since we are calling SetWindowPos we might as well ask it to perform
some other actions, like:
make this a TOPMOST window,
change the coordinates (centered to screen)
*/
DEFINE VARIABLE lpRect AS MEMPTR NO-UNDO.
DEFINE VARIABLE WIDTH AS INTEGER NO-UNDO.
DEFINE VARIABLE HEIGHT AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
/* the lpRect structure is defined as LEFT,TOP,RIGHT,BOTTOM. */
SET-SIZE(lpRect) = 4 * {&INTSIZE}.
/* get the dimensions of the client area: */
RUN GetWindowRect IN hpApi(hClient,
GET-POINTER-VALUE(lpRect),
OUTPUT ReturnValue).
/* let Windows calculate how large the NonClient area must be
to fit exactly around the Client area: */
RUN AdjustWindowRect IN hpApi(GET-POINTER-VALUE(lpRect), style, 0, OUTPUT ReturnValue).
/* so these will be the new dimensions of the Nonclient area: */
WIDTH = get-{&INT}(lpRect, 1 + 2 * {&INTSIZE})
- get-{&INT}(lpRect, 1 + 0 * {&INTSIZE}).
HEIGHT = get-{&INT}(lpRect, 1 + 3 * {&INTSIZE})
- get-{&INT}(lpRect, 1 + 1 * {&INTSIZE}).
SET-SIZE(lpRect) = 0.
/* Do it. SWP_FRAMECHANGED is the most important flag here */
RUN SetWindowPos IN hpApi
(hNonclient,
-1, /* = HWND_TOPMOST */
INTEGER((SESSION:WIDTH-PIXELS - WIDTH) / 2),
INTEGER((SESSION:HEIGHT-PIXELS - HEIGHT) / 2),
WIDTH,
HEIGHT,
{&SWP_NOACTIVATE} + {&SWP_FRAMECHANGED},
OUTPUT ReturnValue
).
RETURN.
Notes:
The call to AdjustWindowRect assumes the window has no menu.
When centering the window I should have taken the visibility, position and size of Taskbar(s) into account. That would not have been too hard, see center a window to the working area
Parameter ThinBorder=NO causes the window to have no border at all. This looks nice if the Splash window is 100% covered with a picture that has its own edges.
Example
Zane Appel created an example Splash window, based on the mksplash.p procedure. This splash window will disappear after 5 seconds or when the user clicks anywhere on the splash window. The example is attached, see splashdm.zip
Attachments
splashdm.zip : demo by Zane Appel, based on mkspash.p
Tranparent window
In Windows 2000 you can make transparent windows, by using function SetLayeredWindowAttributes. The attached Progress procedure demonstrates this.
Attachments
transparent.w.zip : demo SetLayeredWindowAttributes