The OpenEdge Hive

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.