Kbase P17005: How to draw a line on a 4GL Frame? Not only horizontal or v
| Autor |
Progress Software Corporation - Progress |
| Acesso |
Público |
| Publicação |
3/19/2003 |
|
Status: Unverified
GOAL:
How to draw a line on a 4GL Frame? Not only horizontal or vertical...
FACT(s) (Environment):
Progress 9.X
FACT(s) (Environment):
Progress 8.X
FACT(s) (Environment):
Windows 32 Intel
FACT(s) (Environment):
Windows NT 32 Intel/Windows 2000
FIX:
The rectangle widget can be used to draw vertical or horizontal lines (with a small thickness), however there is no 4GL native widget yet to draw a diagonal line. (A enhancement request has been logged for that)
A solution is to use APIs in GDI32.DLL and USER32.DLL, as illustrated in sample code bellow. Problem is that the drawn lines will disappear as soon as Progress refreshes the frame, so a technique to catch a Progress-Windows repaint event needs to be implemented in order to redraw the lines. There is ready solution to achieve that with free message blaster OCX on the win32 API pages of www.global-shared.com (search for "Painting in Progress frames")
http://www.global-shared.com/cgi-bin/twiki/bin/view/Win32/PaintFrames
Code to draw lines with API of GDI32.DLL and USER32.DLL:
/* To add in definition block */
&GLOB USER "user32"
&GLOB GDI "gdi32"
PROCEDURE GetDC EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hwnd AS LONG.
DEFINE RETURN PARAMETER hdc AS LONG.
END PROCEDURE.
PROCEDURE ReleaseDC EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hwnd AS LONG.
DEFINE INPUT PARAMETER hdc AS LONG.
DEFINE RETURN PARAMETER ok AS LONG.
END PROCEDURE.
PROCEDURE CreatePen EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER nStyle AS LONG.
DEFINE INPUT PARAMETER nWidth AS LONG.
DEFINE INPUT PARAMETER ncolor AS LONG.
DEFINE RETURN PARAMETER hPen AS LONG.
END PROCEDURE.
PROCEDURE SelectObject EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS LONG.
DEFINE INPUT PARAMETER hPen AS LONG.
END PROCEDURE.
PROCEDURE MoveToEx EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS LONG.
DEFINE INPUT PARAMETER nx AS LONG.
DEFINE INPUT PARAMETER ny AS LONG.
DEFINE INPUT PARAMETER lppoint AS MEMPTR.
END PROCEDURE.
PROCEDURE LineTo EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS LONG.
DEFINE INPUT PARAMETER nx AS LONG.
DEFINE INPUT PARAMETER ny AS LONG.
END PROCEDURE.
PROCEDURE DeleteObject EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hPen AS LONG.
END PROCEDURE.
/* Example of use in a CHOOSE button button*/
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 1000:
RUN DrawLine(RANDOM(1,FRAME {&FRAME-NAME}:WIDTH-PIXELS), /*fromX*/
RANDOM(1,FRAME {&FRAME-NAME}:HEIGHT-PIXELS), /*FromY*/
RANDOM(1,FRAME {&FRAME-NAME}:WIDTH-PIXELS), /*ToX*/
RANDOM(1,FRAME {&FRAME-NAME}:HEIGHT-PIXELS), /*ToY*/
1, /*thickness*/
0, /*0: line, 1: long dashes, 2: small dashes,
3: axes, 4: double axe*/
RGB-VALUE(RANDOM(0,255),RANDOM(0,255),RANDOM(0,255))). /*
0-255 red , 0-255 green, 0-255 blue*/
END.
/* And finally, the DrawLine procedure */
PROCEDURE DrawLine:
DEFINE INPUT PARAMETER FromX AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER FromY AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER ToX AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER ToY AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER iThickness AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER iStyle AS INTEGER NO-UNDO.
DEFINE INPUT PARAMETER rgbColor AS INTEGER NO-UNDO.
DEF VAR hdc AS INTEGER NO-UNDO.
DEF VAR hpen AS INTEGER NO-UNDO.
DEF VAR Okay AS INTEGER NO-UNDO.
DEFINE VARIABLE lptr AS MEMPTR NO-UNDO.
RUN GetDC (INPUT FRAME {&frame-name}:HWND,
OUTPUT hdc).
RUN CreatePen (iStyle,
iThickness,
rgbColor,
OUTPUT hPen).
RUN SelectObject (hdc, hPen).
SET-SIZE(lptr) = 1. /*do not know the point of this pointer*/
PUT-B.YTE(lptr,1) = 0.
RUN MoveToEx (hdc,
FromX,
FromY,
lptr).
SET-SIZE(lptr) = 0. /*release that mptr*/
RUN LineTo (hdc,
ToX,
ToY).
RUN DeleteObject (hPen).
RUN ReleaseDC (INPUT FRAME {&frame-name}:HWND,
INPUT hdc,
OUTPUT Okay).
END PROCEDURE..