HOWTO: Add Print Preview to Visual Basic Applications

ID: Q113236


The information in this article applies to:


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 
It would be nice if you could pass a generic object to a subroutine and the subroutine would use the Print method off of the generic object as in this example:

   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 system object, so it can't be passed as a parameter.

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 
With just a few simple routines like this, you can start to do generic printing.

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) 
The Scale method does not scale fonts. To scale the fonts, use the ratio of the picture box height divided by the printer's height in inches. Then multiply by this ratio to determine the correct font size within the picture box. Here is the PrintFontSize routine that sets the appropriate font sizes in the example:

   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 
The ratio used to calculate the font size can be applied to anything you need to scale in the picture box that is not automatically scaled by the Scale method. The ratio is also used in the PrintPicture routine to scale pictures.

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:


  4. 
       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 
  5. Add a new Module to the project (MODULE1.BAS).


  6. Put the following code in the basic module:


  7. 
       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 
  8. Save the project.


  9. Run it.


Click the command button with the check box checked to preview the page. Click the command button with the check box cleared to print the page.

Notes

Additional query words:


Keywords          : kbPrinting kbVBp300 kbDSupport kbvbp200 
Version           : WINDOWS:2.0,3.0
Platform          : WINDOWS 
Issue type        : 

Last Reviewed: July 20, 1999