Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm