Microsoft KB Archive/118938

= How to Print Form/Client Area in 256 Colors w/StretchDIBits =

Article ID: 118938

Article Last Modified on 12/9/2003

-

APPLIES TO


 * Microsoft Visual Basic 2.0 Standard Edition
 * Microsoft Visual Basic 3.0 Professional Edition
 * Microsoft Visual Basic 2.0 Professional Edition
 * Microsoft Visual Basic 3.0 Professional Edition

-



This article was previously published under Q118938



SUMMARY
Versions 2.0 and 3.0 of Visual Basic have the ability to display 256-color bitmaps in forms, image controls, and picture boxes. These versions can also print forms containing these controls with the PrintForm method. However, the PrintForm method has the following limitations:


 * You do not have control over the size and position of the output on the page.
 * You cannot print the forms' borders.
 * You cannot print multiple forms on a page.
 * You cannot print text on the same page.

This article describes how to use the Windows Application Programming Interface (API) to print a form or its client area and render the 256-color bitmaps as they are displayed on the screen.

The example code in this article uses the StretchDIBits function from the Windows API and has the following advantages:


 * You have 256 colors to work with.
 * You can print on both PostScript and PCL printers.
 * You can take advantage of printer halftones.
 * You can print a specified portion of a picture.
 * You can stretch the output to a specified location and size.
 * You can print both text and graphics to the same page.
 * You can print multiple forms on a page.



MORE INFORMATION
The example code included with this article uses the Windows API extensively, showing how the form is printed to the printer. (For additional information on this process, please see the comments in the code below or the Windows SDK documentation.) This process is only slightly different when printing the client area of the form. Most of the work done is the same in both cases. In the example code, there are two routines named PrintForm256 and PrintClient256. Both of these routines call the routine StretchFormToDC to do the bulk of the printing. The routines PrintForm256 and PrintClient256 basically get a handle to the desired portion of the form, start the print job, and calculate the size of the output on the printed page. Then they call StretchFormToDC to copy the bitmap. Afterward, PrintForm256 and PrintClient256 clean up as necessary for the part of the form that was copied and then they end the print job.

Once you have tried out the code and you have an idea of how it works, you can make modifications to the PrintForm256 and PrintClient256 routines. You could modify these routines to print multiple forms on the same page by calling StretchFormToDC multiple times with the appropriate parameters. You could also print text to the same page by using the Print method of the printer object before ending the document (Printer.EndDoc) or going to a new page (Printer.NewPage).

Example
 Start a new project in Visual Basic; Form1 is created by default. Put a picture box control on the form; Picture1 is created by default. Assign a 256-color bitmap to the Picture property of the picture box. Put a common dialog control on the form; CMDialog1 is created by default. Place two command buttons on the form; Command1 and Command2 are created by default.  Add the following code to the click event of the first command button: Sub Command1_Click ' Allow user to set up printer. CMDialog1.Flags = &H40& ' Printer setup. CMDialog1.Action = 5   ' Show dialog.

' Print the form. Call PrintForm256(Form1) End Sub

  Add the following code to the Click event of the second command button: Sub Command2_Click ' Allow user to set up printer. CMDialog1.Flags = &H40& ' Printer setup. CMDialog1.Action = 5   ' Show dialog.

' Print the client area. Call PrintClient256(Form1) End Sub

</li> Add a new module to the project; MODULE1.BAS is created by default.</li> Put the example code listed at the end of these steps in the basic module.</li> Save the project.</li> Run the project. Try pressing each of the buttons. The example should be able to print out the form as large as possible with the chosen orientation. If your printer driver does not support StretchDIBits, then you will receive error message 11105.</li></ol>

Example Code
'-- ' 256-Color Form Printing Routines ' ' General Declarations: Types, Constants, and Declares ' ' Routines: ' - PrintForm256 ' - PrintClient256 ' - StretchFormToDC '--

Option Explicit

Type PALETTEENTRY peRed As String * 1 peGreen As String * 1 peBlue As String * 1 peFlags As String * 1 End Type

Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors End Type

Type BITMAPINFOHEADER 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 bmiHeader As BITMAPINFOHEADER bmiColors(255) As PALETTEENTRY 'Enough for 256 colors End Type

Type RECT Left As Integer Top As Integer Right As Integer Bottom As Integer End Type

Global Const PIXELS = 3 Global Const SRCCOPY = &HCC0020 Global Const BI_RGB = 0 Global Const DIB_RGB_COLORS = 0 Global Const GMEM_MOVEABLE = 2 Global Const RASTERCAPS = 38 Global Const RC_STRETCHDIB = &H2000 Global Const RC_PALETTE = &H100 Global Const PLANES = 14 Global Const BITSPIXEL = 12 Global Const SIZEPALETTE = 104

'The following declares must each be entered on a single line: Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer  ) As Integer Declare Function CreateCompatibleBitmap Lib "GDI" (ByVal hDC As Integer,  ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer,  ByVal iCapabilitiy As Integer) As Integer Declare Function GetSystemPaletteEntries Lib "GDI" (ByVal hDC As Integer,  ByVal wStartIndex As Integer, ByVal wNumEntries As Integer,   lpPaletteEntries As PALETTEENTRY) As Integer Declare Function CreatePalette Lib "GDI" (lpLogPalette As LOGPALETTE  ) As Integer Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer,  ByVal hObject As Integer) As Integer Declare Function BitBlt Lib "GDI" (ByVal hDCDest As Integer,  ByVal XDest As Integer, ByVal YDest As Integer, ByVal nWidth As Integer,   ByVal nHeight As Integer, ByVal hDCSrc As Integer, ByVal XSrc As Integer,

ByVal YSrc As Integer, ByVal dwROP As Long) As Integer Declare Function GetDIBits Lib "GDI" (ByVal hDC As Integer, ByVal hBitmap As Integer, ByVal nStartScan As Integer, ByVal nNumScans As Integer, ByVal lpBits As Long, BITMAPINFO As BITMAPINFO ,

ByVal wUsage As Integer) As Integer Declare Function StretchDIBits Lib "GDI" (ByVal hDC As Integer, ByVal DestX As Integer, ByVal DestY As Integer, ByVal wDestWidth As Integer, ByVal wDestHeight As Integer, ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal wSrcWidth As Integer,

ByVal wSrcHeight As Integer, ByVal lpBits As Long, BitsInfo As BITMAPINFO,

ByVal wUsage As Integer, ByVal dwROP As Long) As Integer Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer

Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer

Declare Function GlobalAlloc Lib "KERNEL" (ByVal wFlags As Integer,  ByVal lMem As Long) As Integer Declare Function GlobalLock Lib "KERNEL" (ByVal hMem As Integer) As Long Declare Function GlobalUnlock Lib "KERNEL" (ByVal hMem As Integer) As Integer

Declare Function GlobalFree Lib "KERNEL" (ByVal hMem As Integer) As Integer

Declare Function SelectPalette Lib "USER" (ByVal hDC As Integer,  ByVal hPalette As Integer, ByVal bForceBackground As Integer) As Integer Declare Function RealizePalette Lib "USER" (ByVal hDC As Integer) As Integer

Declare Function GetWindowDC Lib "USER" (ByVal hWnd As Integer) As Integer Declare Function GetWindowRect Lib "USER" (ByVal hWnd As Integer,  lpRect As RECT) As Integer Declare Function ReleaseDC Lib "USER" (ByVal hWnd As Integer,  ByVal hDC As Integer) As Integer

' Error Constants: ' Device does not support StretchDIBits. Global Const ERR_DEVSTRETCHDIB = 11105 ' Palette is not 256-color palette. Global Const ERR_PALSIZE = 11106 ' Unable to create device context. Global Const ERR_CREATEMEMDC = 11107 ' Unable to create bitmap. Global Const ERR_CREATEBMP = 11108 ' Unable to retrieve system palette. Global Const ERR_GETPALETTE = 11109 ' Unable to create a new palette. Global Const ERR_CREATEPAL = 11120 ' Unable to copy bitmap to memory. Global Const ERR_BITBLT = 11110 ' Unable to allocate memory for DIB bits. Global Const ERR_BITMEM = 11111 ' Unable to lock DIB bits memory. Global Const ERR_LOCKBITMEM = 11112 ' Unable to get DIB bits. Global Const ERR_GETDIB = 11113 ' Unable to copy bitmap to destination. Global Const ERR_STRETCHDIB = 11114 ' Unable to unlock DIB bits memory. Global Const ERR_UNLOCKMEM = 11115 ' Unable to free DIB bits memory. Global Const ERR_FREEMEM = 11116 ' Unable to select palette. Global Const ERR_SELPAL = 11117 ' Unable to delete palette. Global Const ERR_DELPAL = 11121 ' Unable to delete bitmap. Global Const ERR_DELBMP = 11118 ' Unable to select palette. Global Const ERR_DELMEMDC = 11119

'-- ' PrintForm256: ' - Prints the entire form. ' - Renders 256-color bitmaps as they appear on the form. ' - Adjusts output to the size and orientation of the printer's page. ' - Calls StretchFormToDC to copy the contents of the form to the printer. ' - Starts and ends a print job. ' ' frmSrc: ' - The form object to print. ' ' Errors: ' - A message box is displayed for StrechFormToDC errors. ' - Otherwise, ther is no error trapping. ' '--

Sub PrintForm256 (frmSrc As Form)

Dim RectWindow As RECT Dim hDCWindow As Integer Dim WindowWidth As Integer Dim WindowHeight As Integer Dim WindowRatio As Double Dim PrinterWindowWidth As Integer Dim PrinterWindowHeight As Integer Dim PrinterRatio As Double Dim r

Screen.MousePointer = 11 ' Hourglass

' Setup form. hDCWindow = GetWindowDC(frmSrc.hWnd) ' hDC of form, including borders r = GetWindowRect(frmSrc.hWnd, RectWindow) WindowWidth = Abs(RectWindow.Right - RectWindow.Left) WindowHeight = Abs(RectWindow.Bottom - RectWindow.Top) ' The following must be entered on a single line: WindowRatio = (WindowWidth * Screen.TwipsPerPixelX) / (WindowHeight * Screen.TwipsPerPixelY)

' Setup printer. Printer.ScaleMode = PIXELS Printer.Print ""; ' Start print job; initialize printer object. ' The following must be entered on a single line: PrinterRatio = (Printer.ScaleWidth * Printer.TwipsPerPixelX) / (Printer.ScaleHeight * Printer.TwipsPerPixelY)

' Scale the output to the page size. If WindowRatio >= PrinterRatio Then PrinterWindowWidth = Printer.ScaleWidth ' The following must be entered on a single line: PrinterWindowHeight = (PrinterWindowWidth * Printer.TwipsPerPixelX) / (WindowRatio * Printer.TwipsPerPixelY) Else PrinterWindowHeight = Printer.ScaleHeight ' The following must be entered on a single line: PrinterWindowWidth = (PrinterWindowHeight * Printer.TwipsPerPixelY *        WindowRatio) / Printer.TwipsPerPixelX End If

' Print the form. On Error Resume Next ' The following must be entered on a single line: Call StretchFormToDC(CInt(Printer.hDC), 0, 0, PrinterWindowWidth,     PrinterWindowHeight, hDCWindow, 0, 0, WindowWidth, WindowHeight) If Err Then MsgBox Err & ": Error Printing Form" ' Predefined error codes are commented in the general declarations. End If  On Error GoTo 0

' Clean up. r = ReleaseDC(frmSrc.hWnd, hDCWindow) ' Free DC.

' End print job. Printer.EndDoc

Screen.MousePointer = 0 ' Default

End Sub

'-- ' PrintClient256: ' - Prints the client area of a form passed to it. ' - Renders 256-color bitmaps as they appear on the form. ' - Adjusts output to the size and orientation of the printer's page. ' - Calls StretchFormToDC to copy the contents of the form to the printer. ' - Starts and ends a print job. ' ' frmSrc: ' - The form object to print ' 'Errors ' - Displays a message box for StrechFormToDC errors. ' - Otherwise, there is no error trapping. ' '--

Sub PrintClient256 (frmSrc As Form)

Dim hDCWindow As Integer Dim WindowWidth As Integer Dim WindowHeight As Integer Dim WindowRatio As Double Dim PrinterWindowWidth As Integer Dim PrinterWindowHeight As Integer Dim PrinterRatio As Double Dim r

Screen.MousePointer = 11 ' Hourglass

' Setup form. frmSrc.ScaleMode = PIXELS ' All dimensions must be in pixels. hDCWindow = frmSrc.hDC   ' hDC of client area WindowWidth = frmSrc.ScaleWidth WindowHeight = frmSrc.ScaleHeight ' The following must be entered on a single line: WindowRatio = (WindowWidth * Screen.TwipsPerPixelX) / (WindowHeight * Screen.TwipsPerPixelY)

' Setup printer. Printer.ScaleMode = PIXELS Printer.Print ""; ' Start print job; initialize printer object. ' The following must be entered on a single line: PrinterRatio = (Printer.ScaleWidth * Printer.TwipsPerPixelX) / (Printer.ScaleHeight * Printer.TwipsPerPixelY)

' Scale the output to the page size. If WindowRatio >= PrinterRatio Then PrinterWindowWidth = Printer.ScaleWidth ' The following must be entered on a single line: PrinterWindowHeight = (PrinterWindowWidth * Printer.TwipsPerPixelX) / (WindowRatio * Printer.TwipsPerPixelY) Else PrinterWindowHeight = Printer.ScaleHeight ' The following must be entered on a single line: PrinterWindowWidth = (PrinterWindowHeight * Printer.TwipsPerPixelY *        WindowRatio) / Printer.TwipsPerPixelX End If

' Print the client area. On Error Resume Next ' The following must be entered on a single line: Call StretchFormToDC(CInt(Printer.hDC), 0, 0, PrinterWindowWidth,     PrinterWindowHeight, hDCWindow, 0, 0, WindowWidth, WindowHeight) If Err Then MsgBox Err & ": Error Printing Client Area" ' Predefined error codes are commented in the general declarations. End If  On Error GoTo 0

' End the print job. Printer.EndDoc

Screen.MousePointer = 0 ' Default

End Sub

'--

' StretchFormToDC ' - Stretches a specified portion of a form to a device context. ' - Works with 256 colors. ' - Works on PostScript and PCL printers (driver must support '    StretchDIBits). ' - Allows you to output to other device contexts ' ' hDCDest: ' - Destination device context. ' - ScaleMode of device context must be pixels. ' - If using Printer object, the printer should be initialized. This can '   be accomplished with Printer.Print ""; or any other printing. ' ' LeftDest, TopDest, WidthDest, HeightDest: ' - Describe the location and size of the image on the printer in pixels. ' ' hDCSrc: ' - The source device context; should be from a form. ' ' LeftSrc, TopSrc, WidthSrc, HeightSrc: ' - Describe the location and size of the source image in pixels. ' ' Errors: ' - Errors with a predefined code if necessary. ' '--

' The following must be entered on a single line: Sub StretchFormToDC (hDCDest As Integer, LeftDest, TopDest, WidthDest,  HeightDest, hDCSrc As Integer, LeftSrc, TopSrc, WidthSrc, HeightSrc)

Dim BMI As BITMAPINFO Dim hMem As Integer Dim lpBits As Long Dim r As Integer Dim hDCMemory As Integer Dim hBmp As Integer Dim hBmpPrev As Integer Dim hPal As Integer Dim hPalPrev As Integer

Dim RasterCapsDest As Integer Dim RasterCapsSrc As Integer Dim HasPaletteSrc As Integer Dim BitsPixelSrc As Integer Dim PlanesSrc As Integer Dim PaletteSizeSrc As Integer Dim LogPal As LOGPALETTE

' Set error trap. On Error GoTo SFTDC_ERRORS:

' Check that destination supports StretchDIBits. RasterCapsDest = GetDeviceCaps(hDCDest, RASTERCAPS) If (RasterCapsDest And RC_STRETCHDIB) <> RC_STRETCHDIB Then Error ERR_DEVSTRETCHDIB End If

' Get properties of source device context. RasterCapsSrc = GetDeviceCaps(hDCSrc, RASTERCAPS) HasPaletteSrc = RasterCapsSrc And RC_PALETTE BitsPixelSrc = GetDeviceCaps(hDCSrc, BITSPIXEL) PlanesSrc = GetDeviceCaps(hDCSrc, PLANES) PaletteSizeSrc = GetDeviceCaps(hDCSrc, SIZEPALETTE)

' Limit function use to 256-color palettes. If HasPaletteSrc And (PaletteSizeSrc <> 256) Then Error ERR_PALSIZE

' Copy source to a bitmap in memory. hDCMemory = CreateCompatibleDC(hDCSrc) If hDCMemory = 0 Then Error ERR_CREATEMEMDC hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) If hBmp = 0 Then Error ERR_CREATEBMP hBmpPrev = SelectObject(hDCMemory, hBmp) ' Create a copy of the system palette and realize it if necessary. If HasPaletteSrc Then LogPal.palVersion = &H300 LogPal.palNumEntries = 256 r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) If r = 0 Then Error ERR_GETPALETTE hPal = CreatePalette(LogPal) If hPal = 0 Then Error ERR_CREATEPAL ' Select the palette into the destination and realize it. hPalPrev = SelectPalette(hDCMemory, hPal, 0) r = RealizePalette(hDCMemory) End If  ' Copy the bitmap to the memory-device context. ' The following must be entered on a single line: r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc,

SRCCOPY)  If r = 0 Then Error ERR_BITBLT   hBmp = SelectObject(hDCMemory, hBmpPrev)

' Fill in necessary parts of bitmap info. BMI.bmiHeader.biSize = 40 BMI.bmiHeader.biWidth = WidthSrc BMI.bmiHeader.biHeight = HeightSrc BMI.bmiHeader.biPlanes = 1 If BitsPixelSrc * PlanesSrc = 24 Then ' 24-bit True color may require too much memory so     ' limit to 256-color DIB. ' You can get rid of this exception and the routine ' should copy 24-bit color bitmaps. BMI.bmiHeader.biBitCount = 8 ' 8 bits = 256 colors Else BMI.bmiHeader.biBitCount = BitsPixelSrc * PlanesSrc End If  BMI.bmiHeader.biCompression = BI_RGB

' Allocate memory for bitmap bits. ' The following must be entered on a single line: hMem = GlobalAlloc(GMEM_MOVEABLE, (CLng(WidthSrc *  BMI.bmiHeader.biBitCount + 31) \ 32) * 4 * HeightSrc)

If hMem = 0 Then Error ERR_BITMEM lpBits = GlobalLock(hMem)

' Get the bits and color information from the bitmap. ' The following must be entered on a single line: r = GetDIBits(hDCMemory, hBmp, 0, HeightSrc, lpBits, BMI, DIB_RGB_COLORS)

If r = 0 Then Error ERR_GETDIB

' Stretch the device-independent bitmap to the printer. ' The following must be entered on a single line: r = StretchDIBits(hDCDest, LeftDest, TopDest, WidthDest, HeightDest, 0, 0,

WidthSrc, HeightSrc, lpBits, BMI, DIB_RGB_COLORS, SRCCOPY)  If r = 0 Then Error ERR_STRETCHDIB

' Free up memory used for bitmap bits. r = GlobalUnlock(hMem) If r <> 0 Then Error ERR_UNLOCKMEM r = GlobalFree(hMem) If r <> 0 Then Error ERR_FREEMEM

' Select the default palette back if necessary. If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) If r = 0 Then Error ERR_SELPAL r = DeleteObject(hPal) If r = 0 Then Error ERR_DELPAL End If

' Delete created objects. r = DeleteObject(hBmp) If r = 0 Then Error ERR_DELBMP r = DeleteDC(hDCMemory) If r = 0 Then Error ERR_DELMEMDC

On Error GoTo 0 Exit Sub

' Clean up predefined errors if necessary. SFTDC_ERRORS: Select Case Err Case ERR_CREATEBMP r = DeleteDC(hDCMemory) Error Err Case ERR_GETPALETTE, ERR_CREATEPAL hBmp = SelectObject(hDCMemory, hBmpPrev) r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_BITBLT If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) r = DeleteObject(hPal) End If        hBmp = SelectObject(hDCMemory, hBmpPrev) r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_BITMEM If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) r = DeleteObject(hPal) End If        r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_GETDIB, ERR_STRETCHDIB r = GlobalUnlock(hMem) r = GlobalFree(hMem) If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) r = DeleteObject(hPal) End If        r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_UNLOCKMEM, ERR_FREEMEM If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) r = DeleteObject(hPal) End If        r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_SELPAL, ERR_DELPAL r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_DELBMP r = DeleteDC(hDCMemory) Error Err Case Else Error Err End Select Error Err

End Sub

<div class="references_section">