HOWTO: Print Form or Client Area to Size on PostScript or PCL PrinterID: Q85978
|
This article demonstrates two Visual Basic procedures: PrintWindow and
PrintClient. Both procedures allow you to print a control or form at a
specified size and location (a printed page, another form, or a picture
control).
The PrintWindow procedure allows you to print the entire control including
the border, caption, and menus.
The PrintClient procedure prints everything contained in the form or
control excluding the border, caption, and menus. When passed a form, the
PrintClient procedure works just like Visual Basic's PrintForm method.
Both procedures (PrintWindow and PrintClient) print all child controls
contained in the form or control. And both use the StretchDIBits Window API
function as well as other Windows API functions to print a form or control.
These functions will print to both Postscript and PCL (printer control
language) or HP-type LaserJet printers.
This information is included with the Help file provided with Microsoft Visual Basic version 3.0.
'*********************************************************************
'* Project
'* PrintAll.MAK
'*
'* Contents
'* PrintALL.FRM (Form1)
'* PrintALL.BAS
'* Structure
'* Form1 can contain any number of controls.
'* The minimum number to demonstrate both client area
'* printing and entire form printing is two command buttons.
'* For illustration, assign a large bitmap to the picture
'* property of Form1.
'*
'* Description:
'* This example successfully prints on both PostScript and
'* PCL (Printer Control Language: the non-PostScript type)
'* printers. The printer output is of the same resolution as
'* you would expect from the PrintForm method or from
'* printing the form from the VB environment. Both the
'* PrintClient and PrintWindow procedures are generic in
'* that they can be used to print any visible window. To
'* incorporate the code into your project, add PrintAll.BAS
'* in the project and paste the code in the PrintAll.GLB
'* program into a code module. The code in the
'* Command1_Click and Command2_Click events demonstrates how
'* to call the two procedures PrintWindow and PrintClient. To
'* print any active window, use the Appactivate and the
'* GetFocus functions to get the handle to the window to pass
'* to the procedures.
'*
'*********************************************************************
'*********************************************************************
'* Module
'* PrintAll.BAS
'*
'* Description:
'* Contains all the necessary Windows API function and Type
'* structure declarations
'*********************************************************************
DefInt A-Z
Type BITMAPINFOHEADER_Type
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type BITMAPINFO_Type
BitmapInfoHeader As BITMAPINFOHEADER_Type
bmiColors As String * 1024
End Type
Type RectType
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Type PointType
x As Integer
y As Integer
End Type
' DC related API
Declare Function CreateCompatibleDC Lib "gdi" (ByVal hDC)
Declare Function GetWindowDC Lib "user" (ByVal hWnd)
Declare Function GetDC Lib "user" (ByVal hWnd)
Declare Function ReleaseDC Lib "user" (ByVal hWnd, ByVal hDC)
Declare Function DeleteDC Lib "gdi" (ByVal hDC)
' Graphics related API
' Enter the following Declare statement as one, single line:
Declare Function BitBlt Lib "gdi" (ByVal hDC, ByVal x, ByVal y,
ByVal w, ByVal h, ByVal hDC, ByVal x, ByVal y, ByVal o As Long)
' Enter the following Declare statement as one, single line:
Declare Function GetDIBits Lib "gdi" (ByVal hDC, ByVal hBitmap,
ByVal nStartScan, ByVal nNumScans, ByVal lpBits As Long,
BitmapInfo As BITMAPINFO_Type, ByVal wUsage)
' Enter the following Declare statement as one, single line:
Declare Function StretchDIBits Lib "gdi" (ByVal hDC, ByVal DestX,
ByVal DestY, ByVal wDestWidth, ByVal wDestHeight, ByVal SrcX,
ByVal SrcY, ByVal wSrcWidth, ByVal wSrcHeight, ByVal lpBits&,
BitsInfo As BITMAPINFO_Type, ByVal wUsage, ByVal dwRop&)
' General attribute related API
Declare Function GetDeviceCaps Lib "gdi" (ByVal hDC, ByVal nIndex)
Declare Function GetWindowRect Lib "user" (ByVal hWnd, lpRect As RectType)
Declare Function GetClientRect Lib "user" (ByVal hWnd, lpRect As RectType)
' Memory allocation related API
Declare Function GlobalAlloc Lib "kernel" (ByVal wFlags, ByVal lMem&)
Declare Function GlobalLock Lib "kernel" (ByVal hMem) As Long
Declare Function GlobalUnlock Lib "kernel" (ByVal hMem)
Declare Function GlobalFree Lib "kernel" (ByVal hMem)
' Graphics object related API
' Enter the following Declare statement as one, single line:
Declare Function CreateCompatibleBitmap Lib "gdi" (ByVal hDC, ByVal nWidth,
ByVal nHeight)
Declare Function DeleteObject Lib "gdi" (ByVal hObject)
Declare Function SelectObject Lib "gdi" (ByVal hDC, ByVal hObject)
Declare Function ClientToScreen Lib "user" (ByVal hWnd%, p As PointType)
' Include the following constant declarations if using Visual Basic
' version 1.0
' Const False = 0
' Const True = Not False
Const HORZRES = 8
Const VERTRES = 10
Const SRCCOPY = &HCC0020
Const NEWFRAME = 1
Const BITSPIXEL = 12
Const PLANES = 14
Const BI_RGB = 0
Const BI_RLE8 = 1
Const BI_RLE4 = 2
Const DIB_PAL_COLORS = 1
Const DIB_RGB_COLORS = 0
Const GMEM_MOVEABLE = 2
'*********************************************************************
'* Title
'* PrintWindow()
'*
'* Description
'*
'* Copies the entire window (form or control) to another
'* window (form or control) or device such as a printer. This
'* routine is capable of printing complete form images on any
'* printer that has Windows drivers loaded including Postscript.
'*
'* The API functions GetDIBits and StretchDIBits are used to copy
'* the client area image to the destination window or device.
'*
'* Parameters:
'* hDC_Dest Handle to the DC of the destination device or
'* window.
'* DestX X position of where the image will be
'* displayed on the destination device.
'* DestY Y position of where the image will be
'* displayed on the destination device.
'* DestDevWidth Pixel width of the destination device.
'* DestDevHeight Pixel height of the destination device.
'* hWnd_SrcWindow Window handle of the source window to be
'* displayed on the destination device.
'*********************************************************************
' Enter the following statement as one, single line:
Function PrintWindow (ByVal hDC_Dest, ByVal DestX, ByVal DestY,
ByVal DestDevWidth, ByVal DestDevHeight, ByVal hWnd_SrcWindow)
Dim Rect As RectType
Dim BitmapInfo As BITMAPINFO_Type
cr$ = Chr$(13)
' Get the DC for the entire window including the non-client area.
hDC_Window = GetWindowDC(hWnd_SrcWindow)
hDC_Mem = CreateCompatibleDC(hDC_Window)
' Get the pixel dimensions of the screen. This is necessary so
' that we can determine the relative size of the window compared to
' the screen
ScreenWidth = GetDeviceCaps(hDC_Window, HORZRES)
ScreenHeight = GetDeviceCaps(hDC_Window, VERTRES)
' Get the pixel dimensions of the window to be printed.
r = GetWindowRect(hWnd_SrcWindow, Rect)
Window_Width = Abs(Rect.Right - Rect.Left)
Window_Height = Abs(Rect.Bottom - Rect.Top)
' Create a bitmap compatible with the window DC. Enter the following
' statement as one, single line:
hBmp_Window = CreateCompatibleBitmap(hDC_Window, Window_Width,
Window_Height)
' Select the bitmap to hold the window image into the memory DC.
hPrevBmp = SelectObject(hDC_Mem, hBmp_Window)
' Copy the image of the window to the memory DC. Enter the following
' statement as one, single line:
r1 = BitBlt(hDC_Mem, 0, 0, Window_Width, Window_Height, hDC_Window,
0, 0, SRCCOPY)
BitsPerPixel = GetDeviceCaps(hDC_Mem, BITSPIXEL)
ColorPlanes = GetDeviceCaps(hDC_Mem, PLANES)
BitmapInfo.BitmapInfoHeader.biSize = 40
BitmapInfo.BitmapInfoHeader.biWidth = Window_Width
BitmapInfo.BitmapInfoHeader.biHeight = Window_Height
BitmapInfo.BitmapInfoHeader.biPlanes = 1
BitmapInfo.BitmapInfoHeader.biBitCount = BitsPerPixel * ColorPlanes
BitmapInfo.BitmapInfoHeader.biCompression = BI_RGB
BitmapInfo.BitmapInfoHeader.biSizeImage = 0
BitmapInfo.BitmapInfoHeader.biXPelsPerMeter = 0
BitmapInfo.BitmapInfoHeader.biYPelsPerMeter = 0
BitmapInfo.BitmapInfoHeader.biClrUsed = 0
BitmapInfo.BitmapInfoHeader.biClrImportant = 0
' Calculate the ratios based on the source and destination
' devices. This will help to cause the size of the window image
' to be approximately the same proportion on another device
' such as a printer.
WidthRatio! = Window_Width / ScreenWidth
HeightAspectRatio! = Window_Height / Window_Width
PrintWidth = WidthRatio! * DestDevWidth
PrintHeight = HeightAspectRatio! * PrintWidth
' Calculate the number of bytes needed to store the image assuming
' 8 bits/pixel.
BytesNeeded& = (CLng(Window_Width + 3) \ 4) * 4 * Window_Height
' Allocate a buffer to hold the bitmap bits.
hMem = GlobalAlloc(GMEM_MOVEABLE, BytesNeeded&)
' Enter the following If statement as one, single line:
If hDC_Window <> 0 And hBmp_Window <> 0 And hDC_Dest <> 0 And
hMem <> 0 Then
lpBits& = GlobalLock(hMem)
' Get the bits that make up the image and copy them to the
' destination device.
' Enter the following r2 statement as one, single line:
r2 = GetDIBits(hDC_Mem, hBmp_Window, 0, Window_Height, lpBits&,
BitmapInfo, DIB_RGB_COLORS)
' Enter the following r3 statement as one, single line:
r3 = StretchDIBits(hDC_Dest, DestX, DestY, PrintWidth, PrintHeight,
0, 0, Window_Width, Window_Height, lpBits&, BitmapInfo,
DIB_RGB_COLORS, SRCCOPY)
End If
' Reselect in the previous bitmap and delete the bitmap we created
r = SelectObject(hDC_Mem, hPrevBmp)
r = DeleteObject(hBmp_Window)
' Release or delete DC's and memory.
r = GlobalUnlock(hMem)
r = GlobalFree(hMem)
r = DeleteDC(hDC_Mem)
r = ReleaseDC(hWnd_SrcWindow, hDC_Window)
' Return true if the window was successfully printed.
If r2 <> 0 And r3 <> 0 Then
PrintWindow = True
Else
PrintWindow = False
End If
End Function
'*********************************************************************
'* Title
'* PrintClient()
'*
'* Description
'*
'* Copies the client area of a window visible on the desktop to
'* another window or device such as a printer. This routine is
'* capable of printing client area images on any printer that has
'* Windows drivers loaded including PostScript.
'*
'* The API functions GetDiBits and StretchBits are used to copy
'* the client area image to the destination device.
'*
'* Parameters:
'* hDC_Dest Handle to the DC of the destination device or
'* window.
'* DestX X position of where the image will be
'* displayed on the destination device.
'* DestY Y position of where the image will be
'* displayed on the destination device.
'* DestDevWidth Pixel width of the destination device.
'* DestDevHeight Pixel height of the destination device.
'* hWnd_SrcWindow Window handle of the source window to be
'* displayed on the destination device.
'*********************************************************************
' Enter the following Function statement as one, single line:
Function PrintClient (ByVal hDC_Dest, ByVal DestX, ByVal DestY,
ByVal DestDevWidth, ByVal DestDevHeight, ByVal hWnd_SrcWindow)
Dim Rect As RectType, RectClient As RectType
Dim BitmapInfo As BITMAPINFO_Type
'*
Dim pWindow As PointType, pClient As PointType, pDiff As PointType
'*
cr$ = Chr$(13)
' Get the DC for the entire window including the non-client area.
hDC_Window = GetWindowDC(hWnd_SrcWindow)
hDC_Mem = CreateCompatibleDC(hDC_Window)
' Get the pixel dimensions of the screen.
ScreenWidth = GetDeviceCaps(hDC_Window, HORZRES)
ScreenHeight = GetDeviceCaps(hDC_Window, VERTRES)
' Get the pixel dimensions of the window to be printed.
r = GetWindowRect(hWnd_SrcWindow, Rect)
Window_Width = Abs(Rect.Right - Rect.Left)
Window_Height = Abs(Rect.Bottom - Rect.Top)
' Create a bitmap compatible with the window DC.
' Enter the following statement as one, single line:
hBmp_Window = CreateCompatibleBitmap(hDC_Window, Window_Width,
Window_Height)
' Select the bitmap to hold the window image into the memory DC.
hPrevBmp = SelectObject(hDC_Mem, hBmp_Window)
' Copy the image of the window to the memory DC.
' Enter the following statement as one, single line:
r1 = BitBlt(hDC_Mem, 0, 0, Window_Width, Window_Height,
hDC_Window, 0, 0, SRCCOPY)
' Get the dimensions of the client area.
r = GetClientRect(hWnd_SrcWindow, RectClient)
Client_Width = Abs(RectClient.Right - RectClient.Left)
Client_Height = Abs(RectClient.Bottom - RectClient.Top)
' Calculate the pixel difference (x and y) between the upper-left
' corner of the non-client area and the upper-left corner of the
' client area.
pClient.x = RectClient.Left
pClient.y = RectClient.Top
r = ClientToScreen(hWnd_SrcWindow, pClient)
xDiff = Abs(pClient.x - Rect.Left)
yDiff = Abs(pClient.y - Rect.Top)
' Create a DC and bitmap to represent the client area of the window.
hDC_MemClient = CreateCompatibleDC(hDC_Window)
' Enter the following statement as one, single line:
hBmp_Client = CreateCompatibleBitmap(hDC_Window, Client_Width,
Client_Height)
hBmpClientPrev = SelectObject(hDC_MemClient, hBmp_Client)
' Bitblt client area of window to memory bitmap representing the client
' area.
' Enter the following statement as one, single line:
r = BitBlt(hDC_MemClient, 0, 0, Client_Width, Client_Height,
hDC_Mem, xDiff, yDiff, SRCCOPY)
BitsPerPixel = GetDeviceCaps(hDC_MemClient, BITSPIXEL)
ColorPlanes = GetDeviceCaps(hDC_MemClient, PLANES)
BitmapInfo.BitmapInfoHeader.biSize = 40
BitmapInfo.BitmapInfoHeader.biWidth = Client_Width
BitmapInfo.BitmapInfoHeader.biHeight = Client_Height
BitmapInfo.BitmapInfoHeader.biPlanes = 1
BitmapInfo.BitmapInfoHeader.biBitCount = BitsPerPixel * ColorPlanes
BitmapInfo.BitmapInfoHeader.biCompression = BI_RGB
BitmapInfo.BitmapInfoHeader.biSizeImage = 0
BitmapInfo.BitmapInfoHeader.biXPelsPerMeter = 0
BitmapInfo.BitmapInfoHeader.biYPelsPerMeter = 0
BitmapInfo.BitmapInfoHeader.biClrUsed = 0
BitmapInfo.BitmapInfoHeader.biClrImportant = 0
' Calculate the ratios based on the source and destination
' devices. This will help to cause the size of the window image to
' be approximately the same proportion on another device such as
' a printer.
WidthRatio! = Client_Width / ScreenWidth
HeightAspectRatio! = Client_Height / Client_Width
PrintWidth = WidthRatio! * DestDevWidth
PrintHeight = HeightAspectRatio! * PrintWidth
' Calculate the number of bytes needed to store the image assuming
' 8 bits/pixel.
BytesNeeded& = (CLng(Window_Width + 3) \ 4) * 4 * Window_Height
' Allocate a buffer to hold the bitmap bits.
hMem = GlobalAlloc(GMEM_MOVEABLE, BytesNeeded&)
If hDC_Window <> 0 And hBmp_Window <> 0 And hDC_Dest <> 0 And
hMem <> 0 Then
lpBits& = GlobalLock(hMem)
' Get the bits that make up the image and copy them to the
' destination device.
' Enter the following r2 statement as one, single line:
r2 = GetDIBits(hDC_MemClient, hBmp_Client, 0, Client_Height,
lpBits&, BitmapInfo, DIB_RGB_COLORS)
' Enter the following r3 statement as one, single line:
r3 = StretchDIBits(hDC_Dest, DestX, DestY, PrintWidth, PrintHeight,
0, 0, Client_Width, Client_Height, lpBits&, BitmapInfo,
DIB_RGB_COLORS, SRCCOPY)
End If
' Select in the previous bitmap and delete the one we created
' that's associated with the Client area
r = SelectObject(hDC_MemClient, hBmpClientPrev)
r = DeleteObject(hBmp_Client)
' delete the client DC we created
r = DeleteDC(hDC_MemClient)
' Select the previous bitmap and delete the one we created
' that's associated with the memory DC
r = SelectObject(hDC_Mem, hPrevBmp)
r = DeleteObject(hBmp_Window)
' delete the memory DC we created
r = DeleteDC(hDC_Mem)
' release the Window DC
r = ReleaseDC(hWnd_SrcWindow, hDC_Window)
' and free the memory we allocated
r = GlobalUnlock(hMem)
r = GlobalFree(hMem)
' Return true if the window was successfully printed.
If r2 <> 0 And r3 <> 0 Then
PrintClient = True
Else
PrintClient = False
End If
End Function
Sub Command1_Click ()
' The ScaleMode must be set to pixels for the PrintWindow
' routine to print correctly.
Printer.ScaleMode = 3
' Change MousePointer to an hourglass.
Screen.MousePointer = 11
' Initialize the printer.
Printer.Print ""
' Copy the image of the form to the printer.
' To print Command1 instead, you can substitute Command1.hWnd for
' Form1.hWnd as the last argument.
' Enter the following statement as one, single line:
r = PrintClient(Printer.hDC, 100, 100, Printer.ScaleWidth,
Printer.ScaleHeight, Form1.hWnd)
' Display an error if the return value from PrintWindow is zero.
If Not r Then
MsgBox "Unable to print the form"
Else
Printer.EndDoc
End If
Screen.MousePointer = 0
End Sub
Sub Command2_Click ()
' The ScaleMode must be set to pixels for the PrintWindow
' routine to print correctly.
Printer.ScaleMode = 3
' Change MousePointer to an hourglass.
Screen.MousePointer = 11
' Initialize the printer.
Printer.Print ""
' Copy the image of the form to the printer.
' To print Command1 instead, you can substitute Command1.hWnd for
' Form1.hWnd as the last argument.
' Enter the following statement as one, single line:
r = PrintWindow(Printer.hDC, 100, 100, Printer.ScaleWidth,
Printer.ScaleHeight, Form1.hWnd)
' Display an error if the return value from PrintWindow is zero.
If Not r Then
MsgBox "Unable to print the form"
Else
Printer.EndDoc
End If
Screen.MousePointer = 0
End Sub
Additional query words: 2.00 3.00
Keywords :
Version : WINDOWS:1.0,2.0,3.0
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: June 21, 1999