home *** CD-ROM | disk | FTP | other *** search
/ CD Direkt 1995 #6 / CDD_6_95.ISO / cdd / winanw / emedit / install / printer.ba_ / printer.ba
Text File  |  1994-09-05  |  8KB  |  225 lines
  1. Option Explicit
  2.  
  3. Global Const gDefaultPrintHeader$ = "&f"
  4. Global Const gDefaultPrintFooter$ = "Page &p"
  5. Global Const gDefaultPrintLeftLogicalMargin# = .75
  6. Global Const gDefaultPrintTopLogicalMargin# = 1
  7. Global Const gDefaultPrintRightPixelMargin# = .75
  8. Global Const gDefaultPrintBottomPixelMargin# = 1
  9.  
  10. Global gPrintHeader$
  11. Global gPrintFooter$
  12.  
  13. Global gPrintLeftLogicalMargin#
  14. Global gPrintTopLogicalMargin#
  15. Global gPrintRightPixelMargin#
  16. Global gPrintBottomPixelMargin#
  17.  
  18. Sub FilePageSetup ()
  19.     frmPageSetup.txtHeader.Text = gPrintHeader$
  20.     frmPageSetup.txtFooter.Text = gPrintFooter$
  21.  
  22.     frmPageSetup.txtLeft.Text = CStr(gPrintLeftLogicalMargin#)
  23.     frmPageSetup.txtTop.Text = CStr(gPrintTopLogicalMargin#)
  24.     frmPageSetup.txtRight.Text = CStr(gPrintRightPixelMargin#)
  25.     frmPageSetup.txtBottom.Text = CStr(gPrintBottomPixelMargin#)
  26.  
  27.     frmPageSetup.Show 1 'modal
  28.     If InStr(frmPageSetup.cmdOK.Tag, "OK") Then
  29.         gPrintHeader$ = frmPageSetup.txtHeader.Text
  30.         gPrintFooter$ = frmPageSetup.txtFooter.Text
  31.     
  32.         gPrintLeftLogicalMargin# = CDbl(frmPageSetup.txtLeft.Text)
  33.         gPrintTopLogicalMargin# = CDbl(frmPageSetup.txtTop.Text)
  34.         gPrintRightPixelMargin# = CDbl(frmPageSetup.txtRight.Text)
  35.         gPrintBottomPixelMargin# = CDbl(frmPageSetup.txtBottom.Text)
  36.     End If
  37.     Unload frmPageSetup
  38. End Sub
  39.  
  40. 'It is assumed here that this function has been invoked
  41. 'by the PCANCEL form.
  42. 'This function uses an editor on the main form to find out
  43. 'how many lines will fit on a printer page and also to wrap
  44. 'text so that it fits the Printer.
  45. 'This function will print out text like Windows Notepad, with margins
  46. 'and, optionally, a header and a footer.
  47. Function FilePrint () As Integer
  48.     '1st, set the font in the printer to the current editor's font
  49.     'and resize the editor so that it fits the Printer (taking
  50.     'margins into account also).
  51.     SetPrinterFont2ActiveFont
  52.     frmMDI.Editor4Printing.FontName = Printer.FontName
  53.     frmMDI.Editor4Printing.FontSize = Printer.FontSize
  54.     frmMDI.Editor4Printing.FontBold = Printer.FontBold
  55.     frmMDI.Editor4Printing.FontItalic = Printer.FontItalic
  56.     frmMDI.Editor4Printing.Width = Printer.Width - 1440 * (gPrintLeftLogicalMargin# + gPrintRightPixelMargin#)
  57.     frmMDI.Editor4Printing.Height = Printer.Height - 1440 * (gPrintTopLogicalMargin# + gPrintBottomPixelMargin#)
  58.  
  59.     ' the # of lines that will fit on a page
  60.     Dim LinesPerPage&
  61.     LinesPerPage& = frmMDI.Editor4Printing.FullLinesPerWindow
  62.     If gPrintHeader$ <> "" Then LinesPerPage& = LinesPerPage& - 1
  63.     If gPrintFooter$ <> "" Then LinesPerPage& = LinesPerPage& - 1
  64.  
  65.     Dim Count& ' the # of lines in our source editor
  66.     Count& = frmMDI.ActiveForm.Text1.Count
  67.  
  68.     Dim Header$ ' line to print at top of page
  69.     Header$ = GetFullHeader()
  70.  
  71.     Dim I&, K&, nPage&
  72.     nPage& = 1
  73.     K = 1
  74.     I = 1
  75.     Do While K <= Count
  76.  
  77.         ' find out if the user has pressed the cancel
  78.         ' button, if so then exit
  79.         DoEvents
  80.         If PCANCEL.Tag <> "" Then Exit Do
  81.  
  82.         ' clear all the text
  83.         frmMDI.Editor4Printing.SelMark = 1 'make a stream block
  84.         frmMDI.Editor4Printing.SelStartX = 1
  85.         frmMDI.Editor4Printing.SelStartY = 1
  86.         frmMDI.Editor4Printing.SelEndY = frmMDI.Editor4Printing.Count
  87.         frmMDI.Editor4Printing.TextIndex = frmMDI.Editor4Printing.Count
  88.         frmMDI.Editor4Printing.SelEndX = Len(frmMDI.Editor4Printing.Text) + 1
  89.         frmMDI.Editor4Printing.Action = 4  'clear
  90.  
  91.         'load exacly one complete line from the current editor into the
  92.         'editor used for printing
  93.         Do
  94.             frmMDI.ActiveForm.Text1.TextIndex = K
  95.             frmMDI.Editor4Printing.SelText = frmMDI.ActiveForm.Text1.Text
  96.             K = K + 1
  97.             If frmMDI.ActiveForm.Text1.IsEndOfParagraph Then Exit Do
  98.         Loop
  99.  
  100.         Dim J&
  101.         For J = 1 To frmMDI.Editor4Printing.Count
  102.  
  103.             ' if we're at the top of the page
  104.             If (I - 1) Mod LinesPerPage = 0 Then
  105.                 'insert space for the top margin
  106.                 Printer.CurrentY = 1440 * gPrintTopLogicalMargin#
  107.     
  108.                 'then print the header, centered
  109.                 If Header$ <> "" Then
  110.                     Dim HeaderWidth%
  111.                     HeaderWidth% = Printer.TextWidth(Header$)
  112.                     If HeaderWidth% < Printer.Width Then
  113.                         Printer.CurrentX = (Printer.Width - HeaderWidth%) / 2
  114.                     End If
  115.                     Printer.Print Header$
  116.                 End If
  117.  
  118.                 I = I + 1
  119.             End If
  120.     
  121.             ' print the next line of text
  122.             Printer.CurrentX = 1440 * gPrintLeftLogicalMargin#
  123.             frmMDI.Editor4Printing.TextIndex = J
  124.             Printer.Print frmMDI.Editor4Printing.Text
  125.     
  126.             ' if we're at the bottom of the page then print the footer
  127.             If (Count& < K Or I Mod LinesPerPage = 0) And gPrintFooter$ <> "" Then
  128.                 Dim footer$
  129.                 footer$ = GetFullFooter(nPage)
  130.     
  131.                 ' If printing the footer for the last page and the whole page
  132.                 ' has not been filled up yet then print blank lines until the
  133.                 ' page is full(this way the footer is always at the bottom of
  134.                 ' the page).
  135.                 Do While I Mod LinesPerPage <> 0
  136.                     Printer.Print ""
  137.                     I = I + 1
  138.                 Loop
  139.     
  140.                 Dim FooterWidth%
  141.                 FooterWidth% = Printer.TextWidth(footer$)
  142.                 If FooterWidth% < Printer.Width Then
  143.                     Printer.CurrentX = (Printer.Width - FooterWidth%) / 2
  144.                 End If
  145.                 Printer.Print footer$
  146.                 Printer.NewPage
  147.                 nPage& = nPage& + 1
  148.             End If
  149.  
  150.             I = I + 1
  151.         Next
  152.     Loop
  153.  
  154.     ' if the user canceled the print operation then
  155.     ' return False, otherwise return True.
  156.     If PCANCEL.Tag = "" Then
  157.         FilePrint = True
  158.     Else
  159.         FilePrint = False
  160.     End If
  161. End Function
  162.  
  163. Sub FilePrintSetup ()
  164.     'set cancel to true
  165.     frmMDI.CMFontDialog.CancelError = True
  166.     On Error GoTo FilePrintSetupHandler
  167.  
  168.     frmMDI.CMFontDialog.Flags = &H40 'display print setup dialog
  169.  
  170.     'display the dialog box
  171.     frmMDI.CMFontDialog.Action = 5
  172.  
  173. FilePrintSetupHandler: ' user pressed cancel button
  174.     Exit Sub
  175. End Sub
  176.  
  177. Function GetFullFooter (nPage&) As String
  178.     Dim Pos%
  179.     Pos% = InStr(gPrintFooter$, "&p")
  180.     If Pos% Then
  181.         GetFullFooter = Left$(gPrintFooter$, Pos% - 1) & CStr(nPage&) & Mid$(gPrintFooter$, Pos% + 2)
  182.     Else
  183.         GetFullFooter = gPrintFooter$
  184.     End If
  185. End Function
  186.  
  187. Function GetFullHeader () As String
  188.     Dim FileNamePos%
  189.     FileNamePos% = InStr(gPrintHeader$, "&f")
  190.     If FileNamePos% Then
  191.         GetFullHeader = Left$(gPrintHeader$, FileNamePos% - 1) & frmMDI.ActiveForm.Caption & Mid$(gPrintHeader$, FileNamePos% + 2)
  192.     Else
  193.         GetFullHeader = gPrintHeader$
  194.     End If
  195. End Function
  196.  
  197. Sub InitializePrinterModule ()
  198.     gPrintHeader$ = gDefaultPrintHeader$
  199.     gPrintFooter$ = gDefaultPrintFooter$
  200.  
  201.     gPrintLeftLogicalMargin# = gDefaultPrintLeftLogicalMargin#
  202.     gPrintTopLogicalMargin# = gDefaultPrintTopLogicalMargin#
  203.     gPrintRightPixelMargin# = gDefaultPrintRightPixelMargin#
  204.     gPrintBottomPixelMargin# = gDefaultPrintBottomPixelMargin#
  205. End Sub
  206.  
  207. 'For reasons I don't understand setting the Printer font to "MS Serif"
  208. 'or "MS Sans Serif generates an error, therefore this function is used
  209. 'to set the Printer font.  If the Printer font can be set to the font
  210. 'in the currently active window then that's just peachy keen otherwise
  211. 'the Printer font is just left alone.
  212. Sub SetPrinterFont2ActiveFont ()
  213. On Error GoTo SetPrinterFontError
  214.     Printer.FontName = frmMDI.ActiveForm.Text1.FontName
  215.     Printer.FontSize = frmMDI.ActiveForm.Text1.FontSize
  216.     Printer.FontBold = frmMDI.ActiveForm.Text1.FontBold
  217.     Printer.FontItalic = frmMDI.ActiveForm.Text1.Fon