You would have to find a way to get the hdc (handle to device context)
for the Progress output. I think there is no way to get the hdc in
8.3A but version 9 has an attribute that returns the hdc.
I have played around with session
rinter-hdc in Progress 9: selected
different fonts and painted some lines and rectangles while
still using the DISPLAY statement.
It was a fun experiment but not worthwile, because Progress does
not evaluate the selected font when it calculates the line height, and
it also does not print columns at X positions but simply padds a number of
spaces as if you are using a fixed width font.
It is very difficult to get a nice looking output when mixing OUTPUT TO and
GDI calls. It's much easier when you use GDI only (or 4GL only).
I still have the experimental source, it may be just good enough for your
purpose (drawing something in the page header). It's v9 only:
<BLOCKQUOTE><font size="1" face="Arial, Verdana">code:</font><HR><pre>
def var PrintHeaderNow as logical no-undo initial no.
FUNCTION SetHeader returns char ():
PrintHeaderNow = TRUE.
RETURN "".
END FUNCTION.
/* ========= the (almost) usual 4GL output loop: ============= */
DEFINE FRAME custframe
customer.name no-label
customer.city no-label
SKIP
HEADER
SetHeader() FORMAT "x"
SKIP.
SYSTEM-DIALOG PRINTER-SETUP.
OUTPUT to printer.
RUN CreateGDIObjects.
FOR EACH customer WITH FRAME custframe:
IF PrintHeaderNow THEN DO:
RUN PrintPageHeader.
PrintHeaderNow = FALSE.
END.
DISPLAY customer.name
customer.city.
END.
RUN DeleteGDIObjects.
OUTPUT CLOSE.
RETURN.
/* ============= additional GDI features: ============= */
{win32/constants.i}
def var hStockFont as integer no-undo.
def var hStockPen as integer no-undo.
def var hHeaderFont as integer no-undo.
def var hBodyFont as integer no-undo.
def var hMyPen as integer no-undo.
def var returnValue as integer no-undo.
procedure CreateGDIObjects :
def var devcap as integer no-undo.
def var emheight as integer no-undo.
RUN CreatePen ({&PS_SOLID},6,RGB-VALUE(0,0,0),OUTPUT hMyPen).
RUN GetDeviceCaps (session
rinter-hdc, {&LOGPIXELSY}, OUTPUT devcap).
RUN MulDiv (20, devcap, 72, OUTPUT emheight).
emheight = 0 - emheight.
RUN CreateFontA ( emheight,
0,
0,
0,
700, /* bold */
1, /* italics */
0,
0,
{&ANSI_CHARSET},
{&OUT_DEFAULT_PRECIS},
{&CLIP_DEFAULT_PRECIS},
{&PROOF_QUALITY},
{&VARIABLE_PITCH} + {&FF_DONTCARE},
"Arial":U,
OUTPUT hHeaderFont).
RUN GetDeviceCaps (session
rinter-hdc, {&LOGPIXELSY}, OUTPUT devcap).
RUN MulDiv (8, devcap, 72, OUTPUT emheight).
emheight = 0 - emheight.
RUN CreateFontA ( emheight,
0, /* width (0=default) */
0, /* escapement */
0, /* orientation */
400, /* weight: LIGHT=300, NORMAL=400, BOLD=700 */
0, /* italics */
0, /* underline */
0, /* strikeout */
{&ANSI_CHARSET},
{&OUT_DEFAULT_PRECIS},
{&CLIP_DEFAULT_PRECIS},
{&PROOF_QUALITY},
{&FIXED_PITCH} + {&FF_DONTCARE},
"Courier New":U,
OUTPUT hBodyFont).
RUN SelectObject(session
rinter-hdc,
hBodyFont,
OUTPUT hStockFont).
end procedure.
procedure DeleteGDIObjects :
RUN SelectObject(session
rinter-hdc,
hStockFont,
OUTPUT ReturnValue).
RUN SelectObject(session
rinter-hdc,
hStockPen,
OUTPUT ReturnValue).
RUN DeleteObject(hHeaderFont, output ReturnValue).
RUN DeleteObject(hBodyFont, output ReturnValue).
RUN DeleteObject(hMyPen , output ReturnValue).
end procedure.
procedure PrintPageHeader :
if session
rinter-control-handle=0 or
session
rinter-control-handle=? or
session
rinter-hdc=0 then
return.
DEF VAR PageWidth as INTEGER NO-UNDO.
DEF VAR hOldPen as INTEGER NO-UNDO.
RUN GetDeviceCaps (SESSION
rinter-hdc,
{&HORZRES},
OUTPUT PageWidth).
RUN SelectObject(SESSION
rinter-hdc, hMyPen, OUTPUT hOldPen).
RUN SelectObject(SESSION
rinter-hdc, hHeaderFont, OUTPUT ReturnValue).
RUN RoundRect (SESSION
rinter-hdc,
4,
0,
PageWidth,
350,
150,
150,output ReturnValue).
run TextOutA(session
rinter-hdc,
100,100,
"Customers",
LENGTH("Customers"),
OUTPUT ReturnValue).
RUN SelectObject(SESSION
rinter-hdc, hOldPen, OUTPUT ReturnValue).
RUN SelectObject(SESSION
rinter-hdc, hBodyFont, OUTPUT ReturnValue).
end.
[/code]
---------------
Search-engine for Progress related websites:
http://home.wxs.nl/~jurjen.dijkstra/prodevring/ringsearch.html
Windows API examples for Progress 4GL:
http://home.wxs.nl/~jurjen.dijkstra/api/index.html
703)318-8502--Fax: (419) 793-7395--email: tedduke@erols.com