home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD52274262000.psc / modPrint.bas < prev    next >
Encoding:
BASIC Source File  |  2000-04-25  |  1.7 KB  |  45 lines
  1. Attribute VB_Name = "ModPrint"
  2. Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
  3. Const vbHiMetric As Integer = 8
  4. Dim PicRatio As Double
  5. Dim PrnWidth As Double
  6. Dim PrnHeight As Double
  7. Dim PrnRatio As Double
  8. Dim PrnPicWidth As Double
  9. Dim PrnPicHeight As Double
  10.  
  11.     ' Determine if picture should be printed in landscape or portrait
  12.     ' and set the orientation
  13.     If Pic.Height >= Pic.Width Then
  14.         Prn.Orientation = vbPRORPortrait   ' Taller than wide
  15.     Else
  16.         Prn.Orientation = vbPRORLandscape  ' Wider than tall
  17.     End If
  18.  
  19.     ' Calculate device independent Width to Height ratio for picture
  20.         PicRatio = Pic.Width / Pic.Height
  21.  
  22.     ' Calculate the dimentions of the printable area in HiMetric
  23.         PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
  24.         PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
  25.     ' Calculate device independent Width to Height ratio for printer
  26.         PrnRatio = PrnWidth / PrnHeight
  27.  
  28.     ' Scale the output to the printable area
  29.     If PicRatio >= PrnRatio Then
  30.     ' Scale picture to fit full width of printable area
  31.         PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
  32.         PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, _
  33.         Prn.ScaleMode)
  34.     Else
  35.     ' Scale picture to fit full height of printable area
  36.         PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
  37.         PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, _
  38.         Prn.ScaleMode)
  39.     End If
  40.  
  41.     ' Print the picture using the PaintPicture method
  42.         Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
  43. End Sub
  44.  
  45.