QBasic & Borland Pascal & C

home *** CD-ROM | disk | FTP | other *** search

/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / VB_SMPL / VB_SMPL.ZIP / PRTPREV.EXE / GENPRINT.TXT < prev next >

Wrap

Text File | 1994-04-04 | 18.3 KB | 539 lines

How to Add Print Preview to Visual Basic Applications [B_VBasic] ID: Q113236 CREATED: 29-MAR-1994 MODIFIED: 2.00 3.00 Windows ENDUSER | -------------------------------------------------------------- The information in this article applies to: - 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 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 variable PrinterFlag. 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: 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") 'Setup 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 'Each of the following declares should be entered on a 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 Intege r 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 'Will be used 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 'The following should be entered on a 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 'The following should be entered on a 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 'The following should be entered on a single line Printer.Line (bLeft - LRGap, bTop - TBGap)- (bLeft + bWidth - LRGap, bTop + bHeight - TBGap), color, BF Else 'The following should be entered on a 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 'The following should be entered on a 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 on a single line hMem = GlobalAlloc(GMEM_MOVEABLE, (CLng(picSource.ScaleWidth + 3) \ 4) * 4 * picSource.ScaleHeight)'DWORD ALIGNED lpBits = GlobalLock(hMem) 'Enter the following on a single line r = GetDIBits(picSource.hDC, picSource.Image, 0, picSource.ScaleHeight, lpBits, BitmapInfo, DIB_RGB_COLORS) If r <> 0 Then 'Enter the following on a 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. 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 ----- - 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 algorythm 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 the device independent unit of measurement. But you could use twips, points, millimeters, or centemeters. - 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. Additional reference words: 2.00 3.00 KBCategory: APrg KBSubcategory: APrgPrint \* \* MSINTERNAL: \* Tested with: HP Laserjet II \* HP LaserJet III \* HP LaserJet IIIsi \* HP LaserJet IIIsi PostScript \* Compaq QVision 1024*768*256 Lg. Res \* ATI Graphics Ultra 800*600*256 \* VGA \* Tech Review: LyleH ================================================================================ Created_by: TIMMCB Edit_review: Edited: Modified_by: Tech_review: Reviewed: