Attribute VB_Name = "mod_PrintRTF"
Option Explicit


Private Declare Function GetDeviceCaps Lib "gdi32" ( _
   ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, _
   lp As Any) As Long

Private Type CharRange
     cpMin As Long     ' First character of range (0 for start of doc)
     cpMax As Long     ' Last character of range (-1 for end of doc)
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type FormatRange
     hdc As Long       ' Actual DC to draw on
     hdcTarget As Long ' Target DC for determining text formatting
     rc As RECT        ' Region of the DC to draw to (in twips)
     rcPage As RECT    ' Region of the entire DC (page size) (in twips)
     chrg As CharRange ' Range of text to draw (see above declaration)
End Type

Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113


Public Sub Print_RTF(RTF As RichTextBox, LeftMarginWidth As Long, _
      TopMarginHeight, RightMarginWidth, BottomMarginHeight)
      Dim LeftOffset As Long, TopOffset As Long
      Dim LeftMargin As Long, TopMargin As Long
      Dim RightMargin As Long, BottomMargin As Long
      Dim fr As FormatRange
      Dim rcDrawTo As RECT
      Dim rcPage As RECT
      Dim TextLength As Long
      Dim NextCharPosition As Long
      Dim r As Long

      ' Start a print job to get a valid Printer.hDC
      Printer.Print Space(1)
      Printer.ScaleMode = vbTwips

      ' Get the offsett to the printable area on the page in twips
      LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
         PHYSICALOFFSETX), vbPixels, vbTwips)
      TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
         PHYSICALOFFSETY), vbPixels, vbTwips)

      ' Calculate the Left, Top, Right, and Bottom margins
      LeftMargin = LeftMarginWidth - LeftOffset
      TopMargin = TopMarginHeight - TopOffset
      RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
      BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset

      ' Set printable area rect
      rcPage.Left = 0
      rcPage.Top = 0
      rcPage.Right = Printer.ScaleWidth
      rcPage.Bottom = Printer.ScaleHeight

      ' Set rect in which to print (relative to printable area)
      rcDrawTo.Left = LeftMargin
      rcDrawTo.Top = TopMargin
      rcDrawTo.Right = RightMargin
      rcDrawTo.Bottom = BottomMargin

      ' Set up the print instructions
      fr.hdc = Printer.hdc   ' Use the same DC for measuring and rendering
      fr.hdcTarget = Printer.hdc  ' Point at printer hDC
      fr.rc = rcDrawTo            ' Indicate the area on page to draw to
      fr.rcPage = rcPage          ' Indicate entire size of page
      fr.chrg.cpMin = 0           ' Indicate start of text through
      fr.chrg.cpMax = -1          ' end of the text

      ' Get length of text in RTF
      TextLength = Len(RTF.Text)

      ' Loop printing each page until done
      Do
         ' Print the page by sending EM_FORMATRANGE message
         NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, fr)
         If NextCharPosition >= TextLength Then Exit Do  'If done then exit
         fr.chrg.cpMin = NextCharPosition ' Starting position for next page
         Printer.NewPage                  ' Move on to next page
         Printer.Print Space(1) ' Re-initialize hDC
         fr.hdc = Printer.hdc
         fr.hdcTarget = Printer.hdc
      Loop

      ' Commit the print job
      Printer.EndDoc

      ' Allow the RTF to free up memory
      r = SendMessage(RTF.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
End Sub

Public Sub PrintRTF()
    Dim realtext As String
    
    realtext = "{\rtf1\ansi\ansicpg1252\uc1 \deff0\deflang1043\deflangfe1043{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f6\fmodern\fcharset0\fprq1{\*\panose 00000000000000000000}Courier;}" & Chr(13) & Chr(10)
    realtext = realtext & "{\f11\fswiss\fcharset0\fprq2{\*\panose 00000000000000000000}MS Sans Serif;}{\f63\fswiss\fcharset0\fprq2{\*\panose 020b0706040902060204}Haettenschweiler;}{\f64\froman\fcharset238\fprq2 Times New Roman CE;}" & Chr(13) & Chr(10)
    realtext = realtext & "{\f65\froman\fcharset204\fprq2 Times New Roman Cyr;}{\f67\froman\fcharset161\fprq2 Times New Roman Greek;}{\f68\froman\fcharset162\fprq2 Times New Roman Tur;}{\f69\froman\fcharset177\fprq2 Times New Roman (Hebrew);}" & Chr(13) & Chr(10)
    realtext = realtext & "{\f70\froman\fcharset178\fprq2 Times New Roman (Arabic);}{\f71\froman\fcharset186\fprq2 Times New Roman Baltic;}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;" & Chr(13) & Chr(10)
    realtext = realtext & "\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{" & Chr(13) & Chr(10)
    realtext = realtext & "\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs24\lang1043\langfe1043\cgrid\langnp1043\langfenp1043 \snext0 Normal;}{\*\cs10 \additive Default Paragraph Font;}}{\info{\author Piet van Stralen}{\operator Piet van Stralen}" & Chr(13) & Chr(10)
    realtext = realtext & "{\creatim\yr2001\mo1\dy20\hr22\min28}{\revtim\yr2001\mo1\dy20\hr22\min29}{\version2}{\edmins1}{\nofpages1}{\nofwords5}{\nofchars30}{\nofcharsws36}{\vern8269}}" & Chr(13) & Chr(10)
    realtext = realtext & "\widowctrl\ftnbj\aenddoc\hyphhotz425\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\hyphcaps0\horzdoc\dghspace120\dgvspace120\dghorigin1701\dgvorigin1984\dghshow0\dgvshow3\jcompress\viewkind4\viewscale200\nolnhtadjtbl \fet0\sectd " & Chr(13) & Chr(10)
    realtext = realtext & "\linex0\headery708\footery708\colsx708\sectdefaultcl {\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl4" & Chr(13) & Chr(10)
    realtext = realtext & "\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}" & Chr(13) & Chr(10)
    realtext = realtext & "{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}\pard\plain \qr \li0\ri0\nowidctlpar\faauto\rin0\lin0\itap0 " & Chr(13) & Chr(10)
    realtext = realtext & "\fs24\lang1043\langfe1043\cgrid\langnp1043\langfenp1043 {\f63\lang1033\langfe1043\langnp1033 LCARS TERMINAL" & Chr(13) & Chr(10)
    realtext = realtext & "\par }\pard \ql \li0\ri0\nowidctlpar\faauto\rin0\lin0\itap0 {\pard\plain \ql \li0\ri0\nowidctlpar\faauto\rin0\lin0\itap0 \f11\fs17\lang1033\langfe1043\cgrid\langnp1033\langfenp1043 {\object\objemb\objw7847\objh15\objscalex999\objscaley73{\*\objclass PBrush}" & Chr(13) & Chr(10)
    realtext = realtext & "{\*\objdata 010500000200000007000000504272757368000000000000000000c0010000" & Chr(13) & Chr(10)
    realtext = realtext & "424db6010000000000003e00000028000000b80b000001000000010001000000000078010000230b0000230b0000020000000200000000000000ffffff0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001050000050000000d0000004d45544146494c4550494354000f360000e6fffffff801000008000f361a000000" & Chr(13) & Chr(10)
    realtext = realtext & "010009000003f80000000000e20000000000050000000b0200000000050000000c020100b80be2000000430f2000cc0000000100b80b000000000100b80b0000000028000000b80b000001000000010001000000000078010000ae540000060f0000020000000200000000000000ffffff00000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff030000000000}{\result {" & Chr(13) & Chr(10)
    realtext = realtext & "\f11\fs17\lang1033\langfe1043\langnp1033 {\*\shppict{\pict{\*\picprop\shplid1025{\sp{\sn shapeType}{\sv 75}}{\sp{\sn fFlipH}{\sv 0}}{\sp{\sn fFlipV}{\sv 0}}{\sp{\sn fLine}{\sv 0}}{\sp{\sn fLayoutInCell}{\sv 1}}}" & Chr(13) & Chr(10)
    realtext = realtext & "\picscalex999\picscaley73\piccropl0\piccropr0\piccropt0\piccropb0\picw13839\pich26\picwgoal7846\pichgoal15\pngblip\bliptag153538627{\*\blipuid 0926d043da51b47e33a0c6cb60cff0a6}" & Chr(13) & Chr(10)
    realtext = realtext & "89504e470d0a1a0a0000000d4948445200000bb800000001010000000066acde930000000467414d410000b18e7cfb51930000000970485973000054ae00000f060143ef4b250000000d4944415428cf6360180503010001780001a17e2c640000000049454e44ae426082}}{\nonshppict" & Chr(13) & Chr(10)
    realtext = realtext & "{\pict\picscalex999\picscaley54\piccropl0\piccropr0\piccropt0\piccropb0\picw13839\pich26\picwgoal7846\pichgoal15\wmetafile8\bliptag153538627\blipupi-310{\*\blipuid 0926d043da51b47e33a0c6cb60cff0a6}" & Chr(13) & Chr(10)
    realtext = realtext & "010009000003060100000000e200000000000400000003010800050000000b0200000000050000000c020100b80b05000000070104000000e2000000430f2000" & Chr(13) & Chr(10)
    realtext = realtext & "cc0000000100b80b000000000100b80b0000000028000000b80b000001000000010001000000000078010000ae540000060f0000020000000200000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "ffffff00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" & Chr(13) & Chr(10)
    realtext = realtext & "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005000000070101000000030000000000}}}}}}{\f11\fs17\lang1033\langfe1043\langnp1033 " & Chr(13) & Chr(10)
    realtext = realtext & "\par }{\f6\fs20\lang1033\langfe1043\langnp1033 " & Chr(13) & Chr(10)
    realtext = realtext & PrintLine
    realtext = realtext & "\par }}"
    
    frmMain.RichTextBox1.TextRTF = realtext
    
    Print_RTF frmMain.RichTextBox1, 1440, 1440, 1440, 1440  ' 1440 Twips = 1 Inch

End Sub



