by Jurjen, improved by Ian Keene
/* ==============================================================
file : printscreen.p
by : Jurjen Dijkstra (Modified by Ian Keene Oct 2003)
dd : 05/16/1999
purpose : draw a window to the default printer.
usage : RUN printscreen.p ({&WINDOW-NAME}:HWND, YES).
parms : hWindow (integer)
HWND of the 'widget' to be drawn
GetParent (logical)
-Use YES if HWND is a Progress window widget
so printscreen.p will draw the border/titlebar.
-Use NO for all other widgets.
============================================================== */
DEFINE INPUT PARAMETER hWindow AS INTEGER NO-UNDO. /* HWND */
DEFINE INPUT PARAMETER GetParent AS LOGICAL NO-UNDO. /* hWindow=GetParent(hWindow)? */
RUN MakeDocument.
/* API definitions used in this proc have been moved to printscreen.i */
{printscreen.i}
PROCEDURE MakeDocument :
DEFINE VARIABLE hDC AS INTEGER NO-UNDO.
DEFINE VARIABLE lpDocInfo AS MEMPTR NO-UNDO.
DEFINE VARIABLE lpDocName AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE prt-buf AS CHARACTER NO-UNDO.
DEFINE VARIABLE prt-out AS CHARACTER NO-UNDO.
DEFINE VARIABLE err-check AS INTEGER NO-UNDO.
DEFINE VARIABLE drbuf AS CHARACTER NO-UNDO.
DEFINE VARIABLE out-buf AS CHARACTER NO-UNDO.
DEFINE VARIABLE prt-hwnd AS INTEGER NO-UNDO.
ASSIGN prt-out = FILL(" ",127). /* ALLOCATE MEMORY */
RUN GetProfileStringA (INPUT "WINDOWS",
INPUT "DEVICE",
INPUT "-unknown-,",
OUTPUT prt-out,
INPUT LENGTH(prt-out),
OUTPUT err-check).
IF prt-out = "-unknown-," THEN DO:
MESSAGE "Aborted, Cannot Determine Default Printer." SKIP
VIEW-AS ALERT-BOX INFORMATION.
RETURN.
END.
ASSIGN prt-buf = ENTRY(1,prt-out)
drbuf = ENTRY(2,prt-out)
out-buf = ENTRY(3,prt-out).
/* OPEN THE PRINTER */
RUN OpenPrinterA (INPUT prt-buf,
OUTPUT prt-hwnd,
INPUT 0).
RUN CreateDCA ( "WINSPOOL",
prt-buf,
0,
0,
OUTPUT hDC) .
IF hDC = 0 THEN DO:
MESSAGE "Error during CreateDCA in PrintScreen procedure"
view-as ALERT-BOX INFORMATION.
RETURN.
END.
SET-SIZE (lpDocName) = LENGTH("PrintScreen") + 1.
PUT-STRING(lpDocName,1) = "PrintScreen".
SET-SIZE (lpDocInfo) = 12.
PUT-LONG (lpDocInfo,1) = 12.
PUT-LONG (lpDocInfo,5) = GET-POINTER-VALUE(lpDocName).
PUT-LONG (lpDocInfo,9) = 0.
RUN StartDocA ( hDC,
GET-POINTER-VALUE(lpDocInfo),
OUTPUT ReturnValue).
IF ReturnValue < 1 THEN
MESSAGE "Error during StartDoc in PrintScreen procedure"
view-as ALERT-BOX INFORMATION.
ELSE DO:
RUN StartPage (hDC, OUTPUT ReturnValue).
IF ReturnValue < 1 THEN
MESSAGE "Error during StartPage in PrintScreen procedure"
view-as ALERT-BOX INFORMATION.
ELSE DO:
RUN PrintWindow (hDC, hWindow).
RUN EndPage (hDC, OUTPUT ReturnValue).
END.
RUN EndDoc (hDC, OUTPUT ReturnValue).
END.
/* cleanup */
RUN DeleteDC (hDC, OUTPUT ReturnValue).
SET-SIZE(lpDocInfo) = 0.
SET-SIZE(lpDocName) = 0.
END PROCEDURE. /* MakeDocument */
PROCEDURE PrintWindow :
/*------------------------------------------------------------------------------
Notes: a couple of extra parameters would be nice, like:
input leftmargin, rightmargin, Ytop
output Ybottom
------------------------------------------------------------------------------*/
define input parameter hdcDest as INTEGER NO-UNDO. /* Printer */
define input parameter hWin as INTEGER NO-UNDO. /* windows handle to progress window to print */
DEFINE VARIABLE hdcWin as integer no-undo. /* hdc window */
DEFINE VARIABLE PrintHorzRes as integer no-undo. /* printer resolution */
DEFINE VARIABLE PrintVertRes as integer no-undo.
DEFINE VARIABLE WinHorzRes as integer no-undo. /* display resolution */
DEFINE VARIABLE WinVertRes as integer no-undo.
DEFINE VARIABLE hdcComp as integer no-undo. /* hdc memory */
DEFINE VARIABLE hbmpComp as integer no-undo. /* bitmap in memory */
DEFINE VARIABLE hbmpDest as integer no-undo. /* bitmap on paper */
DEFINE VARIABLE WinWidth as INTEGER NO-UNDO. /* dimensions of window */
DEFINE VARIABLE WinHeight as INTEGER NO-UNDO.
DEFINE VARIABLE PictureWidth as integer no-undo. /* dimensions of picture on paper */
DEFINE VARIABLE PictureHeight as integer no-undo.
DEFINE VARIABLE Scale as decimal no-undo.
DEFINE VARIABLE xMargin as INTEGER NO-UNDO. /* center picture horizontally */
DEFINE VARIABLE numrows as integer no-undo. /* split large pics into rows/cols */
DEFINE VARIABLE numcols as integer no-undo.
DEFINE VARIABLE rw as integer no-undo.
DEFINE VARIABLE cl as integer no-undo.
DEFINE VARIABLE lpRect as MEMPTR NO-UNDO.
DEFINE VARIABLE ReturnValue as integer no-undo.
DEFINE VARIABLE lpOrigin as MEMPTR NO-UNDO.
IF getParent THEN
RUN GetParent(hWin, OUTPUT hWin).
/* get the window resolution */
run GetDC (hWin, output hdcWin).
run GetDeviceCaps(hdcWin, 8 /* = HorzRes */, output WinHorzRes).
run GetDeviceCaps(hdcWin, 10 /* = VertRes */, output WinVertRes).
/* get the printer resolution */
run GetDeviceCaps(hdcDest, 8 /* = HorzRes */, output PrintHorzRes).
run GetDeviceCaps(hdcDest, 10 /* = VertRes */, output PrintVertRes).
/* determine dimensions of the window */
/* Also determine the coordinates of the upper-left corner.
This is (0,0) for a client window, but will be somewhere around (-4,-20) for
a window with titlebar */
SET-SIZE (lpOrigin) = 8.
SET-SIZE (lpRect) = 16.
RUN GetWindowRect (hWin, GET-POINTER-VALUE(lpRect) , OUTPUT ReturnValue).
WinWidth = GET-LONG(lpRect, 9) - GET-LONG(lpRect, 1).
WinHeight = GET-LONG(lpRect,13) - GET-LONG(lpRect, 5).
PUT-LONG(lpOrigin, 1) = GET-LONG(lpRect, 1).
PUT-LONG(lpOrigin, 5) = GET-LONG(lpRect, 5).
RUN ScreenToClient (hWin, GET-POINTER-VALUE(lpOrigin), OUTPUT ReturnValue).
SET-SIZE (lpRect) = 0.
Scale = MINIMUM(PrintHorzRes / WinWidth,
PrintVertRes / WinHeight).
IF Scale < 1 THEN Scale = 1.
run CreateCompatibleDC (hdcWin, output hdcComp).
run CreateCompatibleBitmap (hdcComp,
integer(winWidth * Scale),
integer(winHeight * Scale),
output hbmpComp).
run CreateCompatibleBitmap (hdcDest,
integer(winWidth * Scale),
integer(winHeight * Scale),
output hbmpDest).
run SelectObject (hdcComp, hbmpComp, output ReturnValue).
run SelectObject (hdcDest, hbmpDest, output ReturnValue).
run StretchBlt (hdcDest,
0,
0,
integer(winwidth * Scale) ,
integer(winHeight * Scale) ,
hdcWin,
get-long(lpOrigin,1),
get-long(lpOrigin,5),
winwidth,
winheight,
13369376, /* = SRCCOPY */
output ReturnValue).
/* cleanup */
run ReleaseDC (hWin, hdcWin, output ReturnValue).
run DeleteDC (hdcComp, output ReturnValue).
run DeleteObject (hbmpComp, output ReturnValue).
run DeleteObject (hbmpDest, output ReturnValue).
SET-SIZE(lpOrigin)=0.
END PROCEDURE. /* PrintWindow */
/* ==============================================================
file : printscreen.i
by : Jurjen Dijkstra (Modified by Ian Keene Oct 2003)
dd : 05/16/1999
purpose : API definitions used in printscreen.p
============================================================== */
&GLOB GDI "gdi32.dll"
&GLOB USER "user32.dll"
&GLOB BOOL LONG
&GLOB COLORREF LONG
&GLOB DWORD LONG
&GLOB HANDLE LONG
&GLOB HDC LONG
&GLOB HGDIOBJ LONG
&GLOB HWND LONG
&GLOB INTEGER LONG
&GLOB LONG LONG
&GLOB LP LONG
&GLOB LPCSTR CHARACTER
&GLOB LPCTSTR CHARACTER
&GLOB LPSECURITY_ATTRIBUTES LONG
&GLOB LPSTRUCT LONG
&GLOB LPTSTR CHARACTER
&GLOB SHORT SHORT
&GLOB UINT LONG
&GLOB WORD SHORT
PROCEDURE CreateDCA EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER lpszDriver AS {&LPCTSTR} NO-UNDO.
DEFINE INPUT PARAMETER lpszDevice AS {&LPCTSTR} NO-UNDO.
DEFINE INPUT PARAMETER lpszOutput AS {&LP} NO-UNDO.
DEFINE INPUT PARAMETER lpInitData AS {&LPSTRUCT} NO-UNDO.
DEFINE RETURN PARAMETER hDC AS {&HDC} NO-UNDO.
END PROCEDURE.
PROCEDURE StartDocA EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER lpdi AS {&LPSTRUCT} NO-UNDO.
DEFINE RETURN PARAMETER JobId AS {&int} NO-UNDO.
END PROCEDURE.
PROCEDURE StartPage EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&int} NO-UNDO.
END PROCEDURE.
PROCEDURE EndPage EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&int} NO-UNDO.
END PROCEDURE.
PROCEDURE EndDoc EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&int} NO-UNDO.
END PROCEDURE.
PROCEDURE GetParent EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hWinHdl AS {&HWND} NO-UNDO.
DEFINE RETURN PARAMETER hwndParent AS {&HWND} NO-UNDO.
END PROCEDURE.
PROCEDURE GetDC EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hWinHdl AS {&HWND} NO-UNDO.
DEFINE RETURN PARAMETER hdc AS {&HDC} NO-UNDO.
END PROCEDURE.
PROCEDURE GetDeviceCaps EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nIndex AS {&int} NO-UNDO.
DEFINE RETURN PARAMETER dwCaps AS {&int} NO-UNDO.
END PROCEDURE.
PROCEDURE GetWindowRect EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hWinHdl AS {&HWND} NO-UNDO.
DEFINE INPUT PARAMETER lpRect AS {&LPSTRUCT} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE ScreenToClient EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hWinHdl AS {&HWND} NO-UNDO.
DEFINE INPUT PARAMETER lpPoint AS {&LPSTRUCT} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE CreateCompatibleDC EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER hdcComp AS {&HDC} NO-UNDO.
END PROCEDURE.
PROCEDURE CreateCompatibleBitmap EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nWidth AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nHeight AS {&int} NO-UNDO.
DEFINE RETURN PARAMETER hbmp AS {&HANDLE} NO-UNDO.
END PROCEDURE.
PROCEDURE SelectObject EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER hgdiobj AS {&HGDIOBJ} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&HGDIOBJ} NO-UNDO.
END PROCEDURE.
PROCEDURE StretchBlt EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdcDest AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nXOriginDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nYOriginDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nWidthDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nHeightDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER hdcSrc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nXOriginSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nYOriginSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nWidthSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nHeightSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER dwRop AS {&DWORD} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE BitBlt EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdcDest AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nXOriginDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nYOriginDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nWidthDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nHeightDest AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER hdcSrc AS {&HDC} NO-UNDO.
DEFINE INPUT PARAMETER nXOriginSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER nYOriginSrc AS {&int} NO-UNDO.
DEFINE INPUT PARAMETER dwRop AS {&DWORD} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE ReleaseDC EXTERNAL {&USER} :
DEFINE INPUT PARAMETER hWinHdl AS {&HWND} NO-UNDO.
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE DeleteDC EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hdc AS {&HDC} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE DeleteObject EXTERNAL {&GDI} :
DEFINE INPUT PARAMETER hObject AS {&HGDIOBJ} NO-UNDO.
DEFINE RETURN PARAMETER ReturnValue AS {&BOOL} NO-UNDO.
END PROCEDURE.
PROCEDURE GetProfileStringA EXTERNAL "kernel32.dll":
DEFINE INPUT PARAMETER in-appname AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER in-keyname AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER in-default AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER in-ret-str AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER in-n-size AS LONG NO-UNDO.
DEFINE RETURN PARAMETER out-nuchr AS LONG NO-UNDO.
END PROCEDURE.
PROCEDURE OpenPrinterA EXTERNAL "winspool.drv":
DEFINE INPUT PARAMETER in-prtname AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER out-hwnd AS LONG NO-UNDO.
DEFINE INPUT PARAMETER in-def AS LONG NO-UNDO.
END PROCEDURE.