Announcement

Collapse
No announcement yet.

Printing Rich Edit Content

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Michael Mattias
    replied
    I showed you mine, so why don't you show us yours?

    (The TRACE file. What did you think I meant?)

    MCM

    Leave a comment:


  • Gary Beene
    replied
    Hi Michael!

    Thanks for the new version.

    But I'm getting funny results when I put the routine into the same code as before (below).

    When I select either of my two printers, nothing is printed.

    But when I print to Fine Print (print preview tool), the outputs shows and can then be printed to either of the two printers - but it comes out with NO color formatting.

    I don't know all that means. I'll have to think on it.


    Code:
    'Compilable Example:
    #Compile Exe
    #Dim All
    #Include "Win32API.inc"
    #Include "RichEdit.inc"
    #Include "CommCtrl.inc"
    #Include "Comdlg32.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 statments. 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 cgrg.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

    Leave a comment:


  • Michael Mattias
    replied
    Found the problem with the extra page and fixed.

    MCM
    Code:
    ' ===============================================================
    ' 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 statments. 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 cgrg.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

    Leave a comment:


  • Michael Mattias
    replied
    FWIW, I find all those additional entries to DlgProc() following the call to the print routine but before the print routine is entered interesting... along with the fact those entries have no parameters (when I'd expect hWnd, uMsg, wParam, lparam).

    I guess there's more to "DDT" than meets the eye, huh?

    [LATER]
    Oops, I'm out of sequence there, aren't I?

    Those calls must be getting made when the Common Dialog "PrintDlg" is called. The message loop created by same is servicing the notifications to the owner window regarding the child dialog activities. Very interesting.... I kind of knew it did that, but I never really saw it demonstrated so vividly before.
    Last edited by Michael Mattias; 19 Aug 2009, 08:45 AM.

    Leave a comment:


  • Michael Mattias
    replied
    Just for the heck of it I enabled the trace thus:

    Code:
    ' test_richeditprint.bas
    'Compilable Example:
    'Credit: Michael Mattias/Don Dickinson
    'http://www.powerbasic.com/support/pbforums/showthread.php?t=28400
    #COMPILE EXE
    #DIM ALL
    
    #TOOLS ON
    #INCLUDE "Win32API.inc"
    #INCLUDE "RichEdit.inc"
    #INCLUDE "CommCtrl.inc"
    #INCLUDE "Comdlg32.inc"
    
    #INCLUDE "RTFFUNCT.BAS"    ' <<< FILE CONTAINING THE UPDATED PRINT FUNCTION
    
    GLOBAL hDlg AS DWORD, hRichEdit AS DWORD, hInst AS DWORD
    %ID_RichEdit = 500
    FUNCTION PBMAIN() AS LONG
        
        TRACE NEW "Trace_richeditPrint.TXT"
        
        
        
       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
           TRACE ON
           TRACE PRINT "Begin Print Trace"
            hInst=GetModuleHandle(BYVAL %NULL)
            PrintRichTextBox2 hDlg, hInst, hRichEdit, 0.5, 0.5, 0.5, 0.5
           TRACE PRINT "End Print Trace"
           TRACE OFF
           TRACE CLOSE
       END IF
       
       
    END FUNCTION
    ... and got this:
    Code:
    Trace Begins...
    Begin Print Trace
     PRINTRICHTEXTBOX2(264282,4194304,198738,.5,.5,.5,.5)
     Begin PrintRichTextBox2
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
      DLGPROC()
      DLGPROC Exit
     ENTER LOOP, ITextAmt=43
      Top of loop Itex Done = 0
      Top of loop fr.chrg.cpmin=0
      Top of loop fr.chrg.cpmax=42
      Send EM_FORMATRANGE returns itext out=42
     Starting page here
     ending page here
      Top of loop Itex Done = 42
      Top of loop fr.chrg.cpmin=42
      Top of loop fr.chrg.cpmax=42
      Send EM_FORMATRANGE returns itext out=42
     Starting page here
     ending page here
     EXIT PRINT FORMAT/RENDER LOOP 
     PRINTRICHTEXTBOX2 Exit
    End Print Trace
    Maybe you can soup up the trace on your system and it will tell you more.

    MCM

    Leave a comment:


  • Michael Mattias
    replied
    Well, on my system this AM, your program using the new "Print" function posted above prints one blank page followed by a page containing the text noted, then ends printing and waits for me to do it again.

    It should not print that extra blank page at the start, so I guess this function goes on the "fix me" list.

    Used: PB/Win 9.0.1, Windows XP/Pro SP3 all updates, HP Deskjet D4200.

    MCM
    Last edited by Michael Mattias; 19 Aug 2009, 08:06 AM.

    Leave a comment:


  • Gary Beene
    replied
    Jules,
    I was working on military electronics at the time, but the tool applied to multi-chip modules for both commercial and military applications.

    Leave a comment:


  • Jules Marchildon
    replied
    Gary,...that tool is interesting, thanks for sharing!
    Was that Military related?
    Regards,
    Jules

    Leave a comment:


  • Gary Beene
    replied
    MCM,

    TOTALLY OFF-TOPIC, MCM in my working career meant Multi-Chip Modules - a method of miniaturizing electronic assemblies.

    At this page:

    http://www.garybeene.com/mcm/cad.htm

    is an online tool I wrote for evaluating MCM design concepts. You can define a parts list, final form factor and a few other design decisions - and the page returns a rotatable 3D image of the product.

    Leave a comment:


  • Gary Beene
    replied
    MCM,

    Thanks for the update, but still no output. But, at least the new version did not lock up.

    I haven't looked at yours or Dickinson's enough to suggest why I'm having trouble. I'll play with it some more.

    Leave a comment:


  • Michael Mattias
    replied
    Try some of these changes.... (no promises)
    Code:
    ' 08/28/03 the PRINT GPFs.. suspect DECLARE problem somewhere.
    ' 01/21/04 this version still has debug MSGBOXs and prints an extra page at end.
    ' BUT.. it has the notes on how to fix it... the problem requires we do not do
    ' a StartPage until we know there is text to print. Requires some work.
    ' 04.05.07  01.24.04 note re PrintRichTextBox2 does not have extra page at end
    ' 04.05.07  Want to use with PB 8 need to change pointer params in headers to use EXPLICIT 'BYVAL'
    ' 10.14/08  Changed MSGBOX to "?" so can use with PB/CC as well as PB/WIN compilers.
    ' 11/04/08  Add some TRACE PRINT statements to figure out what is going wrong
    '           with PrintRichTextBox2 function... it's hanging like it was before I
    '           fixed PrintRichRtextBox in 2007
    ' 11.04.08 FIXED. I had errors incrementing chrg.cpmin, and this routine does not allow
    ' for the inclusion of forced page advances which was messing up everything.
    ' I'd also suggest avoiding richtext created by Microsoft word, instead use richtext
    ' created by Lotus or (what I used for Zirmed rebatcher), Microsoft "WordPad"
    ' I suppose some day I will could add page numbers and /or headers/footers to the print routine.
    '......
    
    ' ===============================================================
    ' 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
    ' ===============================================================
    
    ' 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 cgrg.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
    
       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
    
          ' 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
    
          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)
             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
    
          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

    Leave a comment:


  • Mike Doty
    replied
    The code above prints endless pages on my printer and had to be
    terminated using task manager. Tried Don's original RTFPRINT, which
    had to be modified for new compiler and it doesn't print the graphics.

    Leave a comment:


  • Gary Beene
    started a topic Printing Rich Edit Content

    Printing Rich Edit Content

    I took Michael's update to Dickinson's code and wrapped it in a rich edit example - but running print gives no output. In fact, the program freezes up. I select the printer, press go, and that's all that happens.

    Michael, have I mis-used the code, or do you have an updated version? And BTW, I tried Dickinson's version and it worked, but the extra printed page was a bummer (although it didn't always appear - I don't know why).

    Does anyone else have code for printing content of a rich edit control? Michael's code was '06 vintage and I've not found anything posted since then.

    The code handles embedded $tab characters, which is a key reason I'm interested in it, plus eliminating the blank page that Michael fixed.

    Here's my example, with Michael's code included.

    Code:
    'Compilable Example:
    'Credit: Michael Mattias/Don Dickinson
    'http://www.powerbasic.com/support/pbforums/showthread.php?t=28400
    #Compile Exe
    #Dim All
    #Include "Win32API.inc"
    #Include "RichEdit.inc"
    #Include "CommCtrl.inc"
    #Include "Comdlg32.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, 0.5, 0.5, 0.5, 0.5
       End If
    End Function
              
    ' ===============================================================
    ' PrintRichTextBox2: MCM's improved version of PrintRichTextBox
    ' 01.24.04      Created from copy of annotated PrintRichTextBox (above)
    '               Above is Don Dickinson's original (Public domain) Rich Text Control printer
    '               Purposes:
    '               a) End up with printing which does not have extra blank page each time
    '               b) meaningful return code from FUNCTION = number of pages printed
    '                  instead of calling as a SUB
    ' 05/03/06      Clean up comments to make suitable for posting
    ' ===============================================================
    ' MCM NOTE 5/3/06: These includes may vary, since I am sure later versions of the
    ' PowerBASIC-supplied Windows Headers files moved some of this stuff around.
    ' But I know you MUST have Win32API.INC and COMDLG32.INC.
    ' REquired #INCLUDES:
    '  #INCLUDE "WIN32API.INC"
    '  #INCLUDE "COMDLG32.INC"
    '  #INCLUDE "RICHEDIT.INC"
    
    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 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              = Len(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
    
       Pageno            =   0&    ' initialize
       '----------------------------------------------------------------------------
       ' 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
          '
          '  Don's 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
    
            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
    
          ' 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
    
          Local iTextDone As Long    ' index of last character printed...
          Local iLastRendered As   Long
    
          Local iLastCharDone   As Long
          iTextDone             = 0   ' not yet, anyway
    
          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
    
             iTextOut = SendMessage(rtfEdit, %EM_FORMATRANGE, 0&, VarPtr(fr))
    
             ' MCM NOTE 12/28/03: MDSN says EM_FORMATRANGE 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"
                 Exit Do
             ElseIf iTExtOut < fr.chrg.cpmin Then               ' no  renderable  text left to do..
             '    MSGBOX "itextout < cpmin, exit print loop"     '
                 Exit Do
             End If
             ' -----------------------------------------------------------
             ' if we get here, we can start a page, print it and end it
             ' -----------------------------------------------------------
             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
             Endpage               pd.hdc
             ' reset the start point of FORMATRANGE structure for next page
             fr.chrg.cpmin    = itextOut   ' leave max alone, try to format ALL remaining text..
          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
    Last edited by Gary Beene; 18 Aug 2009, 08:50 AM.
Working...
X