最美我中文

实现打印预览的源码
Option Explicit

      Private Sub Form_Load()
        CommonDialog1.CancelError = True
        Command1.Caption = "Load Picture"
        Command2.Caption = "Print Preview"
        Command3.Caption = "Print"
      End Sub

      Private Sub Command1_Click()
        Dim sFileFilter As String

        On Error GoTo ErrHandler

        sFileFilter = "Bitmap Files (*.bmp)|*.bmp|"
        sFileFilter = sFileFilter & "GIF Files (*.gif)|*.gif|"
        sFileFilter = sFileFilter & "Icon Files (*.ico)|*.ico|"
        sFileFilter = sFileFilter & "JPEG Files (*.jpg)|*.jpg|"
        sFileFilter = sFileFilter & "Windows MetaFiles (*.wmf)|.wmf"
        With CommonDialog1
            .Filter = sFileFilter
            .ShowOpen
            If .FileName <> " " Then
              Picture2.Picture = LoadPicture(.FileName)
            End If
        End With

ErrHandler:
            Exit Sub
      End Sub

      Private Sub Command2_Click()
        Dim dRatio As Double
        dRatio = ScalePicPreviewToPrinterInches(Picture1)
        PrintRoutine Picture1, dRatio
      End Sub

      Private Sub Command3_Click()
        Printer.ScaleMode = vbInches
        PrintRoutine Printer
        Printer.EndDoc
      End Sub

      Private Function ScalePicPreviewToPrinterInches _
        (picPreview As PictureBox) As Double

        Dim Ratio As Double ' Ratio between Printer and Picture
        Dim LRGap As Double, TBGap As Double
        Dim HeightRatio As Double, WidthRatio As Double
        Dim PgWidth As Double, PgHeight As Double
        Dim smtemp As Long

        ' Get the physical page size in Inches:
        PgWidth = Printer.Width / 1440
        PgHeight = Printer.Height / 1440

        ' Find the size of the non-printable area on the printer to
        ' use to offset coordinates. These formulas assume the
        ' printable area is centered on the page:
        smtemp = Printer.ScaleMode
        Printer.ScaleMode = vbInches
        LRGap = (PgWidth - Printer.ScaleWidth) / 2
        TBGap = (PgHeight - Printer.ScaleHeight) / 2
        Printer.ScaleMode = smtemp

        ' Scale PictureBox to Printer's printable area in Inches:
        picPreview.ScaleMode = vbInches

        ' Compare the height and with ratios to determine the
        ' Ratio to use and how to size the picture box:
        HeightRatio = picPreview.ScaleHeight / PgHeight
        WidthRatio = picPreview.ScaleWidth / PgWidth

        If HeightRatio < WidthRatio Then
            Ratio = HeightRatio
            smtemp = picPreview.Container.ScaleMode
            picPreview.Container.ScaleMode = vbInches
            picPreview.Width = PgWidth * Ratio
            picPreview.Container.ScaleMode = smtemp
        Else
            Ratio = WidthRatio
            smtemp = picPreview.Container.ScaleMode
            picPreview.Container.ScaleMode = vbInches
            picPreview.Height = PgHeight * Ratio
            picPreview.Container.ScaleMode = smtemp
        End If

        ' Set default properties of picture box to match printer
        ' There are many that you could add here:
        picPreview.Scale (0, 0)-(PgWidth, PgHeight)
        picPreview.Font.Name = Printer.Font.Name
        picPreview.FontSize = Printer.FontSize * Ratio
        picPreview.ForeColor = Printer.ForeColor
        picPreview.Cls

        ScalePicPreviewToPrinterInches = Ratio
      End Function

      Private Sub PrintRoutine(objPrint As Object, _
                              Optional Ratio As Double = 1)
        ' All dimensions in inches:

        ' Print some graphics to the control object
        objPrint.Line (1, 1)-(1 + 6.5, 1 + 9), , B
        objPrint.Line (1.1, 2)-(1.1, 2)
        objPrint.PaintPicture Picture2, 1.1, 1.1, 0.8, 0.8
        objPrint.Line (2.1, 1.2)-(2.1 + 5.2, 1.2 + 0.7), _
                        RGB(200, 200, 200), BF

        ' Print a title
        With objPrint
            .Font.Name = "Arial"
            .CurrentX = 2.3
            .CurrentY = 1.3
            .FontSize = 35 * Ratio
            objPrint.Print "Visual Basic Printing"
        End With

        ' Print some circles
        Dim x As Single
        For x = 3 To 5.5 Step 0.2
            objPrint.Circle (x, 3.5), 0.75
        Next

        ' Print some text
        With objPrint
            .Font.Name = "Courier New"
            .FontSize = 30 * Ratio
            .CurrentX = 1.5
            .CurrentY = 5
            objPrint.Print "It is possible to do"

            .FontSize = 24 * Ratio
            .CurrentX = 1.5
            .CurrentY = 6.5
            objPrint.Print "It is possible to do print"

            .FontSize = 18 * Ratio
            .CurrentX = 1.5
            .CurrentY = 8
            objPrint.Print "It is possible to do print preview"
        End With
      End Sub