Microsoft KB Archive/113333

= How To Print Picture Box Contents Using StretchDIBits =

PSS ID Number: 113333

Article Last Modified on 12/9/2003

-

The information in this article applies to:


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

-



This article was previously published under Q113333





SUMMARY
This article demonstrates how to print the contents of a Visual Basic picture box by using the Windows API StretchDIBits functions. This method can accomplish the following:


 * Work with 256-color bitmaps.
 * Work on both PostScript and PCL printers.
 * Take advantage of printer halftones.
 * Work with visible and invisible picture boxes.
 * Print a specified portion of a picture.
 * Stretch the output to a specified size.



MORE INFORMATION
Microsoft Windows supports a device-independent bitmap (DIB) format. StretchDIBits is a Windows API function that paints a DIB into a device context (DC). A DC is a link between a Windows-based application, a device driver, and an output device (such as a printer or plotter).

Many printer drivers support the StretchDIBits function, including most PCL and PostScript printer drivers. If a printer driver supports the StretchDIBits function, the driver will convert the device-independent color information to the colors available on the printer. This allows the code in the step-by-step example (below) to print 256-color bitmaps.

The Windows function GetDIBits creates a DIB from a device-dependent bitmap (DDB). In the process, GetDIBits expects the DDB not to be selected into a device context. To achieve this, the sample application creates a device context in memory and a compatible bitmap. It then copies the source picture into this newly created bitmap. If the source picture has a palette, the program uses it when copying the picture. After copying, the routine removes the bitmap copy from the memory-device context and passes it to GetDIBits. Once GetDIBits returns the DIB bits, the code can call StretchDIBits to stretch the bitmap onto the printer's device context.

The following example puts this information into practice by demonstrating how to use GetDIBits and StretchDIBits to print bitmaps of up to 256 colors to the printer.

Step-by-Step Example
 Start a new project in Visual Basic. Form1 is created by default. Add a picture box (Picture1) and a Command button (Command1) to the form.  Place the following code in the Command button's click event: Sub Command1_Click ' Set up picture box (these properties can be set at design time): Picture1.AutoRedraw = True      ' Must be true if invisible. Picture1.ScaleMode = PIXELS     ' Scale mode must be pixels. Picture1.AutoSize = True Picture1.Visible = False Picture1.Picture = LoadPicture("C:\WINDOWS\256COLOR.BMP")

' Set up Printer object: Printer.ScaleMode = PIXELS      ' Scale mode must be pixels. Printer.Print " "               ' Printer must be initialized.

' The source coordinates used must be valid for the picture. You can ' use Picture1.ScaleWidth and Picture1.ScaleHeight to verify them. ' All coordinates are in pixels. ' The coordinates 0, 0, 60, 40 are valid for 256COLOR.BMP. On Error Resume Next ' Enter the following two lines on one line: Call StretchPicToDC(CInt(Printer.hDC), 0, 0, 600, 400, Picture1, 0,        0, 60, 40) If Err Then MsgBox Err & ": Error Printing Picture" ' Predefined error codes are commented in the BAS file. End If     On Error Goto 0

' End print job: Printer.EndDoc End Sub

 Add a new module to the project.  Place the following code in the new module: Option Explicit

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 As String * 1024 ' Enough for 256 colors. 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 Global Const VBM_GETPALETTE = &H101C

' Each of the following declares should be entered on one line: Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer     ) As Integer Declare Function DeleteDC Lib "GDI" (ByVal hDC 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 CreateCompatibleBitmap Lib "GDI" (ByVal hDC As Integer,     ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As  Integer Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer,     ByVal hObject As Integer) 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 GetDeviceCaps Lib "GDI" (ByVal hDC As Integer,     ByVal iCapabilitiy 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 SendMessage Lib "USER" (ByVal hWnd As Integer,     ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As   Long

' The following are Global constants for the error trapping comments ' below:

Global Const ERR_PICSCALEMODE = 11100 ' Picture box ScaleMode not Pixels Global Const ERR_PICAUTOREDRAW = 11101 ' Picture invisible and AutoRedraw False Global Const ERR_SRCPARAMETER = 11102 ' Source coordinates out of range Global Const ERR_PRINTERSCALEMODE = 11103 ' Printer ScaleMode not Pixels Global Const ERR_DESTPARAMETER = 11104 ' Destination coordinates out of range Global Const ERR_DEVSTRETCHDIB = 11105 ' Device not supporting StretchDIBits Global Const ERR_PALSIZE = 11106 ' Palette not 256 colors Global Const ERR_CREATEMEMDC = 11107 ' Unable to create device context Global Const ERR_CREATEBMP = 11108 ' Unable to create bitmap Global Const ERR_GETPALETTE = 11109 ' Unable to retrieve palette Global Const ERR_BITBLT = 11110 ' Unable to copy bitmap to memory Global Const ERR_BITMEM = 11111 ' Unable to allocate memory for DIB bits Global Const ERR_LOCKBITMEM = 11112 ' Unable to lock DIB bits memory Global Const ERR_GETDIB = 11113 ' Unable to get DIB bits Global Const ERR_STRETCHDIB = 11114 ' Unable to copy bitmap to destination Global Const ERR_UNLOCKMEM = 11115 ' Unable to unlock DIB bits memory Global Const ERR_FREEMEM = 11116 ' Unable to free DIB bits memory Global Const ERR_SELPAL = 11117 ' Unable to select palette Global Const ERR_DELBMP = 11118 ' Unable to delete bitmap Global Const ERR_DELMEMDC = 11119 ' Unable to delete device context

'---  ' StretchPicToDC: ' - Stretches a specified portion of picture box to a device context. ' - Works with 256-color bitmaps. ' - Works on PostScript and PCL printers (driver must support        StretchDIBits). ' - Can output to other device contexts. '  ' hDCDest: ' - This is 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, and HeightDest describe the location and ' size of the image on the printer in pixels. '  ' picSrc: ' - Is a picture box that must have ScaleMode = Pixels. ' - Can also have Visible = False if AutoRedraw = True '  ' LeftSrc, TopSrc, WidthSrc, and HeightSrc describe the location and ' size of the source image in pixels. '  ' Errors will occur with a predefined code if necessary. '  '---   ' The following should be entered on one line: Sub StretchPicToDC (hDCDest As Integer, LeftDest, TopDest, WidthDest,    HeightDest, picSrc As PictureBox, 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

' Set error trap. On Error GoTo SPTDC_ERRORS: ' As a precaution, check for some invalid parameters. If picSrc.ScaleMode <> PIXELS Then Error ERR_PICSCALEMODE If picSrc.Visible = False And picSrc.AutoRedraw = False Then Error ERR_PICAUTOREDRAW End If    If LeftSrc < 0 Or TopSrc < 0 Then Error ERR_SRCPARAMETER If WidthSrc <= 0 Or HeightSrc <= 0 Then Error ERR_SRCPARAMETER If LeftSrc > picSrc.ScaleWidth Then Error ERR_SRCPARAMETER If TopSrc > picSrc.ScaleHeight Then Error ERR_SRCPARAMETER If LeftSrc + WidthSrc > picSrc.ScaleWidth Then Error ERR_SRCPARAMETER If TopSrc + HeightSrc > picSrc.ScaleHeight Then Error ERR_SRCPARAMETER If LeftDest < 0 Or TopDest < 0 Then Error ERR_DESTPARAMETER If WidthDest <= 0 Or HeightDest <= 0 Then Error ERR_DESTPARAMETER If Printer.hDC = hDCDest Then If Printer.ScaleMode <> PIXELS Then Error ERR_PRINTERSCALEMODE If LeftDest > Printer.ScaleWidth Then Error ERR_DESTPARAMETER If TopDest > Printer.ScaleHeight Then Error ERR_DESTPARAMETER If LeftDest + WidthDest > Printer.ScaleWidth Then Error ERR_DESTPARAMETER End If       If TopDest + HeightDest > Printer.ScaleHeight Then Error ERR_DESTPARAMETER End If    End If

' Check that the 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(picSrc.hDC, RASTERCAPS) HasPaletteSrc = RasterCapsSrc And RC_PALETTE BitsPixelSrc = GetDeviceCaps(picSrc.hDC, BITSPIXEL) PlanesSrc = GetDeviceCaps(picSrc.hDC, PLANES) PaletteSizeSrc = GetDeviceCaps(picSrc.hDC, 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(picSrc.hDC) If hDCMemory = 0 Then Error ERR_CREATEMEMDC hBmp = CreateCompatibleBitmap(picSrc.hDC, WidthSrc, HeightSrc) If hBmp = 0 Then Error ERR_CREATEBMP hBmpPrev = SelectObject(hDCMemory, hBmp) ' Get a copy of the source palette and realize it if necessary. If HasPaletteSrc Then hPal = SendMessage(picSrc.hWnd, VBM_GETPALETTE, 0, 0) If hPal = 0 Then Error ERR_GETPALETTE ' Select the palette into the destination and realize it. hPalPrev = SelectPalette(hDCMemory, hPal, 0) r = RealizePalette(hDCMemory) End If    ' Enter the following on one line: r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, picSrc.hDC, 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. ' Enter the following on one 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 persistent bitmap. ' The following should be entered on one line: r = GetDIBits(hDCMemory, hBmp, 0, HeightSrc, lpBits, BMI,       DIB_RGB_COLORS) If r = 0 Then Error ERR_GETDIB

' Stretch the DIB to the printer. ' The following should be entered on one 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 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 on predefined errors if necessary. SPTDC_ERRORS: Select Case Err Case ERR_CREATEBMP r = DeleteDC(hDCMemory) Error Err Case ERR_GETPALETTE hBmp = SelectObject(hDCMemory, hBmpPrev) r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_BITBLT If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) 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) 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) End If           r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_UNLOCKMEM, ERR_FREEMEM If HasPaletteSrc Then r = SelectPalette(hDCMemory, hPalPrev, 0) End If           r = DeleteObject(hBmp) r = DeleteDC(hDCMemory) Error Err Case ERR_SELPAL 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  Save the project.</li> Run the program (or press the F5 key). Then choose the Command1 button.

The picture box should disappear and a portion of the hidden 256-color bitmap should be printed on the printer.</li></ol>