How to Add Print Preview to Visual Basic Applications

- Standard and Professional Editions of Microsoft Visual Basic

  Programming System for Windows, version 2.0 and 3.0

SUMMARY

This article describes how to create printing routines that can print to the printer or to a picture box. This enables you to add print preview capabilities to your Visual Basic applications.

There are several ways that you could implement print preview in your applications. This article describes one method that is easy to do in Visual Basic and works well.

MORE INFORMATION

Generic Printing

It would be ideal to have a generic print routine that could print to the printer or to the screen depending on what you pass it. The Visual Basic printer object and picture box control have many of the same methods and properties. For example, both of these are valid:

   Printer.Print AString
   Picture1.Print AString

   Call PrintJob(Printer)
   Call PrintJob(Picture1)

   Sub PrintJob(GenericObject As Object)
      GenericObject.Print AString
   End Sub
 Unfortunately, this is not possible. The Visual Basic Printer object is a

This leaves you with two choices in Visual Basic. You could create two routines -- one for printing to the printer and one for print preview. However, the code would not be reusable in your future projects. The second approach is to write your own set of routines that can print to the printer or a picture box based on the value of a flag. This is the method used in the example code given below. Once you create the routines, you can re-use them in future programs.

The example creates routines that closely mimic Visual Basic's built in methods and properties. However, you could use this approach to create high- level routines that greatly simplify your printing needs.

The routines work by checking the PrinterFlag variable. PrinterFlag is True when printing is going to the printer and False when printing to the picture box.

Here's the print routine from the example. Notice how it is just a shell function that determines what to print to and then does it.

   Sub PrintPrint (PrintVar)
      If PrinterFlag Then
         Printer.Print PrintVar
      Else
         objPrint.Print PrintVar
      End If
   End Sub

Scaling

To accomplish print preview, the program must scale the output to the picture box to match the output on the printer.

In the example, the PrintStartDoc routine initializes the printer or picture box and sets up the scaling. The width and height of the paper are passed to the PrintStartDoc routine. These dimensions are used to determine the non-printable area of the printer object, find the ratio of the picture box to the printer, re-size the picture box, and scale the picture box. The picture box is scaled with the Scale method. After setting the scale of the picture box, graphic methods use the new coordinates. For an 8.5 x 11 inch piece of paper the picture box is scaled with this command:

   Picture1.Scale (0, 0)-(8.5, 11)

   Sub PrintFontSize (pSize)
      If PrinterFlag Then
         Printer.FontSize = pSize
      Else
         'Sized by ratio since Scale method does not effect FontSize
         ObjPrint.FontSize = pSize * Ratio
      End If
   End Sub

Step-by-Step Example

1. Start a new project in Visual Basic. Form1 is created by default.

2. Add a command button (Command1), a check box (Check1), and two picture boxes (Picture1 and Picture2) to the form.

3. Put the following code in the command button click event:

      Sub Command1_Click ()
         ' Setup (Could be done at design time or in form load)
         ' Make printing stick:
         Picture1.AutoRedraw = True
         ' Add a palette for 256 colors:
         Picture1.Picture = LoadPicture("C:\VB\PASTEL.DIB")
         ' Set up hidden picture:
         Picture2.AutoRedraw = False
         Picture2.ScaleMode = 3 'Pixels
         Picture2.Visible = False
         Picture2.AutoSize = True
         Picture2.Picture = LoadPicture("C:\VB\METAFILE\BUSINESS\PRINTER.WMF")
   
         ' This print job can go to the printer or the picture box:
         If Check1.Value = 0 Then PrinterFlag = True
         PrintStartDoc Picture1, PrinterFlag, 8.5, 11
   
         ' All the subs use inches:
         PrintBox 1, 1, 6.5, 9
         PrintLine 1.1, 2, 7.4, 2
         PrintPicture Picture2, 1.1, 1.1, .8, .8
         PrintFilledBox 2.1, 1.2, 5.2, .7, RGB(200, 200, 200)
         PrintFontName "Arial"
         PrintCurrentX 2.3
         PrintCurrentY 1.3
         PrintFontSize 35
         PrintPrint "Visual Basic Printing"
         For x = 3 To 5.5 Step .2
            PrintCircle x, 3.5, .75
         Next
         PrintFontName "Courier New"
         PrintFontSize 30
         PrintCurrentX 1.5
         PrintCurrentY 5
         PrintPrint "It is possible to do"
         PrintFontSize 24
         PrintCurrentX 1.5
         PrintCurrentY 6.5
         PrintPrint "It is possible to do print"
         PrintFontSize 18
         PrintCurrentX 1.5
         PrintCurrentY 8
         PrintPrint "It is possible to do print preview"
         PrintFontSize 12
         PrintCurrentX 1.5
         PrintCurrentY 9.5
         PrintPrint "It is possible to do print preview with good results."
         PrintEndDoc
      End Sub
   
   

4. Add a new Module to the project (MODULE1.BAS).

5. Put the following code in the basic module:

   Option Explicit

      ' The following Types, Declares, and Constants are only necessary
      ' for the PrintPicture routine
      '=======================================================================
      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
         bmiColors As String * 1024
      End Type
   
      Type BITMAPINFO_TYPE
         BitmapInfoHeader As BITMAPINFOHEADER_TYPE
         bmiColors As String * 1024
      End Type
   
      ' Enter each of the following Declare statements as one, single line:
      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_TYPE, 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_TYPE,
         ByVal wUsage As Integer, ByVal dwRop As Long) 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
   
      Global Const SRCCOPY = &HCC0020
      Global Const BI_RGB = 0
      Global Const DIB_RGB_COLORS = 0
      Global Const GMEM_MOVEABLE = 2
   
      ' Module level variables set in PrintStartDoc flag indicating Printing
      ' or Previewing:
      Dim PrinterFlag
      ' Object used for Print Preview:
      Dim ObjPrint As Control
      ' Storage for output objects original scale mode:
      Dim sm
      ' The size ratio between the actual page and the print preview object:
      Dim Ratio
      ' Size of the non-printable area on printer:
      Dim LRGap
      Dim TBGap
      ' The actual paper size (8.5 x 11 normally):
      Dim PgWidth
      Dim PgHeight
   
      Sub PrintStartDoc (objToPrintOn As Control, PF, PaperWidth, PaperHeight)
         Dim psm
         Dim fsm
         Dim HeightRatio
         Dim WidthRatio
   
         ' Set the flag that determines whether printing or previewing:
         PrinterFlag = PF
   
         ' Set the physical page size:
         PgWidth = PaperWidth
         PgHeight = PaperHeight
   
         ' Find the size of the non-printable area on the printer to
         ' use to offset coordinates. These formulas assume the
         ' non-printable area is centered on the page:
         psm = Printer.ScaleMode
         Printer.ScaleMode = 5 'Inches
         LRGap = (PgWidth - Printer.ScaleWidth) / 2
         TBGap = (PgHeight - Printer.ScaleHeight) / 2
         Printer.ScaleMode = psm
   
         ' Initialize printer or preview object:
         If PrinterFlag Then
            sm = Printer.ScaleMode
            Printer.ScaleMode = 5 'Inches
            Printer.Print "";
         Else
            ' Set the object used for preview:
            Set ObjPrint = objToPrintOn
            ' Scale Object to Printer's printable area in Inches:
            sm = ObjPrint.ScaleMode
            ObjPrint.ScaleMode = 5 'Inches
            ' Compare the height and with ratios to determine the
            ' Ratio to use and how to size the picture box:
            HeightRatio = ObjPrint.ScaleHeight / PgHeight
            WidthRatio = ObjPrint.ScaleWidth / PgWidth
            If HeightRatio < WidthRatio Then
               Ratio = HeightRatio
               ' Re-size picture box - this does not work on a form:
               fsm = ObjPrint.Parent.ScaleMode
               ObjPrint.Parent.ScaleMode = 5 'Inches
               ObjPrint.Width = PgWidth * Ratio
               ObjPrint.Parent.ScaleMode = fsm
            Else
               Ratio = WidthRatio
               ' Re-size picture box - this does not work on a form:
               fsm = ObjPrint.Parent.ScaleMode
               ObjPrint.Parent.ScaleMode = 5 'Inches
               ObjPrint.Height = PgHeight * Ratio
               ObjPrint.Parent.ScaleMode = fsm
            End If
            ' Set default properties of picture box to match printer
            ' There are many that you could add here:
            ObjPrint.Scale (0, 0)-(PgWidth, PgHeight)
            ObjPrint.FontName = Printer.FontName
            ObjPrint.FontSize = Printer.FontSize * Ratio
            ObjPrint.ForeColor = Printer.ForeColor
            ObjPrint.Cls
         End If
      End Sub
   
      Sub PrintCurrentX (XVal)
         If PrinterFlag Then
            Printer.CurrentX = XVal - LRGap
         Else
            ObjPrint.CurrentX = XVal
         End If
      End Sub
   
      Sub PrintCurrentY (YVal)
         If PrinterFlag Then
            Printer.CurrentY = YVal - TBGap
         Else
            ObjPrint.CurrentY = YVal
         End If
      End Sub
   
      Sub PrintFontName (pFontName)
         If PrinterFlag Then
            Printer.FontName = pFontName
         Else
            ObjPrint.FontName = pFontName
         End If
      End Sub
   
      Sub PrintFontSize (pSize)
         If PrinterFlag Then
            Printer.FontSize = pSize
         Else
            ' Sized by ratio since Scale method does not effect FontSize:
            ObjPrint.FontSize = pSize * Ratio
         End If
      End Sub
   
      Sub PrintPrint (PrintVar)
         If PrinterFlag Then
            Printer.Print PrintVar
         Else
            ObjPrint.Print PrintVar
         End If
      End Sub
   
      Sub PrintLine (bLeft0, bTop0, bLeft1, bTop1)
         If PrinterFlag Then
            ' Enter the following two lines as one, single line:
            Printer.Line (bLeft0 - LRGap, bTop0 - TBGap)-
               (bLeft1 - LRGap, bTop1 - TBGap)
         Else
            ObjPrint.Line (bLeft0, bTop0)-(bLeft1, bTop1)
         End If
      End Sub
   
      Sub PrintBox (bLeft, bTop, bWidth, bHeight)
         If PrinterFlag Then
            ' Enter the following two lines as one, single line:
            Printer.Line (bLeft - LRGap, bTop - TBGap)-
               (bLeft + bWidth - LRGap, bTop + bHeight - TBGap), , B
         Else
            ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), , B
         End If
      End Sub
   
      Sub PrintFilledBox (bLeft, bTop, bWidth, bHeight, color)
         If PrinterFlag Then
            ' Enter the following two lines as one, single line:
            Printer.Line (bLeft - LRGap, bTop - TBGap)-
               (bLeft + bWidth - LRGap, bTop + bHeight - TBGap), color, BF
         Else
            ' Enter the following two lines as one, single line:
            ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight),
               color, BF
         End If
      End Sub
   
      Sub PrintCircle (bLeft, bTop, bRadius)
         If PrinterFlag Then
            Printer.Circle (bLeft - LRGap, bTop - TBGap), bRadius
         Else
            ObjPrint.Circle (bLeft, bTop), bRadius
         End If
      End Sub
   
      Sub PrintNewPage ()
         If PrinterFlag Then
            Printer.NewPage
         Else
            ObjPrint.Cls
         End If
      End Sub
   
      ' Enter the following two lines as one, single line:
      Sub PrintPicture (picSource As Control, ByVal pLeft, ByVal pTop,
         ByVal pWidth, ByVal pHeight)
   
         ' Picture Box should have autoredraw = False, ScaleMode = Pixel
         ' Also can have visible=false, Autosize = true
   
         Dim BitmapInfo As BITMAPINFO_TYPE
         Dim DesthDC As Integer
         Dim hMem As Integer
         Dim lpBits As Long
         Dim r As Integer
   
         ' Precaution:
         If pLeft < LRGap Or pTop < TBGap Then Exit Sub
         If pWidth < 0 Or pHeight < 0 Then Exit Sub
         If pWidth + pLeft > PgWidth - LRGap Then Exit Sub
         If pHeight + pTop > PgHeight - TBGap Then Exit Sub
         picSource.ScaleMode = 3 'Pixels
         picSource.AutoRedraw = False
         picSource.Visible = False
         picSource.AutoSize = True
   
         If PrinterFlag Then
            Printer.ScaleMode = 3 'Pixels
            ' Calculate size in pixels:
            pLeft = ((pLeft - LRGap) * 1440) / Printer.TwipsPerPixelX
            pTop = ((pTop - TBGap) * 1440) / Printer.TwipsPerPixelY
            pWidth = (pWidth * 1440) / Printer.TwipsPerPixelX
            pHeight = (pHeight * 1440) / Printer.TwipsPerPixelY
            Printer.Print "";
            DesthDC = Printer.hDC
         Else
            ObjPrint.Scale
            ObjPrint.ScaleMode = 3 'Pixels
            ' Calculate size in pixels:
            pLeft = ((pLeft * 1440) / Screen.TwipsPerPixelX) * Ratio
            pTop = ((pTop * 1440) / Screen.TwipsPerPixelY) * Ratio
            pWidth = ((pWidth * 1440) / Screen.TwipsPerPixelX) * Ratio
            pHeight = ((pHeight * 1440) / Screen.TwipsPerPixelY) * Ratio
            DesthDC = ObjPrint.hDC
         End If
   
         BitmapInfo.BitmapInfoHeader.biSize = 40
         BitmapInfo.BitmapInfoHeader.biWidth = picSource.ScaleWidth
         BitmapInfo.BitmapInfoHeader.biHeight = picSource.ScaleHeight
         BitmapInfo.BitmapInfoHeader.biPlanes = 1
         BitmapInfo.BitmapInfoHeader.biBitCount = 8
         BitmapInfo.BitmapInfoHeader.biCompression = BI_RGB
   
         ' Enter the following two lines as one, single line:
         hMem = GlobalAlloc(GMEM_MOVEABLE, (CLng(picSource.ScaleWidth + 3)
            \ 4) * 4 * picSource.ScaleHeight)'DWORD ALIGNED
         lpBits = GlobalLock(hMem)
   
         ' Enter the following two lines as one, single line:
         r = GetDIBits(picSource.hDC, picSource.Image, 0,
            picSource.ScaleHeight, lpBits, BitmapInfo, DIB_RGB_COLORS)
         If r <> 0 Then
            ' Enter the following two lines as one, single line:
            r = StretchDIBits(DesthDC, pLeft, pTop, pWidth, pHeight, 0, 0,
               picSource.ScaleWidth, picSource.ScaleHeight, lpBits,
               BitmapInfo, DIB_RGB_COLORS, SRCCOPY)
         End If
   
         r = GlobalUnlock(hMem)
         r = GlobalFree(hMem)
   
         If PrinterFlag Then
            Printer.ScaleMode = 5 'Inches
         Else
            ObjPrint.ScaleMode = 5'Inches
            ObjPrint.Scale (0, 0)-(PgWidth, PgHeight)
         End If
      End Sub
   
      Sub PrintEndDoc ()
         If PrinterFlag Then
            Printer.EndDoc
            Printer.ScaleMode = sm
         Else
            ObjPrint.ScaleMode = sm
         End If
      End Sub
   
   

6. Save the project.

7. Run it.

Notes

• The accuracy of the preview really depends on the fonts available. This method relies upon Windows to return the most appropriate font and size. You could come up with your own algorithm for choosing a font size. The TextWidth and TextHeight methods of the Printer object and picture box may be useful for this.
• The example uses inches as the device independent unit of measurement. But you could use twips, points, millimeters, or centimeters.
• You may want to implement the preview window in a scrollable viewport. For more information, please see the following article in the Microsoft Knowledge Base:

  ARTICLE-ID: Q71068

     TITLE     : How to Create Scrollable Viewports in Visual Basic
  
  

• There are other methods that you could use to preview printing. You could pass a device context to a routine that uses only Windows API functions to draw and print. You could also create a picture that you either stretch to the printer or to the screen.