Print RTF (Color)

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'Printing plain text is easy, but printing RTF content of a RichEdit control
'to get formatted output is harder.
 
'Primary Code:
'Credit: Michael Mattias
'For space reasons, the primary code is shown only once, in the Function below.
 
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add these lines:
#Include "CommCtrl.inc"
#Include "Comdlg32.inc"
 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "RichEdit.inc"
Global hDlg as Dword, hRichEdit as Dword, hInst as Dword
%ID_RichEdit = 500
 
Function PBMain() As Long
   Local style&, buf$
   buf$ =  "This is sample" + $CrLf + "text for the" + $CrLf + "edit control."
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   Dialog New Pixels, 0, "Test Code",300,300,200,150, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 30,10,140,20
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, buf$,20,40,160,100, style&, %WS_EX_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      hInst=GetModuleHandle(ByVal %NULL)
      PrintRichTextBox2 hDlg, hInst, hRichEdit, 1,1,1,1
   End If
End Function
 
   ' ===============================================================
   ' PrintRichTextBox2: MCM's improved version of PrintRichTextBox
   ' 01.24.04      Created from copy of annotated PrintRichTextBox (above)
   '               Purposes:
   '               a) End up with printing which does not have extra blank page each time
   '               b) meaningful return code (not decided, maybe number of pages printed?)
   '                  by converting to Function from SUB
   ' 11.04.08  Add some TRACE PRINT statements in the Print Loop
   ' for debugging
   ' 08.20.09  Add some more trace statements. Also, get ACTUAL length of text
   '           to be printed. WM_GETTEXTLENGTH returns value AT LEAST the length
   '           of the text, to be used for buffer allocation purposes. When you get
   '           an extra null at the end you end up with an extra blank page.
   ' ===============================================================
 
   ' 10.14.08 Hanging System using PB/CC 4.0 in RB 835
   ' look for Long/DWord thing as the includes may have changed.
   ' 11.04.08 FIXED. I had errors incrementing chrg.cpmin, and this routine does not allow
   ' for the inclusion of forced page advance.
 
Function PrintRichTextBox2 (  hWnd As Long, hInst As Long, rtfEdit As Long, LM AS SINGLE, _
      RM AS SINGLE, TM AS SINGLE, BM AS SINGLE ) As Long
   '
   '  Purpose:
   '           Prints the contents of an RTF text box given it's handle, the
   '           calling program's handle(s), and the page margins.
   '
   '  Parameters:
   '           hWnd     = Parent window (used for print common dlg)
   '           hInst    = Instance of calling program
   '           rtfEdit  = Handle of rich edit control
   '           LM       = Left Margin in inches
   '           RM       = Right Margin in inches
   '           TM       = Top Margin in inches
   '           BM       = Bottom Margin in inches
 
   Dim fr AS FORMATRANGE
   Dim rDocInfo AS DOCINFO
   Dim iTextOut As Long
   Dim iTextAmt As Long
   Dim pd AS PRINTDLGAPI
   Dim zString As AsciiZ * 200
   Dim iWidthTwips&
   Dim iHeightTwips&
 
   '- Setup the print common dialog
   pd.lStructSize              = SizeOf(pd)
   pd.hwndOwner                = hWnd
   pd.hDevMode                 = %NULL
   pd.hDevNames                = %NULL
   pd.nFromPage                = 0
   pd.nToPage                  = 0
   pd.nMinPage                 = 0
   pd.nMaxPage                 = 0
   pd.nCopies                  = 0
   pd.hInstance                = hInst
   pd.Flags                    = (%PD_RETURNDC Or %PD_NOPAGENUMS Or %PD_PRINTSETUP)
   pd.lpfnSetupHook            = %NULL
   pd.lpPrintSetupTemplateName = %NULL
   pd.lpfnPrintHook            = %NULL
   pd.lpPrintTemplateName      = %NULL
 
   Local pageNO      As Long
   ' add 8/20/09:
   Local sBUffer AS String, lBUff As Long
 
   Pageno            =   0&    ' initialize
 
   Trace Print "Begin PrintRichTextBox2"
   '----------------------------------------------------------------------------
   ' call the PrintDlg common dialog to get printer name and a hDC for printer
   ' ---------------------------------------------------------------------------
   If PrintDlg(pd) Then
 
      SetCursor LoadCursor( %NULL, ByVal %IDC_WAIT )
 
      '- Fill format range structure
      '
      '  NOTE:
      '     This gave me fits. I was looking at the book from
      '     Microsoft Press called Programming the Windows 95
      '     Iterface. It said (via example) that the
      '     Rectagle was defined in Pixels. This didn't work right.
      '     The SDK, however, said the measurements needed to be
      '     in Twips! This seems to work fine.
      '
      '
      fr.hdc           = pd.hDC
      fr.hdcTarget     = pd.hDC
      fr.chrg.cpMin    =  0
      fr.chrg.cpMax    = -1&
 
      fr.rc.nTop       = TM * 1440
      fr.rcPage.nTop   = fr.rc.nTop
 
      fr.rc.nLeft     = LM * 1440
      fr.rcPage.nLeft = fr.rc.nLeft
 
      '- Get page dimensions in Twips
      iWidthTwips&   = Int((GetDeviceCaps(pd.hDC, %HORZRES) / GetDeviceCaps(pd.hDC, %LOGPIXELSX)) * 1440)
      iHeightTwips&  = Int((GetDeviceCaps(pd.hDC, %VERTRES) / GetDeviceCaps(pd.hDC, %LOGPIXELSY)) * 1440)
 
      fr.rc.nRight         = iWidthTwips& - RM * 1440
      fr.rcPage.nRight     = fr.rc.nRight
 
      fr.rc.nBottom        = iHeightTwips& - BM * 1440
      fr.rcPage.nBottom    = fr.rc.nBottom
 
      '- Fill rDocInfo structure
      rDocInfo.cbSize              = Len(rDocInfo)
      zString                      = "RTF Printer"
      rDocInfo.lpszDocName         = VarPTR(zString)
      rDocInfo.lpszOutput          = %NULL
 
      '- Here we go
 
      ' We actually do not need to do a startdoc unless we are on page one..
 
      StartDoc   pd.hDC, rDocInfo
 
      ' ==== MCM update here]
      ' we are not going to startpage until we know there is something to print on this page
      ' StartPage  pd.hDC
 
      '- This does the printing. We send messages  to the edit box telling it to format it
      '  text to fit the Printer's DC.
 
      iTextOut = 0
      iTextAmt = SendMessage(rtfEdit, %WM_GETTEXTLENGTH, 0, 0)   ' TOTAL LENGTH OF TEXT TO BE FORMATTED AND PRINTED
 
      ' 8/20/09  Do I really want to format iTextAmt MINUS ONE?
      'WM_GETTEXTLENGTH returns a number AT LEAST as large as the text...
      ' for buffer allocation purposes.
      ' doc says "
      ' "  To obtain the exact length of the text, use the WM_GETTEXT, LB_GETTEXT, or CB_GETLBTEXT messages, or the GetWindowText function."
 
      sBuffer = String$ ( iTextAmt, $NUL)
      GetWindowText   RtfEdit, ByVal StrPTR(sBuffer), iTextAmt
      lBuff = lStrLen (ByVal StrPTR(sBuffer))  ' get lenght not including any trailing nulls
 
      Trace Print Using$("Length of text not including any trailing nulls #", lBUff)
 
      iTextAmt = lBuff   ' the max amount of text we want to format
 
      'set end index of charrange to max index; we  want to always format "as much as will fit on a page"
 
      fr.chrg.cpmax =  iTextAmt -1
      fr.chrg.cpmax =  iTextAmt        ' try this 8/20/09
 
      Local iResponse As Long    ' test  usage onlye
      Local iTextDone As Long    ' index of last character printed...
      Local iLastRendered AS   Long
 
      Local iLastCharDone   As Long
      iTextDone             = 0   ' not yet, anyway
 
      ' -------------------
      ' 11/04/08 I am never setting either iTExtDone OR itextamt!
      ' Itextamt = Total amount to print, which I get above
      ' OK, that was my problem, but now it is skipping printing in the middle
      ' I think I have an old or corrupt routine here.
      ' ------------------------------------------------------------------------
 
      Trace Print  "ENTER LOOP, ITextAmt=" & Format$(iTExtAmt)
 
      Do While iTextDone < iTextAmt
         ' =========================================================================================
         ' emformatrage returns
         ' "This message returns the index of the last character that fits in the region, plus one."
         ' =========================================================================================
 
         ' MSGBOX "send em_formatrange, measure only with fr.Chrg.cpmin, fr.chrg.cpmax=" & STR$(fr.chrg.cpmin) & STR$(fr.chrg.cpmax)
         ' itext out will never return more than than can fit on a page!
 
         ' send EM_FORMATRANGE with wparam = 0 to measure
 
         Trace Print " Top of loop Itex Done = " &  Format$(iTextDone) & " itextAmt=" & Format$(iTextAmt)
         Trace Print " Top of loop fr.chrg.cpmin=" & Format$(fr.chrg.cpmin)
         Trace Print " Top of loop fr.chrg.cpmax=" & Format$(fr.chrg.cpmax)
 
         iTextOut = SendMessage(rtfEdit, %EM_FORMATRANGE, 0&, VarPTR(fr))
 
         Trace Print " Send EM_FORMATRANGE returns itext out=" & Format$(iTextOut)
         '  11/4/08 THis should be the amount of text which can be formatted onto the current page.
 
         ' NOTE 12/28/03: MDSN says EM_FORMATRANG returns:
         ' "This message returns the index of the last character that fits in the region, plus one"
         ' Not quite true, if it resturns less than cpmin, there is no text to print.
         ' (Like the trailer formatting text in a RTF document).
 
         ' is this iText is beyond the end  (should never happen)
         ' or less than cpmin (true on last page), there is no text to format and we are done
         If iTextOut > fr.chrg.cpmax Then
            '    MSGBOX "ITextOut > cpmax, exit print loop"
            Trace Print "ITextOut > cpmax, exit print loop"
            Exit Do
         ElseIf iTExtOut < fr.chrg.cpmin Then               ' no  renderable  text left to do..
            '    MSGBOX "itextout < cpmin, exit print loop"     '
            Trace Print "itextout < cpmin, exit print loop"
            Exit Do
         End If
 
         ' TEST CODE to AvOID GETTING STUCK IN ENDLESS LOOPS
         ' iResponse  = MSGBOX ("EM-FORMATRANGE Returns itextOut=" _
         '              & STR$(iTextOut) & $CRLF & _
         '              "iTextAmt=" & STR$(iTextAmt) _
         '              & "fr.Chrg.cpmin, fr.chrg.cpmax=" & STR$(fr.chrg.cpmin) & STR$(fr.chrg.cpmax) _
         '              , %MB_OKCANCEL,"Debug - Measure only")
         ' IF iResponse <> %IDOK THEN
         '     EXIT DO
         ' END IF
         ' for PB/CC I could use something different here
 
         ' if we get here, we can start a page, print it and end it
 
         Trace Print "Starting page here"
 
         StartPage             pd.hDC         ' start a page
         ' render it:
         iLastRendered      =  SendMessage(rtfEdit, %EM_FORMATRANGE, 1&, VarPTR(fr))
         ' incrment the number of pages printed and end the page
         Incr PageNo
 
         Trace Print "ending page here"
         Endpage               pd.hdc
         ' reset the start point of FORMATRANGE structure for next page
         ' I THINK THIS IS WRONG fr.chrg.cpmin    = itextOut   ' leave max alone, try to format ALL remaining text..
 
         fr.chrg.cpmin  = fr.chrg.cpmin + itextOut   ' leave max alone, try to format ALL remaining text..
         ' 11/4/08 I think this should be what was plus what we just printed
         ' nope that's not correct.
         ' -0-------------------
 
         ' 11.04.08  I NEVER SET iTExtDone up by the amount rendered here!
         iTextDone = iTextDone + iTextOut   ' add 11/4/08
         Trace Print Using$ ("bottom of loop with iTextDone #", iTextDone)
 
      Loop
 
      Trace Print "EXIT PRINT FORMAT/RENDER LOOP "
 
      ' Clean up the Richedit control:
      SendMessage rtfEdit, %EM_FORMATRANGE, 1, %NULL  ' << MDSN says send this msg w/lparam=%NULL when
      ' done with the device
 
      '- Finish the printing.
      EndDoc pd.hDC
      DeleteDC pd.hDC
      SetCursor LoadCursor( %NULL, ByVal %IDC_ARROW )
   Else
      ' MsgBox "Canceled !" (in PRintDlg)
   End If
   ' set return value = # pages printed
   Function = PageNo
End Function
 
'gbs_00307
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm