Print picture to fit the page

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Advanced

Author:

Waty

Version Compatibility: Visual Basic 5

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function PrintPictureToFitPage(Prn As Printer, _
 Pic As Picture) As Boolean
 
' #VBIDEUtils#***************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 13/10/98
' * Time             : 09:18
' * Module Name      : Capture_Module
' * Module Filename  : Capture.bas
' * Procedure Name   : PrintPictureToFitPage
' * Parameters       :
' *                    Prn As Printer
' *                    Pic As Picture
' *****************************************************************
' * Comments         : Prints a Picture object as
                       'big as possible
' *
' *
' *************************************************************

Const vbHiMetric As Integer = 8

Dim PicRatio      As Double
Dim PrnWidth      As Double
Dim PrnHeight     As Double
Dim PrnRatio      As Double
Dim PrnPicWidth   As Double
Dim PrnPicHeight  As Double

On Error GoTo ErrorHandler

' *** Determine if picture should be printed in
'landscape or portrait and set the orientation
If Pic.Height >= Pic.Width Then
   Prn.Orientation = vbPRORPortrait ' Taller than wide
Else
   Prn.Orientation = vbPRORLandscape ' Wider than tall
End If

' *** Calculate device independent Width to Height
'ratio for picture
PicRatio = Pic.Width / Pic.Height

' *** Calculate the dimentions of the printable
'area in HiMetric
PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)

' *** Calculate device independent Width to Height
'ratio for printer
PrnRatio = PrnWidth / PrnHeight

' *** Scale the output to the printable area
If PicRatio >= PrnRatio Then
   ' *** Scale picture to fit full width of printable area
   PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, _
       Prn.ScaleMode)
   PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, _
       vbHiMetric, Prn.ScaleMode)
Else
   ' *** Scale picture to fit full height of printable area
   PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, _
       Prn.ScaleMode)
   PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, _
       vbHiMetric, Prn.ScaleMode)
End If

' *** Print the picture using the PaintPicture method
Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
PrintPictureToFitPage = True
Exit Function

ErrorHandler:
    
    PrintPictureToFitPage = False

End Function