Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Rich Edit Print and Print Preview

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

  • PBWin Rich Edit Print and Print Preview

    Here is an example of including print and print preview for a rich edit control.
    Printing text and rich text can be done for the whole document, individual pages,
    or selected text. This demo works on my two development machines, one a laptop
    running XP and connected directly to an HP4L printer, the other a deskttop running
    Windows 98 and connected to the same printer by ethernet. I'm hopeful that it will
    run ok on other systems, so any feedback would be much appreciated.

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "Win32api.inc"
    #INCLUDE "ComDlg32.inc"
    #INCLUDE "RichEdit.inc"
    '#INCLUDE "debug.inc"
    
    %IDC_Text     = 100
    %IDC_TextSel  = 101
    %IDC_Fwd      = 121
    %IDC_Bwd      = 122
    %IDC_FastFwd  = 123
    %IDC_FastBwd  = 124
    %IDC_PageNo   = 125
    %IDC_NumPages = 126
    %IDC_Zoom     = 127
    %IDC_Print    = 128
    %IDC_VScroll  = 129
    %IDC_HScroll  = 130
    %IDM_New      = 201
    %IDM_Open     = 202
    %IDM_Save     = 203
    %IDM_SaveAs   = 204
    %IDM_Preview  = 205
    %IDM_Print    = 206
    %IDM_Exit     = 207
    GLOBAL hDlg, hEdit, hEditSel, fileFmt, gOrigEditProc AS DWORD
    GLOBAL leftMargin, rightMargin, topMargin, bottomMargin AS SINGLE
    GLOBAL thisFile AS STRING
    GLOBAL pageEnd() AS LONG
    DECLARE FUNCTION getRichEditText(BYVAL DWORD) AS STRING
    DECLARE FUNCTION putRichEditText(BYVAL DWORD, BYVAL STRING) AS LONG
    DECLARE FUNCTION choosePrinter(OPT PRINTDLGAPI) AS STRING
    DECLARE FUNCTION getFontName() AS STRING
    DECLARE FUNCTION getFontSize() AS LONG
    DECLARE FUNCTION getNumPages(LONG, LONG, LONG) AS LONG
    DECLARE FUNCTION printRTF(LONG, LONG, LONG, LONG) AS LONG
    DECLARE FUNCTION MakeFont(BYVAL STRING, BYVAL LONG) AS DWORD
    DECLARE FUNCTION WriteClipBoard(sBuffer AS STRING) AS LONG
    DECLARE FUNCTION ReadClipBoard() AS STRING
    DECLARE SUB addMenubar()
    DECLARE SUB openTheFile()
    DECLARE SUB saveTheFile()
    DECLARE SUB saveAsFile()
    DECLARE SUB printPreview()
    DECLARE SUB printFile()
    
    FUNCTION PBMAIN()
       LOCAL hLib, nStyle AS LONG, s AS STRING
       hLib = LoadLibrary("RICHED20.DLL") 
       IF hLib = 0 THEN
          s = "File 'Riched20.dll' required"
          MSGBOX s, %MB_ICONWARNING, "File not Fount": EXIT FUNCTION
       END IF 
       DIALOG NEW PIXELS, 0, "Print Preview", , , 500, 500, %WS_SYSMENU OR %WS_THICKFRAME _
                OR %WS_MINIMIZEBOX OR %WS_CAPTION OR %WS_CLIPSIBLINGS TO hDlg
       nStyle = %WS_CHILD  OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %ES_MULTILINE OR _
                %WS_VSCROLL OR %ES_AUTOVSCROLL OR %ES_WANTRETURN OR %ES_NOHIDESEL
       CONTROL ADD "RichEdit20A", hDlg, %IDC_Text, "", 0, 0, 500, 460, nStyle
       CONTROL ADD "RichEdit20A", hDlg, %IDC_TextSel, "", 0, 0, 500, 460, nStyle
       DIALOG SHOW MODAL hDlg CALL DialogProc
       FreeLibrary hLib
    END FUNCTION
    
    CALLBACK FUNCTION dialogProc()
       LOCAL wi, ht, hdc, flags, hFont, n AS LONG
       LOCAL f, filter AS STRING
       SELECT CASE CBMSG
          CASE %WM_INITDIALOG
             fileFmt = %SF_TEXT 
             CONTROL HANDLE CBHNDL, %IDC_TextSel TO hEditSel
             CONTROL SHOW STATE CBHNDL, %IDC_TextSel, %SW_HIDE
             CONTROL HANDLE CBHNDL, %IDC_Text TO hEdit 
             gOrigEditProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(subClassEditProc))
             SendMessage hEdit, %EM_LIMITTEXT, 1000000, 0  'allow 1 meg files
             addMenubar
             DIM pageEnd(100): pageEnd(0) = -1
    
             '------------------------------------------------------------------
             ' setup editor window size
             '------------------------------------------------------------------
             hdc = GetDC(CBHNDL)
             ht = GetDeviceCaps(hdc, %VERTRES)
             ht = MAX(440, .80 * ht): wi = ht
             DIALOG SET SIZE CBHNDL, wi, ht
             DIALOG SET LOC CBHNDL, 100, 20
    
             '------------------------------------------------------------------
             ' initialize printer margins and set default font
             '------------------------------------------------------------------
             leftMargin   = 0.750
             rightMargin  = 0.500
             topMargin    = 0.500
             bottomMargin = 0.500
             
             f = "Times New Roman": n = 12
             f = "Courier New": n = 10
             hFont = MakeFont(f, n)
             SendMessage hEdit, %WM_SETFONT, hFont, 0
             SendMessage hEditSel, %WM_SETFONT, hFont, 0
             
          CASE %WM_SIZE
             DIALOG GET CLIENT CBHNDL TO wi, ht
             CONTROL SET SIZE CBHNDL, %IDC_Text, wi, ht - 20
          CASE %WM_COMMAND
             SELECT CASE CBCTL
                CASE %IDM_New
                   hFont = MakeFont("Courier New", 10)
                   SendMessage hEdit, %WM_SETFONT, hFont, 0
                   thisFile = "": fileFmt = %SF_TEXT: putRichEditText hEdit, ""
                CASE %IDM_Open
                   putRichEditText hEdit, ""
                   filter = "Text Files (*.txt, *.ini, *.dat)|*.txt; *.ini; *.dat|" + _
                            "Source Files (*.bas, *.inc)|*.bas; *.inc|" + _  
                            "Rich Text Files (*.rtf)|*.rtf|" + _
                            "All Files (*.*)|*.*"
                   flags = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR _
                           %OFN_LONGNAMES OR %OFN_EXPLORER
                   OpenFileDialog hDlg, "Open File", f, "", filter, "", flags
                   IF LEN(f) THEN thisFile = f: openTheFile
                CASE %IDM_Save
                   saveTheFile
                CASE %IDM_SaveAs
                   saveAsFile  
                CASE %IDM_Preview
                   printPreview
                CASE %IDM_Print
                   printFile
                CASE %IDM_Exit
                   DIALOG SEND CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0 
          END SELECT
       END SELECT   
    END FUNCTION
    
    FUNCTION subClassEditProc(BYVAL hWnd&, BYVAL wMsg&, BYVAL wParm&, BYVAL lParm&) AS LONG
       LOCAL lRet AS LONG
       SELECT CASE wMsg&
          CASE %WM_GETDLGCODE
             IF ISFALSE lParm& THEN 'not a message being sent to the control  
               ' Ensure that the edit control does not select its contents on receiving the focus
               lRet = CallWindowProc(gOrigEditProc, hWnd&, wMsg&, wParm&, lParm&)
               FUNCTION = lRet XOR %DLGC_HASSETSEL 'Clear the DLGC_HASSETSEL bit from lRet
               EXIT FUNCTION
             END IF
       END SELECT
       ' Pass the message on to the original window procedure... the DDT engine!
       FUNCTION = CallWindowProc(gOrigEditProc, hWnd&, wMsg&, wParm&, lParm&)
    END FUNCTION
    
    SUB addMenubar()
       LOCAL hMenu, hFileMenu AS LONG
       MENU NEW BAR TO hMenu
       MENU NEW POPUP TO hFileMenu
       MENU ADD STRING, hFileMenu, "&New", %IDM_New, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "&Open", %IDM_Open, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "&Save", %IDM_Save, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "&SaveAs", %IDM_SaveAs, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "-", 0, 0
       MENU ADD STRING, hFileMenu, "Print Pre&view", %IDM_Preview, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "&Print", %IDM_Print, %MF_ENABLED
       MENU ADD STRING, hFileMenu, "E&xit", %IDM_Exit, %MF_ENABLED
       MENU ADD POPUP, hMenu, "File", hFileMenu, %MF_ENABLED
       MENU ATTACH hMenu, hDlg
    END SUB
    
    FUNCTION getRichEditText(BYVAL hEd AS DWORD) AS STRING
       LOCAL sBuffer AS STRING, es AS EDITSTREAM
       es.dwCookie = VARPTR(sBuffer)
       es.pfnCallback = CODEPTR(getRichEditTextCB)
       IF fileFmt = 0 THEN fileFmt = %SF_TEXT 
       SendMessage(hEd, %EM_STREAMOUT, fileFmt, VARPTR(es))
       FUNCTION = sBuffer
    END FUNCTION
    
    FUNCTION getRichEditTextCB(BYVAL dwCookie AS DWORD, BYVAL pRichEd AS BYTE PTR, _
                             BYVAL cb AS LONG, BYREF pcb AS LONG) AS LONG
       LOCAL psBuffer AS STRING PTR
       psBuffer = dwCookie
       IF cb < 1 THEN EXIT FUNCTION
       @psBuffer = @psBuffer & PEEK$(pRichEd, cb)
       pcb = cb
    END FUNCTION
    
    FUNCTION putRichEditText(BYVAL hEd AS DWORD, BYVAL sBuffer AS STRING) AS LONG
       '-------------------------------------------------------------------------------
       'let rich edit call the callback function repeatedly, reading in 4K chunks of
       'data at a time until there is no more to read. (fileFmt = %SF_TEXT or %SF_RTF)
       '-------------------------------------------------------------------------------
       LOCAL ES AS EDITSTREAM
       es.dwCookie = VARPTR(sBuffer)
       es.pfnCallback = CODEPTR(putRichEditTextCB)
       FUNCTION = SendMessage(hEd, %EM_STREAMIN, fileFmt, VARPTR(es))
    END FUNCTION
    
    FUNCTION putRichEditTextCB(BYVAL dwCookie AS DWORD, BYVAL pRichEd AS BYTE PTR, _
                               BYVAL cb AS LONG, BYREF pcb AS LONG) AS LONG
        'dwCookie is used to pass ptr to string buffer that holds the data to load.                  
        'pRichEd is the ptr to the rich edit control buffer that receives the data.
        'cb = bytes to read in chunks (4K) defined by the OS
        'pcb = bytes actually needed to be read (last chunk less than 4K)
        '-------------------------------------------------------------------------                  
        LOCAL psBuffer AS STRING PTR
        psBuffer = dwCookie
        pcb = MIN(LEN(@psBuffer), cb)
        IF pcb > 0 THEN
            POKE$ pRichEd, LEFT$(@psBuffer, pcb)
            @psBuffer = MID$(@psBuffer, pcb + 1)
        END IF
    END FUNCTION
    
    FUNCTION MakeFont(BYVAL FontName AS STRING, BYVAL PointSize AS LONG) AS DWORD
       '--------------------------------------------------------------------
       ' Create a desired font and return its handle.
       '--------------------------------------------------------------------
       LOCAL hDC AS DWORD, CharSet AS LONG, CyPixels AS LONG
       
       hDC = GetDC(%HWND_DESKTOP)
       CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
       ReleaseDC %HWND_DESKTOP, hDC
       PointSize = 0 - (PointSize * CyPixels) \ 72
       FUNCTION = CreateFont(PointSize, 0, 0, 0, 0, 0, 0, _
                 %FALSE, CharSet, %OUT_TT_PRECIS, _
                 %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
                 %FF_DONTCARE , BYCOPY FontName)
    END FUNCTION
    
    SUB openTheFile()
       LOCAL fileNo, hFont AS DWORD
       LOCAL sBuffer AS STRING
       fileNo = FREEFILE
       OPEN thisFile FOR BINARY ACCESS READ LOCK SHARED AS #fileNo
       IF ERR THEN 
          MSGBOX "File could not be opened",, "File Error " + STR$(ERR): EXIT SUB
       END IF
       hFont = MakeFont("Courier New", 10)
       SendMessage hEdit, %WM_SETFONT, hFont, 0
       sBuffer = STRING$(LOF(fileNo), 0)
       GET #fileNo,, sBuffer  'load file into string buffer
       CLOSE #fileNo
       fileFmt = %SF_TEXT
       IF UCASE$(RIGHT$(thisFile, 3)) = "RTF" THEN fileFmt = %SF_RTF   
       putRichEditText hEdit, sBuffer
    END SUB
    
    SUB saveTheFile()
       LOCAL txt AS STRING, fileNo AS LONG
       IF LEN(thisFile) THEN
          KILL thisFile
          fileFmt = %SF_TEXT
          IF UCASE$(RIGHT$(thisFile, 3)) = "RTF" THEN fileFmt = %SF_RTF
          txt = getRichEditText(hEdit): IF LEN(txt) = 0 THEN EXIT SUB
          fileNo = FREEFILE
          OPEN thisFile FOR BINARY ACCESS WRITE AS fileNo
          PUT #fileNo,, txt
          CLOSE fileNo
          SendMessage hEdit, %EM_SETMODIFY, 0, 0
       ELSE
          saveAsFile
       END IF
    END SUB
    
    SUB saveAsFile()
       LOCAL f, path, filter AS STRING, flags, n AS DWORD
       path = CURDIR$: f = thisFile
       filter = "Text Files (*.txt, *.ini, *.dat)|*.txt; *.ini; *.dat|" + _
                "Source Files (*.bas, *.inc)|*.bas; *.inc|" + _  
                "Rich Text Files (*.rtf)|*.rtf|"
       flags = %OFN_OVERWRITEPROMPT OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       n = SaveFileDialog(hDlg, "Save File", f, path, filter, "txt", flags)
       IF n = 0 OR LEN(f) = 0 THEN EXIT SUB
       thisFile = f: saveTheFile
    END SUB
    
    '-----------------------------------------------------------------------
    'Print and Print preview routines
    '-----------------------------------------------------------------------
    SUB printPreview()
       LOCAL hPreviewDlg AS LONG
       DIALOG NEW PIXELS, 0, "Print Preview", , , 500, 500, %WS_SYSMENU TO hPreviewDlg
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_Fwd, ">", 10, 5, 30, 20
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_Bwd, "<", 40, 5, 30, 20
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_FastFwd, ">>", 70, 5, 30, 20
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_FastBwd, "<<", 100, 5, 30, 20
       CONTROL ADD LABEL, hPreviewDlg, -1, "Page No:", 150, 7, 48, 15             
       CONTROL ADD TEXTBOX, hPreviewDlg, %IDC_PageNo, " 0", 200, 5, 25, 20, %ES_NUMBER
       CONTROL ADD LABEL, hPreviewDlg, %IDC_NumPages, "", 230, 7, 70, 15
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_Zoom, "&Zoom", 350, 5, 50, 20                
       CONTROL ADD BUTTON, hPreviewDlg, %IDC_Print, "&Print", 405, 5, 50, 20
       CONTROL ADD SCROLLBAR, hPreviewDlg, %IDC_VScroll, "", 500, 30, 18, 540
       CONTROL ADD SCROLLBAR, hPreviewDlg, %IDC_HScroll, "", 0, 570, 500, 20
       DIALOG SHOW MODAL hPreviewDlg CALL previewDlgProc
    END SUB
    
    CALLBACK FUNCTION previewDlgProc()
       LOCAL hdc AS DWORD, xppi, yppi, hPrnDC AS LONG
       LOCAL ps AS PAINTSTRUCT, s AS STRING, wi, ht AS SINGLE
       STATIC nWi, nHt, nx, ny, xp, yp, x, y, kx, ky, hBmp AS LONG
       STATIC page, numPages, dPages, lastPage, hVScroll, hHScroll AS LONG
       STATIC memdc AS LONG, zoom AS SINGLE, si, ssi AS SCROLLINFO, r AS rect
       SELECT CASE CBMSG 
          CASE %WM_INITDIALOG
             'first, set appropriate dialog size to match printed paper
             IF PRINTERCOUNT = 0 THEN
                MSGBOX "No windows printers are connected", %MB_ICONERROR, "Initialize Print Preview"
                DIALOG END CBHNDL: EXIT FUNCTION
             END IF 
             XPRINT ATTACH DEFAULT
             XPRINT GET CLIENT TO wi, ht
             XPRINT CANCEL 
             hdc = GetDC(CBHNDL)
             xppi = GetDeviceCaps(hdc, %LOGPIXELSX)
             yppi = GetDeviceCaps(hdc, %LOGPIXELSY)
             nHt = .90 * GetDeviceCaps(hdc, %VERTRES) - 90
             nWi = (wi/ht) * (xppi / yppi) * nHt 
             x = MAX(460, nWi + 60)
             DIALOG SET CLIENT CBHNDL, x, nHt + 60
             DIALOG SET LOC CBHNDL, 100, 10
             nx = (x - nWi - 9)/2: ny = 30 
             CONTROL SET SIZE CBHNDL, %IDC_VScroll, 18, nHt
             CONTROL SET LOC CBHNDL, %IDC_VScroll, nx + nWi, ny
             CONTROL SET SIZE CBHNDL, %IDC_HScroll, nWi, 18
             CONTROL SET LOC CBHNDL, %IDC_HScroll, nx, nHt + ny
             CONTROL SHOW STATE CBHNDL, %IDC_VScroll, %SW_HIDE
             CONTROL SHOW STATE CBHNDL, %IDC_HScroll, %SW_HIDE
             CONTROL HANDLE CBHNDL, %IDC_VScroll TO hVScroll
             CONTROL HANDLE CBHNDL, %IDC_HScroll TO hHScroll
             '----------------------------------------------------------------
             XPRINT ATTACH DEFAULT
             XPRINT GET CLIENT TO xp, yp
             XPRINT GET DC TO hPrnDC
             memdc = CreateCompatibleDC(hPrnDC)
             hBmp = CreateCompatibleBitmap(hPrnDC, xp, yp)
             numPages = printRTF(hPrnDC, -1, 0, -1)
             XPRINT CANCEL
             SelectObject memdc, hBmp 
             PatBlt memdc, 0, 0, xp, yp, %PATCOPY
             IF numPages THEN 
                page = 1: CONTROL SET TEXT CBHNDL, %IDC_PageNo, " 1": GOSUB previewPage
             END IF   
             CONTROL SET TEXT CBHNDL, %IDC_NumPages, "of" + STR$(numPages) + " pages"
             dPages = MAX(numPages / 10, 5): zoom = 1: x = 0: y = 0
             r.nLeft = nx: r.nTop = ny
             r.nRight = r.nLeft + nWi: r.nBottom = r.nTop + nHt
             CONTROL SET FOCUS CBHNDL, %IDC_PageNo 
             CONTROL SEND CBHNDL, %IDC_PageNo, %EM_SETSEL, -1, 0
          CASE %WM_PAINT
             hdc = BeginPaint(CBHNDL, ps)
             StretchBlt hdc, nx, ny, nWi, nHt, _
                    memdc, x, y, xp/zoom, yp/zoom, %SRCCOPY
             EndPaint CBHNDL, ps 
          CASE %WM_COMMAND
             IF CBCTL = %IDC_Fwd THEN
                IF page < numPages THEN INCR page: GOSUB previewPage
             ELSEIF CBCTL = %IDC_Bwd THEN 
                IF page > 1 THEN DECR page: GOSUB previewPage
             ELSEIF CBCTL = %IDC_FastFwd THEN
                page = MIN(page + dPages, numPages)
                IF page <> lastPage THEN GOSUB previewPage
             ELSEIF CBCTL = %IDC_FastBwd THEN
                page = MAX(page - dPages, 1)
                IF page <> lastPage THEN GOSUB previewPage
             ELSEIF CBCTL = %IDOK THEN 
                CONTROL GET TEXT CBHNDL, %IDC_PageNo TO s
                IF VAL(s) THEN
                   page = MAX(1, MIN(VAL(s), numPages))
                   CONTROL SET TEXT CBHNDL, %IDC_PageNo, STR$(page)
                   IF page <> lastPage THEN
                      lastPage = page: zoom = 2.25
                      GOSUB previewPage
                   END IF 
                END IF
             ELSEIF CBCTL = %IDCANCEL THEN
                DIALOG END CBHNDL      
             ELSEIF CBCTL = %IDC_Zoom THEN
                zoom = 1.5 * zoom: IF zoom > 2.25 THEN zoom = 1
                IF zoom > 1 THEN 
                   CONTROL SHOW STATE CBHNDL, %IDC_VScroll, %SW_SHOW
                   CONTROL SHOW STATE CBHNDL, %IDC_HScroll, %SW_SHOW
                   si.cbSize = LEN(si)
                   si.fMask  = %SIF_ALL
                   si.nPage = (1 - 1/zoom)*yp/4
                   si.nMax  = 5 * si.nPage
                   si.nPos   = ky * si.nPage
                   SetScrollInfo hVScroll, %SB_CTL, si, 1
                   ssi.cbSize = LEN(ssi)
                   ssi.fMask  = %SIF_ALL
                   ssi.nPage = (1 - 1/zoom)*xp/4
                   ssi.nMax  = 5 * ssi.nPage
                   ssi.nPos   = kx * ssi.nPage
                   SetScrollInfo hHScroll, %SB_CTL, ssi, 1
                   x = ssi.nPos: y = si.nPos
                ELSE
                   x = 0: y = 0
                   CONTROL SHOW STATE CBHNDL, %IDC_VScroll, %SW_HIDE
                   CONTROL SHOW STATE CBHNDL, %IDC_HScroll, %SW_HIDE
                END IF
                InvalidateRect CBHNDL, r, 0
             ELSEIF CBCTL = %IDC_Print THEN
                printFile
             ELSE
                EXIT FUNCTION
             END IF      
             IF zoom > 1 AND CBCTL < %IDC_Zoom THEN
                zoom = 2.25: DIALOG SEND CBHNDL, %WM_COMMAND, %IDC_Zoom, 0
             END IF
          CASE %WM_VSCROLL
             SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINEDOWN, %SB_PAGEDOWN
                   si.nPos = MIN(si.nPos + si.nPage, si.nMax - si.nPage)
                CASE %SB_LINEUP, %SB_PAGEUP
                   si.nPos = MAX(si.nPos - si.nPage, si.nMin)
                CASE %SB_THUMBPOSITION
                   si.nPos = MIN(HIWRD(CBWPARAM), si.nMax - si.nPage)
                CASE ELSE
                   EXIT FUNCTION
             END SELECT
             y = si.nPos: ky = y/si.nPage 
             InvalidateRect CBHNDL, r, 0 
             si.cbSize = SIZEOF(si)
             si.fMask = %SIF_POS OR %SIF_PAGE
             SetScrollInfo hVScroll, %SB_CTL, si, 1
          CASE %WM_HSCROLL
             SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINEDOWN, %SB_PAGEDOWN
                   ssi.nPos = MIN(ssi.nPos + ssi.nPage, ssi.nMax - ssi.nPage)
                CASE %SB_LINEUP, %SB_PAGEUP
                   ssi.nPos = MAX(ssi.nPos - ssi.nPage, ssi.nMin)
                CASE %SB_THUMBPOSITION
                   ssi.nPos = MIN(HIWRD(CBWPARAM), ssi.nMax - ssi.nPage)
                CASE ELSE
                   EXIT FUNCTION
             END SELECT
             x = ssi.nPos: kx = x/ssi.nPage
             InvalidateRect CBHNDL, r, 0 
             ssi.cbSize = SIZEOF(ssi)
             ssi.fMask = %SIF_POS OR %SIF_PAGE
             SetScrollInfo hHScroll, %SB_CTL, ssi, 1
          CASE %WM_DESTROY
             DeleteDC memdc
             DeleteObject hBmp
             XPRINT CANCEL
       END SELECT
       EXIT FUNCTION
    previewPage:
       IF page THEN
          PatBlt memdc, 0, 0, xp, yp, %PATCOPY
          printRTF memdc, 0, pageEnd(page-1) + 1, pageEnd(page)
          InvalidateRect CBHNDL, r, 0: lastPage = page
          CONTROL SET TEXT CBHNDL, %IDC_PageNo, STR$(MIN(page, numPages))   
       END IF
       RETURN      
    END FUNCTION
    
    FUNCTION printRTF(hdc AS LONG, prn AS LONG, cpMin AS LONG, cpMax AS LONG) AS LONG
       'cpMin = -1 for printing selected text using hSelText
       'cpMax = -1 for printing all pages
       'prn > 0 to print
       'prn < 0 to define pages
       '---------------------------------------------------------------------------
       LOCAL fr AS FORMATRANGE, hEd AS LONG
       LOCAL di AS DOCINFO, zString AS ASCIIZ * 255
       LOCAL iTextOut, iTextAmt, iWidthTwips, iHeightTwips, numPages AS LONG
       fr.hdc           = hdc
       fr.hdcTarget     = hdc
       
       '- Get page dimensions in Twips
       iWidthTwips   = CLNG((GetDeviceCaps(hdc, %HORZRES) / GetDeviceCaps(hdc, %LOGPIXELSX)) * 1440)
       iHeightTwips  = CLNG((GetDeviceCaps(hdc, %VERTRES) / GetDeviceCaps(hdc, %LOGPIXELSY)) * 1440)
       
       fr.rcPage.nLeft   = 0
       fr.rcPage.nTop    = 0
       fr.rcPage.nRight  = iWidthTwips
       fr.rcPage.nBottom = iHeightTwips 
       
       fr.rc.nLeft   = fr.rcPage.nLeft   + 1440 * leftMargin
       fr.rc.nTop    = fr.rcPage.nTop    + 1440 * topMargin
       fr.rc.nRight  = fr.rcPage.nRight  - 1440 * rightMargin
       fr.rc.nBottom = fr.rcPage.nBottom - 1440 * bottomMargin
    
       '- Fill rDocInfo structure
       di.cbSize         = SIZEOF(DOCINFO)
       zString           = "RTF Printer"
       di.lpszDocName    = VARPTR(zString)
       di.lpszOutput     = %NULL
       
       hEd = hEdit: iTextAmt = cpMax
       IF cpMin < 0 THEN 'process selected text only
          hEd = hEditSel: cpMin = 1
          iTextAmt = SendMessage(hEd, %WM_GETTEXTLENGTH, 0, 0)
       ELSEIF cpMax < 0 THEN 'process entire text
          iTextAmt = SendMessage(hEd, %WM_GETTEXTLENGTH, 0, 0)
       END IF
       fr.chrg.cpmin = cpMin: fr.chrg.cpmax = iTextAmt
       IF prn > 0 THEN StartDoc hdc, di
       DO 
          IF prn > 0 THEN 'check if another page is to be printed
             iTextOut = SendMessage(hEd, %EM_FORMATRANGE, 0, VARPTR(fr))
             IF (iTextOut < fr.chrg.cpmin) OR (iTextOut >=fr.chrg.cpmax) THEN EXIT DO 
             StartPage hdc
          END IF
          iTextOut = SendMessage(hEd, %EM_FORMATRANGE, 1, VARPTR(fr))
          IF prn > 0 THEN Endpage hdc 
          IF (iTextOut < fr.chrg.cpmin) OR (iTextOut >=fr.chrg.cpmax) THEN EXIT DO
          
          IF prn < 0 THEN INCR numPages: pageEnd(numPages) = iTextOut - 1
          fr.chrg.cpmin = iTextOut: fr.chrg.cpmax = iTextAmt
       LOOP WHILE iTextOut < iTextAmt
    
       ' Clean up the Richedit control and finish printing:
       SendMessage hEd, %EM_FORMATRANGE, 0, BYVAL %NULL
       IF prn > 0 THEN EndDoc hdc
       FUNCTION = numPages 
    END FUNCTION
    
    SUB printFile()
       LOCAL pd AS PRINTDLGAPI, cr AS CHARRANGE
       LOCAL start, finish, numPages, hPrnDC, i, j AS LONG
       LOCAL txt AS STRING
       txt = getRichEditText(hEdit)
       IF LEN(txt) = 0 THEN EXIT SUB
       'setup the print dialog --------------------------------------------
       SendMessage hEdit, %EM_EXGETSEL, 0, VARPTR(cr)
       start = cr.cpMin + 1: finish = cr.cpMax + 1
       XPRINT ATTACH DEFAULT
       XPRINT GET DC TO hPrnDC
       numPages = printRTF(hPrnDC, -1, 1, -1)
       XPRINT CANCEL
       pd.lStructSize = LEN(pd)
       pd.Flags = %PD_ALLPAGES OR %PD_RETURNDC OR %PD_HIDEPRINTTOFILE
       IF numPages > 1 THEN
          pd.Flags = pd.Flags OR %PD_PAGENUMS
          pd.nFromPage = 1: pd.nToPage = 1
          pd.nMinPage = 1: pd.nMaxPage = numPages
       END IF
       IF finish > start THEN 'copy selection to hidden text box
          SendMessage hEdit, %WM_COPY, 0, 0
          SendMessage hEditSel, %WM_PASTE, 0, 0
          pd.Flags = pd.Flags OR %PD_SELECTION OR %PD_NOPAGENUMS
       ELSE
          pd.Flags = pd.Flags OR %PD_NOSELECTION
       END IF
       pd.hWndOwner = hDlg 
       IF PrintDlg(pd) THEN 'call print dialog ----------------------------
          IF (pd.Flags AND %PD_SELECTION) THEN
             i = -1: j = 0
          ELSEIF (pd.Flags AND %PD_PAGENUMS) THEN
             i = pageEnd(pd.nFromPage-1) + 1: j = pageEnd(pd.nToPage)
          ELSE
             i = 1: j = -1
          END IF
          SetCursor LoadCursor(%NULL, BYVAL %IDC_WAIT)
          printRTF pd.hDC, 1, i, j
          SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
          DeleteDC pd.hDC
       END IF 
       IF finish > start THEN
          putRichEditText hEditSel, ""
          SendMessage hEdit, %EM_SETSEL, -1, 0
       END IF
    END SUB
    ------------------




    [This message has been edited by Charles Dietz (edited July 05, 2006).]

  • #2
    Edited code to trigger error message when no windows printers are connected, and to pick up scroll bar
    error for low screen resolutions.

    ------------------

    Comment


    • #3
      Doesn't print graphics.
      How long is an idea? Write it down.

      Comment

      Working...
      X