home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Print_and_210872462008.psc / frmPrintPre.frm < prev    next >
Text File  |  2008-04-06  |  7KB  |  204 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPrintPre 
  3.    BackColor       =   &H00E0E0E0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "                           Preview And Print Form"
  6.    ClientHeight    =   8430
  7.    ClientLeft      =   45
  8.    ClientTop       =   435
  9.    ClientWidth     =   5805
  10.    ControlBox      =   0   'False
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   8430
  15.    ScaleWidth      =   5805
  16.    Begin VB.CommandButton Command1 
  17.       Caption         =   "Save as Bitmap"
  18.       Height          =   540
  19.       Left            =   45
  20.       TabIndex        =   4
  21.       Top             =   7755
  22.       Width           =   1590
  23.    End
  24.    Begin VB.CommandButton cmdCancel 
  25.       Caption         =   "Cancel"
  26.       Height          =   540
  27.       Left            =   2040
  28.       TabIndex        =   3
  29.       Top             =   7755
  30.       Width           =   1875
  31.    End
  32.    Begin VB.CommandButton cmdPrintAll 
  33.       Caption         =   "Print Pictures"
  34.       Height          =   540
  35.       Left            =   4290
  36.       TabIndex        =   2
  37.       Top             =   7755
  38.       Width           =   1425
  39.    End
  40.    Begin VB.PictureBox PicSrc 
  41.       AutoRedraw      =   -1  'True
  42.       AutoSize        =   -1  'True
  43.       Height          =   765
  44.       Left            =   7470
  45.       ScaleHeight     =   705
  46.       ScaleWidth      =   1110
  47.       TabIndex        =   1
  48.       Top             =   9075
  49.       Width           =   1170
  50.    End
  51.    Begin VB.PictureBox Picture1 
  52.       AutoRedraw      =   -1  'True
  53.       BackColor       =   &H00FFFFFF&
  54.       BorderStyle     =   0  'None
  55.       Height          =   7425
  56.       Left            =   15
  57.       ScaleHeight     =   495
  58.       ScaleMode       =   3  'Pixel
  59.       ScaleWidth      =   384
  60.       TabIndex        =   0
  61.       Top             =   180
  62.       Width           =   5760
  63.    End
  64. End
  65. Attribute VB_Name = "frmPrintPre"
  66. Attribute VB_GlobalNameSpace = False
  67. Attribute VB_Creatable = False
  68. Attribute VB_PredeclaredId = True
  69. Attribute VB_Exposed = False
  70. Option Explicit
  71. '
  72. 'Printer code is from Microsoft site, modified a little for this program
  73. '
  74.  
  75. Private Sub Form_Load()
  76.    Dim dRatio As Double
  77.    Dim x As Integer
  78.    Me.Left = frmMain.Left + 650
  79.    Me.Top = frmMain.Top
  80.    dRatio = ScalePicPreviewToPrinterInches(Picture1)
  81.    PrintRoutineAll Picture1, dRatio
  82. End Sub
  83.  
  84. Private Sub Command1_Click()
  85.    With frmEdit.cde
  86.         .DialogTitle = "Save Picture"
  87.         .Filter = "Bitmap (*.Bmp )|*.bmp"
  88.         Picture1.Picture = Picture1.Image
  89.         .ShowSave
  90.         SavePicture Picture1.Picture, .FileName
  91.         MsgBox "Picture saved...." & .FileName
  92.     End With
  93. End Sub
  94.  
  95. Private Sub cmdCancel_Click()
  96. Dim x As Integer
  97.     For x = 0 To 7
  98.         frmMain.Shape1(x).Visible = True
  99.      Next x
  100.     Unload Me
  101. End Sub
  102.  
  103. Private Sub cmdPrintAll_Click()   'print
  104.          Printer.ScaleMode = vbInches
  105.          PrintRoutineAll Printer
  106.          Printer.EndDoc
  107. End Sub
  108.  
  109. Private Function ScalePicPreviewToPrinterInches(picPreview As PictureBox) As Double
  110.  
  111.          Dim Ratio As Double ' Ratio between Printer and Picture
  112.          Dim LRGap As Double, TBGap As Double
  113.          Dim HeightRatio As Double, WidthRatio As Double
  114.          Dim PgWidth As Double, PgHeight As Double
  115.          Dim smtemp As Long
  116.  
  117.          ' Get the physical page size in Inches:
  118.          PgWidth = Printer.Width / 1440
  119.          PgHeight = Printer.Height / 1440
  120.  
  121.          ' Find the size of the non-printable area on the printer to
  122.          ' use to offset coordinates. These formulas assume the
  123.          ' printable area is centered on the page:
  124.          smtemp = Printer.ScaleMode
  125.          Printer.ScaleMode = vbInches
  126.          LRGap = (PgWidth - Printer.ScaleWidth) / 2
  127.          TBGap = (PgHeight - Printer.ScaleHeight) / 2
  128.          Printer.ScaleMode = smtemp
  129.  
  130.          ' Scale PictureBox to Printer's printable area in Inches:
  131.          picPreview.ScaleMode = vbInches
  132.  
  133.          ' Compare the height and with ratios to determine the
  134.          ' Ratio to use and how to size the picture box:
  135.          HeightRatio = picPreview.ScaleHeight / PgHeight
  136.          WidthRatio = picPreview.ScaleWidth / PgWidth
  137.  
  138.          If HeightRatio < WidthRatio Then
  139.             Ratio = HeightRatio
  140.             smtemp = picPreview.Container.ScaleMode
  141.             picPreview.Container.ScaleMode = vbInches
  142.             picPreview.Width = PgWidth * Ratio
  143.             picPreview.Container.ScaleMode = smtemp
  144.          Else
  145.             Ratio = WidthRatio
  146.             smtemp = picPreview.Container.ScaleMode
  147.             picPreview.Container.ScaleMode = vbInches
  148.             picPreview.Height = PgHeight * Ratio
  149.             picPreview.Container.ScaleMode = smtemp
  150.          End If
  151.  
  152.          ' Set default properties of picture box to match printer
  153.          ' There are many that you could add here:
  154.          picPreview.Scale (0, 0)-(PgWidth, PgHeight)
  155.          picPreview.Font.Name = Printer.Font.Name
  156.          picPreview.FontSize = Printer.FontSize * Ratio
  157.          picPreview.ForeColor = Printer.ForeColor
  158.          picPreview.Cls
  159.  
  160.          ScalePicPreviewToPrinterInches = Ratio
  161. End Function
  162.  
  163.       
  164. Private Sub PrintRoutineAll(objPrint As Object, Optional Ratio As Double = 1)
  165.          ' All dimensions in inches:
  166.          Dim xPosition As Double      'horizontal (or left) position of picture
  167.          Dim yPosition As Double      'vertical (or top) position of picture
  168.          xPosition = 0.08
  169.          yPosition = 0.15
  170.          Dim i As Integer
  171.          
  172.          Dim picWidth As Double       'picture width
  173.          Dim picHeight As Double      'picture height
  174.          picWidth = 3.9
  175.          picHeight = 2.48
  176.          
  177.          Dim xSpacing As Double       'horizontal spacing bewtween pictures
  178.          Dim ySpacing As Double       'vertical spacing between pictures
  179.          xSpacing = 0.32
  180.          ySpacing = 0.25
  181.          
  182.      For i = 0 To 7
  183.      
  184.          ' Print some graphics to the control object
  185.          frmMain.picDisplay(i).Picture = frmMain.picDisplay(i).Image
  186.          PicSrc.Picture = frmMain.picDisplay(i).Picture
  187.          'object.PaintPicture picture, x1, y1, width1, height1, x2, y2, width2, height2, opcode   '<-- general format
  188.          objPrint.PaintPicture PicSrc.Picture, xPosition, yPosition, picWidth, picHeight
  189.          
  190.          xPosition = xPosition + (picWidth + xSpacing)       'next picture moves in the x direction
  191.  
  192.          If xPosition >= 8 Then                              'if xPosition is greater than 8 in., then start a new row
  193.             xPosition = 0.08                                 'new row so x starts a the beginning
  194.             yPosition = yPosition + (picHeight + ySpacing)   'y moves down one row
  195.          End If
  196.          
  197.      Next i
  198.  
  199. End Sub
  200.  
  201. Private Sub Form_Unload(Cancel As Integer)
  202.    Unload Me
  203. End Sub
  204.