home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / print / prtprev / genbas.txt next >
Text File  |  1995-02-27  |  9KB  |  282 lines
  1. Option Explicit
  2.  
  3. ' The following Types, Declares, and Constants are only necessary for the PrintPicture routine
  4. '=====================================================================
  5. Type BITMAPINFOHEADER_TYPE
  6.     biSize As Long
  7.     biWidth As Long
  8.     biHeight As Long
  9.     biPlanes As Integer
  10.     biBitCount As Integer
  11.     biCompression As Long
  12.     biSizeImage As Long
  13.     biXPelsPerMeter As Long
  14.     biYPelsPerMeter As Long
  15.     biClrUsed As Long
  16.     biClrImportant As Long
  17.     bmiColors As String * 1024
  18. End Type
  19.  
  20. Type BITMAPINFO_TYPE
  21.     BitmapInfoHeader As BITMAPINFOHEADER_TYPE
  22.     bmiColors As String * 1024
  23. End Type
  24.  
  25.  
  26. Declare Function GetDIBits Lib "gdi" (ByVal hDC As Integer, ByVal hBitmap As Integer, ByVal nStartScan As Integer, ByVal nNumScans As Integer, ByVal lpBits As Long, BitmapInfo As BITMAPINFO_TYPE, ByVal wUsage As Integer) As Integer
  27. Declare Function StretchDIBits Lib "gdi" (ByVal hDC As Integer, ByVal DestX As Integer, ByVal DestY As Integer, ByVal wDestWidth As Integer, ByVal wDestHeight As Integer, ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal wSrcWidth As Integer, ByVal wSrcHeight As Integer, ByVal lpBits As Long, BitsInfo As BITMAPINFO_TYPE, ByVal wUsage As Integer, ByVal dwRop As Long) As Integer
  28.  
  29. Declare Function GlobalAlloc Lib "kernel" (ByVal wFlags As Integer, ByVal lMem As Long) As Integer
  30. Declare Function GlobalLock Lib "kernel" (ByVal hMem As Integer) As Long
  31. Declare Function GlobalUnlock Lib "kernel" (ByVal hMem As Integer) As Integer
  32. Declare Function GlobalFree Lib "kernel" (ByVal hMem As Integer) As Integer
  33.  
  34. Global Const SRCCOPY = &HCC0020
  35. Global Const BI_RGB = 0
  36. Global Const DIB_RGB_COLORS = 0
  37. Global Const GMEM_MOVEABLE = 2
  38. '=========================================================================================
  39.  
  40.  
  41. 'Module level variables set in PrintStartDoc
  42. 'Flag indicating Printing or Previewing
  43. Dim PrinterFlag
  44. 'Object used for Print Preview
  45. Dim ObjPrint As Control
  46. 'Storage for output objects original scale mode
  47. Dim sm
  48. 'The size ratio between the actual page and the print preview object
  49. Dim Ratio
  50. 'Size of the non-printable area on printer
  51. Dim LRGap
  52. Dim TBGap
  53. 'The actual paper size (8.5 x 11 normally)
  54. Dim PgWidth
  55. Dim PgHeight
  56.  
  57. Sub PrintBox (bLeft, bTop, bWidth, bHeight)
  58.    If PrinterFlag Then
  59.       Printer.Line (bLeft - LRGap, bTop - TBGap)-(bLeft + bWidth - LRGap, bTop + bHeight - TBGap), , B
  60.    Else
  61.       ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), , B
  62.    End If
  63. End Sub
  64.  
  65. Sub PrintCircle (bLeft, bTop, bRadius)
  66.    If PrinterFlag Then
  67.       Printer.Circle (bLeft - LRGap, bTop - TBGap), bRadius
  68.    Else
  69.       ObjPrint.Circle (bLeft, bTop), bRadius
  70.    End If
  71. End Sub
  72.  
  73. Sub PrintCurrentX (XVal)
  74.    If PrinterFlag Then
  75.       Printer.CurrentX = XVal - LRGap
  76.    Else
  77.       ObjPrint.CurrentX = XVal
  78.    End If
  79. End Sub
  80.  
  81. Sub PrintCurrentY (YVal)
  82.    If PrinterFlag Then
  83.       Printer.CurrentY = YVal - TBGap
  84.    Else
  85.       ObjPrint.CurrentY = YVal
  86.    End If
  87. End Sub
  88.  
  89. Sub PrintEndDoc ()
  90.    If PrinterFlag Then
  91.       Printer.EndDoc
  92.       Printer.ScaleMode = sm
  93.    Else
  94.       ObjPrint.ScaleMode = sm
  95.    End If
  96. End Sub
  97.  
  98. Sub PrintFilledBox (bLeft, bTop, bWidth, bHeight, color)
  99.    If PrinterFlag Then
  100.       Printer.Line (bLeft - LRGap, bTop - TBGap)-(bLeft + bWidth - LRGap, bTop + bHeight - TBGap), color, BF
  101.    Else
  102.       ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), color, BF
  103.    End If
  104. End Sub
  105.  
  106. Sub PrintFontName (pFontName)
  107.    If PrinterFlag Then
  108.       Printer.FontName = pFontName
  109.    Else
  110.       ObjPrint.FontName = pFontName
  111.    End If
  112. End Sub
  113.  
  114. Sub PrintFontSize (pSize)
  115.    If PrinterFlag Then
  116.       Printer.FontSize = pSize
  117.    Else
  118.       'Sized by ratio since Scale method does not effect FontSize
  119.       ObjPrint.FontSize = pSize * Ratio
  120.    End If
  121. End Sub
  122.  
  123. Sub PrintForeColor (ForeColor)
  124.    If PrinterFlag Then
  125.       Printer.ForeColor = ForeColor
  126.    Else
  127.       ObjPrint.ForeColor = ForeColor
  128.    End If
  129. End Sub
  130.  
  131. Sub PrintLine (bLeft0, bTop0, bLeft1, bTop1)
  132.    If PrinterFlag Then
  133.       Printer.Line (bLeft0 - LRGap, bTop0 - TBGap)-(bLeft1 - LRGap, bTop1 - TBGap)
  134.    Else
  135.       ObjPrint.Line (bLeft0, bTop0)-(bLeft1, bTop1)
  136.    End If
  137. End Sub
  138.  
  139. Sub PrintNewPage ()
  140.    If PrinterFlag Then
  141.       Printer.NewPage
  142.    Else
  143.       ObjPrint.Cls
  144.    End If
  145. End Sub
  146.  
  147. Sub PrintPicture (picSource As Control, ByVal pLeft, ByVal pTop, ByVal pWidth, ByVal pHeight)
  148.    'Picture Box should have autoredraw = False, ScaleMode = Pixel
  149.    ' Also can have visible=false, Autosize = true
  150.    
  151.    Dim BitmapInfo As BITMAPINFO_TYPE
  152.    Dim DesthDC As Integer
  153.    Dim hMem As Integer
  154.    Dim lpBits As Long
  155.    Dim r As Integer
  156.  
  157.    'Precaution
  158.    If pLeft < LRGap Or pTop < TBGap Then Exit Sub
  159.    If pWidth < 0 Or pHeight < 0 Then Exit Sub
  160.    If pWidth + pLeft > PgWidth - LRGap Then Exit Sub
  161.    If pHeight + pTop > PgHeight - TBGap Then Exit Sub
  162.    picSource.ScaleMode = 3 'Pixels
  163.    picSource.AutoRedraw = False
  164.    picSource.Visible = False
  165.    picSource.AutoSize = True
  166.  
  167.    If PrinterFlag Then
  168.       Printer.ScaleMode = 3 'Pixels
  169.       pLeft = ((pLeft - LRGap) * 1440) / Printer.TwipsPerPixelX
  170.       pTop = ((pTop - TBGap) * 1440) / Printer.TwipsPerPixelY
  171.       pWidth = (pWidth * 1440) / Printer.TwipsPerPixelX
  172.       pHeight = (pHeight * 1440) / Printer.TwipsPerPixelY
  173.       Printer.Print "";
  174.       DesthDC = Printer.hDC
  175.    Else
  176.       ObjPrint.Scale
  177.       ObjPrint.ScaleMode = 3 'Pixels
  178.       pLeft = ((pLeft * 1440) / Screen.TwipsPerPixelX) * Ratio
  179.       pTop = ((pTop * 1440) / Screen.TwipsPerPixelY) * Ratio
  180.       pWidth = ((pWidth * 1440) / Screen.TwipsPerPixelX) * Ratio
  181.       pHeight = ((pHeight * 1440) / Screen.TwipsPerPixelY) * Ratio
  182.       DesthDC = ObjPrint.hDC
  183.    End If
  184.  
  185.    BitmapInfo.BitmapInfoHeader.biSize = 40
  186.    BitmapInfo.BitmapInfoHeader.biWidth = picSource.ScaleWidth
  187.    BitmapInfo.BitmapInfoHeader.biHeight = picSource.ScaleHeight
  188.    BitmapInfo.BitmapInfoHeader.biPlanes = 1
  189.    BitmapInfo.BitmapInfoHeader.biBitCount = 8
  190.    BitmapInfo.BitmapInfoHeader.biCompression = BI_RGB
  191.    
  192.    hMem = GlobalAlloc(GMEM_MOVEABLE, (CLng(picSource.ScaleWidth + 3) \ 4) * 4 * picSource.ScaleHeight)'DWORD ALIGNED
  193.    lpBits = GlobalLock(hMem)
  194.    
  195.    r = GetDIBits(picSource.hDC, picSource.Image, 0, picSource.ScaleHeight, lpBits, BitmapInfo, DIB_RGB_COLORS)
  196.    If r <> 0 Then
  197.       r = StretchDIBits(DesthDC, pLeft, pTop, pWidth, pHeight, 0, 0, picSource.ScaleWidth, picSource.ScaleHeight, lpBits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY)
  198.    End If
  199.  
  200.    r = GlobalUnlock(hMem)
  201.    r = GlobalFree(hMem)
  202.   
  203.    If PrinterFlag Then
  204.       Printer.ScaleMode = 5 'Inches
  205.    Else
  206.       ObjPrint.ScaleMode = 5'Inches
  207.       ObjPrint.Scale (0, 0)-(PgWidth, PgHeight)
  208.    End If
  209.    
  210.  
  211. End Sub
  212.  
  213. Sub PrintPrint (PrintVar)
  214.    If PrinterFlag Then
  215.       Printer.Print PrintVar
  216.    Else
  217.       ObjPrint.Print PrintVar
  218.    End If
  219. End Sub
  220.  
  221. Sub PrintStartDoc (objToPrintOn As Control, PF, PaperWidth, PaperHeight)
  222.    Dim psm
  223.    Dim fsm
  224.    Dim HeightRatio
  225.    Dim WidthRatio
  226.  
  227.    'Set the flag that determines whether printing or previewing
  228.    PrinterFlag = PF
  229.    
  230.    'Set the physical page size
  231.    PgWidth = PaperWidth
  232.    PgHeight = PaperHeight
  233.    
  234.    'Find the size of the non-printable area on the printer
  235.    'Will be used to offset coordinates
  236.    psm = Printer.ScaleMode
  237.    Printer.ScaleMode = 5 'Inches
  238.    LRGap = (PgWidth - Printer.ScaleWidth) / 2
  239.    TBGap = (PgHeight - Printer.ScaleHeight) / 2
  240.    Printer.ScaleMode = psm
  241.  
  242.    'Initialize printer or preview object
  243.    If PrinterFlag Then
  244.       sm = Printer.ScaleMode
  245.       Printer.ScaleMode = 5 'Inches
  246.       Printer.Print "";
  247.    Else
  248.       'Set the object used for preview
  249.       Set ObjPrint = objToPrintOn
  250.       'Scale Object to Printer's printable area in Inches
  251.       sm = ObjPrint.ScaleMode
  252.       ObjPrint.ScaleMode = 5 'Inches
  253.       'Compare the height and with ratios to determine the
  254.       'Ratio to use and how to size the picture box
  255.       HeightRatio = ObjPrint.ScaleHeight / PgHeight
  256.       WidthRatio = ObjPrint.ScaleWidth / PgWidth
  257.       If HeightRatio < WidthRatio Then
  258.          Ratio = HeightRatio
  259.          'Resize picture box - this does not work on a form
  260.          fsm = ObjPrint.Parent.ScaleMode
  261.          ObjPrint.Parent.ScaleMode = 5 'Inches
  262.          ObjPrint.Width = PgWidth * Ratio
  263.          ObjPrint.Parent.ScaleMode = fsm
  264.       Else
  265.          Ratio = WidthRatio
  266.          'Resize picture box - this does not work on a form
  267.          fsm = ObjPrint.Parent.ScaleMode
  268.          ObjPrint.Parent.ScaleMode = 5 'Inches
  269.          ObjPrint.Height = PgHeight * Ratio
  270.          ObjPrint.Parent.ScaleMode = fsm
  271.       End If
  272.       'Set default properties of picture box to match printer
  273.       'There are many that you could add here
  274.       ObjPrint.Scale (0, 0)-(PgWidth, PgHeight)
  275.       ObjPrint.FontName = Printer.FontName
  276.       ObjPrint.FontSize = Printer.FontSize * Ratio
  277.       ObjPrint.ForeColor = Printer.ForeColor
  278.       ObjPrint.Cls
  279.    End If
  280. End Sub
  281.  
  282.