Option Explicit

Private Sub Command4_Click()
 Unload Me
End Sub
----------------------------------------------------------------------------------
      Private Sub Form_Load()
         CommonDialog1.CancelError = True
         Command1.Caption = "Carrega Imagem"
         Command2.Caption = "Visualiza Impressão"
         Command3.Caption = "Imprimir"
      End Sub
----------------------------------------------------------------------------------
      Private Sub Command1_Click()
         Dim sFileFilter As String

         On Error GoTo ErrHandler

         sFileFilter = "Arqs. Bitmap (*.bmp)|*.bmp|"
         sFileFilter = sFileFilter & "Arqs. GIF (*.gif)|*.gif|"
         sFileFilter = sFileFilter & "Arqs. Icon (*.ico)|*.ico|"
         sFileFilter = sFileFilter & "Arqs. JPEG (*.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

         ' Pega o tamanho fisico da pagina em polegadas ( Inches )
         PgWidth = Printer.Width / 1440
         PgHeight = Printer.Height / 1440

         ' Econtre o tamanho da area não imprimível
         smtemp = Printer.ScaleMode
         Printer.ScaleMode = vbInches
         LRGap = (PgWidth - Printer.ScaleWidth) / 2
         TBGap = (PgHeight - Printer.ScaleHeight) / 2
         Printer.ScaleMode = smtemp

         picPreview.ScaleMode = vbInches

         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

         ' Define as propriedades do picture box 
         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)
         ' As dimensoes estao em polegadas

         ' Imprime alguns gráficos
         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

         ' Imprime o titulo
         With objPrint
            .Font.Name = "Arial"
            .CurrentX = 2.3
            .CurrentY = 1.3
            .FontSize = 35 * Ratio
            objPrint.Print "Impressão no VB"
         End With

         ' Imprime alguns circulos
         Dim x As Single
         For x = 3 To 5.5 Step 0.2
            objPrint.Circle (x, 3.5), 0.75
         Next

         ' Imprime algum texto
         With objPrint
            .Font.Name = "Courier New"
            .FontSize = 30 * Ratio
            .CurrentX = 1.5
            .CurrentY = 5
            objPrint.Print "Visualizando Impressão"

            .FontSize = 24 * Ratio
            .CurrentX = 1.5
            .CurrentY = 6.5
            objPrint.Print "Simples e fácil"

            .FontSize = 18 * Ratio
            .CurrentX = 1.5
            .CurrentY = 8
            objPrint.Print "Agora basta imprimir ...."
         End With
      End Sub

Quer migrar para o VB .NET ?

• Veja mais sistemas completos para a plataforma .NET no Super DVD .NET , confira...

• Curso Básico VB .NET - Vídeo Aulas

Quer aprender C# ??

• Chegou o Super DVD C# com exclusivo material de suporte e vídeo aulas com curso básico sobre C#.

• Curso C# Basico - Video Aulas

Quer aprender os conceitos da Programação Orientada a objetos ?

• Curso Fundamentos da Programação Orientada a Objetos com VB .NET

Quer aprender o gerar relatórios com o ReportViewer no VS 2013 ?

•  Curso - Gerando Relatórios com o ReportViewer no VS 2013 - Vídeo Aulas