Contoh Print Preeview Pada Visual Basic 6.0

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