' declaration: DECLARE FUNCTION WindowToPrinter (hWnd AS LONG, printarea AS LONG, printscale AS LONG) AS LONG ' called: WindowToPrinter hWndMain, 0, printscale ' window, area, scale '---------------------------------------------------------------------------------- ' WindowToPrinter by Gary Peek. Send the contents of a window to the default printer. ' Aspect ratio of window is retained, with smallest dimension of paper filled. ' Includes printer dialog function to create a self contained "print window" function. ' Enter with printarea = 0 to print client area, 1 to print entire window. ' Enter with printscale = image size as a percentage of paper size, (100 for full size) ' Returns 0 if printing canceled in PrintDlg, 1 if function completed. ' Contains minimal error checking which can be added after input from others. ' Created and modified from a number of sources for which I am thankful: ' Screen to bitmap concepts and code from "printscr.bas" (PBCC) by Jozsef Hegyi. ' Bitmap to printer concepts and code from "printbmp.bas" (PBWin) by Don Dickinson. ' Various concepts from Microsoft "WINCAP", suggested by Nick Melnick. ' Abbreviations used throughout: ' DC=device context, DDB=device dependent bitmap, DIB=device independent bitmap. FUNCTION WindowToPrinter (hWnd AS LONG, printarea AS LONG, printscale AS LONG) AS LONG LOCAL pd AS PRINTDLGAPI ' printer dialog structure LOCAL di AS DOCINFO ' document info structure LOCAL result AS LONG LOCAL scrPPIx AS LONG ' screen pixels per inch LOCAL scrPPIy AS LONG LOCAL prnPPIx AS LONG ' printer pixels per inch LOCAL prnPPIy AS LONG LOCAL xPrnRes AS SINGLE ' printer resolution (pixels available) LOCAL yPrnRes AS SINGLE LOCAL xScale AS SINGLE ' scale between screen and printer LOCAL yScale AS SINGLE LOCAL prnWidth AS LONG ' calculated image size in pixels on printer LOCAL prnHeight AS LONG LOCAL prnXoff AS LONG ' offset for centering image LOCAL prnYoff AS LONG LOCAL scale AS SINGLE ' overall scale LOCAL hDC AS LONG ' handle to DC of screen or (print) window LOCAL rectArea AS Rect ' (print) window area LOCAL pt1 AS POINTAPI ' points for calculations LOCAL pt2 AS POINTAPI ' points for calculations LOCAL areaWidth AS LONG ' width of print area LOCAL areaHeight AS LONG ' height of print area LOCAL wp AS WINDOWPLACEMENT ' structure defining window placement info LOCAL sourceX AS LONG ' where bitblt starts LOCAL sourceY AS LONG ' where bitblt starts LOCAL hCompatibleDC AS LONG ' handle to the compatible DC LOCAL hCompatibleBM AS LONG ' handle to the compatible bitmap in memory LOCAL hOldBM AS LONG ' temporary handle for old bitmap LOCAL bmSize AS LONG ' space needed by bitmap bits LOCAL ptrMem AS LONG ' pointer to the gMemory string LOCAL gMemory AS STRING ' string space to store the DIB bits LOCAL bm AS BITMAP ' structure defining properties of a bitmap LOCAL bmi AS BITMAPINFO ' structure defining properties of a DIB IF printarea = 1 THEN ' print entire window hDC = CreateDC("DISPLAY", BYVAL 0, BYVAL 0, BYVAL 0) ' get DC handle to the screen GetWindowRect hWnd, rectArea ' get window bounding rectangle in screen coordinates wp.Length = SIZEOF(WINDOWPLACEMENT) ' initialize the size of structure GetWindowPlacement hWnd, wp ' get window placement info sourceX = wp.rcNormalPosition.nLeft ' where window starts on screen sourceY = wp.rcNormalPosition.nTop ELSE ' print just the client area hDC = GetDC(hWnd) ' get DC handle to the (print) window GetClientRect hWnd, rectArea ' get client dimensions in screen coordinates pt1.x = rectArea.nLeft ' put client coordinates in rectangle area for conversion pt1.y = rectArea.nTop pt2.x = rectArea.nRight pt2.y = rectArea.nBottom ClientToScreen hWnd, pt1 ' convert client coordinates to screen coordinates ClientToScreen hWnd, pt2 rectArea.nLeft = pt1.x ' put screen coordinates back into the rectangle area rectArea.nTop = pt1.y rectArea.nRight = pt2.x rectArea.nBottom = pt2.y sourceX = 0 : sourceY = 0 ' client area in window always starts at 0, 0 END IF areaWidth = rectArea.nRight - rectArea.nLeft ' calculate size of area to transfer areaHeight = rectArea.nBottom - rectArea.nTop hCompatibleDC = CreateCompatibleDC(hDC) ' create a DC compatible to the (print) window hCompatibleBM = CreateCompatibleBitmap(hDC, areaWidth, areaHeight) ' create a bitmap compatible to the (print) window GetObject hCompatibleBM, SIZEOF(bm), bm ' get DDB graphics object into a buffer hOldBM = SelectObject(hCompatibleDC, hCompatibleBM) ' select DDB object into the DC BitBlt hCompatibleDC, 0, 0, areaWidth, areaHeight, hDC, sourceX, sourceY, %SRCCOPY 'transfer color data from (print) window DC to compatible DC SelectObject hCompatibleDC, hOldBM ' select the older object into the DC so we can later delete it IF printarea = 1 THEN DeleteDC hDC ELSE ReleaseDC hWnd, hDC ' delete or release window DC handle GetObject hCompatibleBM, LEN(bm), bm ' get bitmap object into a buffer ' fill out a structure describing the bits of the DIB bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader) ' info for GetDIBits bmi.bmiHeader.biWidth = bm.bmWidth bmi.bmiHeader.biHeight = bm.bmHeight bmi.bmiHeader.biPlanes = 1 bmi.bmiHeader.biBitCount = bm.bmBitsPixel bmi.bmiHeader.biCompression = %BI_RGB bmSize = bmi.bmiHeader.biWidth ' calculate space needed by DIB bits bmSize = (bmSize + 1) * (bmi.bmiHeader.biBitCount / 8) bmSize = ((bmSize + 3) / 4) * 4 bmSize = bmSize * bmi.bmiHeader.biHeight gMemory = STRING$(bmSize, CHR$(0)) ' allocate memory as a string of bytes ptrMem = STRPTR(gMemory) ' point to this string in memory ' copy bits of the compatible bitmap into the allocated memory in DIB format GetDIBits hCompatibleDC, hCompatibleBM, 0, bmi.bmiHeader.biHeight, _ BYVAL ptrMem, bmi, %DIB_RGB_COLORS DeleteDC hCompatibleDC ' delete DC DeleteObject hCompatibleBM ' delete bitmap pd.lStructSize = SIZEOF(pd) pd.Flags = %PD_RETURNDC OR %PD_HIDEPRINTTOFILE ' return DC in structure pd.hWndOwner = hWnd ' identify window result = PrintDlg(pd) ' call printer common dialog IF result = 0 THEN FUNCTION = 0 : EXIT FUNCTION ' return zero if Cancel clicked hDC = GetDC(hWnd) ' get DC handle to the window scrPPIx = GetDeviceCaps(hDC, %LOGPIXELSX) ' get pixels per logical inch for display scrPPIy = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC hWnd, hDC ' release window DC handle prnPPIx = GetDeviceCaps(pd.hDC, %LOGPIXELSX) ' get pixels per logical inch for printer prnPPIy = GetDeviceCaps(pd.hDC, %LOGPIXELSY) xScale = prnPPIx / scrPPIx ' get scaling factor going from screen inches to printer inches yScale = prnPPIy / scrPPIy prnWidth = areaWidth * xScale ' scale screen to printer in inches prnHeight = areaHeight * yScale xPrnRes = GetDeviceCaps (pd.hDC, %HORZRES) ' get width in pixels of the printer yPrnRes = GetDeviceCaps (pd.hDC, %VERTRES) ' get height in pixels of the printer xScale = xPrnRes / prnWidth ' get scaling facter going from screen to printer resolution yScale = yPrnRes / prnHeight IF xScale < yScale THEN scale = xScale ELSE scale = yScale ' use smaller of the two scale = scale * printscale / 100 ' image size as percentage of paper size prnWidth = prnWidth * scale ' scale both by the same factor to retain aspect ratio prnHeight = prnHeight * scale ' this will make image as large as possible in the smallest dimension IF prnWidth < xPrnRes THEN prnXoff = (xPrnRes - prnWidth) / 2 ELSE prnXoff = 0 ' center the image IF prnHeight < yPrnRes THEN prnYoff = (yPrnRes - prnHeight) / 2 ELSE prnYoff = 0 di.lpszOutput = %NULL StartDoc pd.hDC, di ' start document StartPage pd.hDC ' start page ' copy/stretch the DIB into printer's DC StretchDIBits pd.hDC, prnXoff, prnYoff, prnWidth, prnHeight, 0, 0, bmi.bmiHeader.biWidth, _ bmi.bmiHeader.biHeight, BYVAL ptrMem, bmi, %DIB_RGB_COLORS, %SRCCOPY EndPage pd.hDC ' end page EndDoc pd.hDC ' end document DeleteDC pd.hDC ' delete printer DC gMemory = "" ' clear memory FUNCTION = 1 ' function completed END FUNCTION