home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / debugt1r / module1.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-10  |  6.9 KB  |  187 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Public fMainForm As frmMain
  4.    Private Type Rect
  5.       Left As Long
  6.       Top As Long
  7.       Right As Long
  8.       Bottom As Long
  9.    End Type
  10.  
  11.    Private Type CharRange
  12.      cpMin As Long     ' First character of range (0 for start of doc)
  13.      cpMax As Long     ' Last character of range (-1 for end of doc)
  14.    End Type
  15.  
  16.    Private Type FormatRange
  17.      hdc As Long       ' Actual DC to draw on
  18.      hdcTarget As Long ' Target DC for determining text formatting
  19.      rc As Rect        ' Region of the DC to draw to (in twips)
  20.      rcPage As Rect    ' Region of the entire DC (page size) (in twips)
  21.      chrg As CharRange ' Range of text to draw (see above declaration)
  22.    End Type
  23.  
  24.    Private Const WM_USER As Long = &H400
  25.    Private Const EM_FORMATRANGE As Long = WM_USER + 57
  26.    Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
  27.    Private Const PHYSICALOFFSETX As Long = 112
  28.    Private Const PHYSICALOFFSETY As Long = 113
  29.  
  30.    Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  31.       ByVal hdc As Long, ByVal nIndex As Long) As Long
  32.    Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
  33.       (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, _
  34.       lp As Any) As Long
  35.    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
  36.       (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  37.       ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
  38.  
  39.    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  40.    '
  41.    ' WYSIWYG_RTF - Sets an RTF control to display itself the same as it
  42.    '               would print on the default printer
  43.    '
  44.    ' RTF - A RichTextBox control to set for WYSIWYG display.
  45.    '
  46.    ' LeftMarginWidth - Width of desired left margin in twips
  47.    '
  48.    ' RightMarginWidth - Width of desired right margin in twips
  49.    '
  50.    ' Returns - The length of a line on the printer in twips
  51.    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  52.    Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, _
  53.       RightMarginWidth As Long) As Long
  54.       Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long
  55.       Dim LineWidth As Long
  56.       Dim PrinterhDC As Long
  57.       Dim r As Long
  58.  
  59.       ' Start a print job to initialize printer object
  60.       Printer.Print Space(1)
  61.       Printer.ScaleMode = vbTwips
  62.  
  63.       ' Get the offset to the printable area on the page in twips
  64.       LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
  65.          PHYSICALOFFSETX), vbPixels, vbTwips)
  66.  
  67.       ' Calculate the Left, and Right margins
  68.       LeftMargin = LeftMarginWidth - LeftOffset
  69.       RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
  70.  
  71.       ' Calculate the line width
  72.       LineWidth = RightMargin - LeftMargin
  73.  
  74.       ' Create an hDC on the Printer pointed to by the Printer object
  75.       ' This DC needs to remain for the RTF to keep up the WYSIWYG display
  76.       PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
  77.  
  78.       ' Tell the RTF to base it's display off of the printer
  79.       '    at the desired line width
  80.       r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _
  81.          ByVal LineWidth)
  82.  
  83.       ' Abort the temporary print job used to get printer info
  84.       Printer.KillDoc
  85.  
  86.       WYSIWYG_RTF = LineWidth
  87.    End Function
  88.  
  89.    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  90.    '
  91.    ' PrintRTF - Prints the contents of a RichTextBox control using the
  92.    '            provided margins
  93.    '
  94.    ' RTF - A RichTextBox control to print
  95.    '
  96.    ' LeftMarginWidth - Width of desired left margin in twips
  97.    '
  98.    ' TopMarginHeight - Height of desired top margin in twips
  99.    '
  100.    ' RightMarginWidth - Width of desired right margin in twips
  101.    '
  102.    ' BottomMarginHeight - Height of desired bottom margin in twips
  103.    '
  104.    ' Notes - If you are also using WYSIWYG_RTF() on the provided RTF
  105.    '         parameter you should specify the same LeftMarginWidth and
  106.    '         RightMarginWidth that you used to call WYSIWYG_RTF()
  107.    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  108.    Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
  109.       TopMarginHeight, RightMarginWidth, BottomMarginHeight)
  110.       Dim LeftOffset As Long, TopOffset As Long
  111.       Dim LeftMargin As Long, TopMargin As Long
  112.       Dim RightMargin As Long, BottomMargin As Long
  113.       Dim fr As FormatRange
  114.       Dim rcDrawTo As Rect
  115.       Dim rcPage As Rect
  116.       Dim TextLength As Long
  117.       Dim NextCharPosition As Long
  118.       Dim r As Long
  119.  
  120.       ' Start a print job to get a valid Printer.hDC
  121.       Printer.Print Space(1)
  122.       Printer.ScaleMode = vbTwips
  123.  
  124.       ' Get the offsett to the printable area on the page in twips
  125.       LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
  126.          PHYSICALOFFSETX), vbPixels, vbTwips)
  127.       TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
  128.          PHYSICALOFFSETY), vbPixels, vbTwips)
  129.  
  130.       ' Calculate the Left, Top, Right, and Bottom margins
  131.       LeftMargin = LeftMarginWidth - LeftOffset
  132.       TopMargin = TopMarginHeight - TopOffset
  133.       RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
  134.       BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
  135.  
  136.       ' Set printable area rect
  137.       rcPage.Left = 0
  138.       rcPage.Top = 0
  139.       rcPage.Right = Printer.ScaleWidth
  140.       rcPage.Bottom = Printer.ScaleHeight
  141.  
  142.       ' Set rect in which to print (relative to printable area)
  143.       rcDrawTo.Left = LeftMargin
  144.       rcDrawTo.Top = TopMargin
  145.       rcDrawTo.Right = RightMargin
  146.       rcDrawTo.Bottom = BottomMargin
  147.  
  148.       ' Set up the print instructions
  149.       fr.hdc = Printer.hdc   ' Use the same DC for measuring and rendering
  150.       fr.hdcTarget = Printer.hdc  ' Point at printer hDC
  151.       fr.rc = rcDrawTo            ' Indicate the area on page to draw to
  152.       fr.rcPage = rcPage          ' Indicate entire size of page
  153.       fr.chrg.cpMin = 0           ' Indicate start of text through
  154.       fr.chrg.cpMax = -1          ' end of the text
  155.  
  156.       ' Get length of text in RTF
  157.       TextLength = Len(RTF.Text)
  158.  
  159.       ' Loop printing each page until done
  160.       Do
  161.          ' Print the page by sending EM_FORMATRANGE message
  162.          NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
  163.          If NextCharPosition >= TextLength Then Exit Do   'If done then exit
  164.          fr.chrg.cpMin = NextCharPosition ' Starting position for next page
  165.          Printer.NewPage                  ' Move on to next page
  166.          Printer.Print Space(1) ' Re-initialize hDC
  167.          fr.hdc = Printer.hdc
  168.          fr.hdcTarget = Printer.hdc
  169.       Loop
  170.  
  171.       ' Commit the print job
  172.       Printer.EndDoc
  173.  
  174.       ' Allow the RTF to free up memory
  175.       r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
  176.    End Sub
  177.  
  178.  
  179.  
  180.  
  181.  
  182. Sub Main()
  183.     Set fMainForm = New frmMain
  184.     fMainForm.Show
  185. End Sub
  186.  
  187.