PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Print rtf formatted text from editorgadget?

https://www.purebasic.fr/english/viewtopic.php?t=65755

Page 3 of 3

Re: Print rtf formatted text from editorgadget?

Posted: Fri May 27, 2016 2:30 pm
by RASHAD
Hi Fang

Code: Select all

#PD_ALLPAGES = $00000000
#PD_COLLATE = $10
#PD_DISABLEPRINTTOFILE = $80000
#PD_ENABLEPRINTHOOK = $1000
#PD_ENABLEPRINTTEMPLATE = $4000
#PD_ENABLEPRINTTEMPLATEHANDLE = $10000
#PD_ENABLESETUPHOOK = $2000
#PD_ENABLESETUPTEMPLATE = $8000
#PD_ENABLESETUPTEMPLATEHANDLE = $20000
#PD_HIDEPRINTTOFILE = $100000
#PD_NONETWORKBUTTON = $200000
#PD_NOPAGENUMS = $8
#PD_NOSELECTION = $4
#PD_NOWARNING = $80
#PD_PAGENUMS = $2
#PD_PRINTSETUP = $40
#PD_PRINTTOFILE = $20
#PD_RETURNDC = $100
#PD_RETURNDEFAULT = $400
#PD_RETURNIC = $200
#PD_SELECTION = $1
#PD_SHOWHELP = $800
#PD_USEDEVMODECOPIES = $40000
#PD_USEDEVMODECOPIESANDCOLLATE = $40000

Global PrinterDC

Procedure SetMargin(Gad, PageW,PageH, LM, TM, RM, BM)
  r.RECT
  r\left = LM
  r\top = TM
  r\right = PageW - RM
  r\bottom = PageH - BM  
  SendMessage_(GadgetID(Gad), #EM_SETRECTNP, 0, r)
EndProcedure

Procedure  StartPrint(Doc.s)
  d.DOCINFO
  d\cbSize = SizeOf(d)
  d\lpszDocName = @Doc
  d\lpszOutput = 0
  StartDoc_(PrinterDC,d)
EndProcedure

Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, TM, RM, BM)
  pd.PRINTDLG
  
  pd\lStructSize = SizeOf(PRINTDLG)
  pd\hwndOwner = hWnd
  pd\hDevMode = 0
  pd\hDevNames = 0
  pd\nFromPage = 0
  pd\nToPage = 0
  pd\nMinPage = 0
  pd\nMaxPage = 0
  pd\nCopies = 0
  pd\hInstance = hInst
  pd\Flags = #PD_HIDEPRINTTOFILE | #PD_NONETWORKBUTTON |#PD_RETURNDC | #PD_PRINTSETUP
  pd\lpfnSetupHook = 0
  pd\lpSetupTemplateName = 0
  pd\lpfnPrintHook = 0
  pd\lpPrintTemplateName = 0
   
  If PrintDlg_(pd)
    PrinterDC = pd\hDC
  Else
    PrinterDC = DefaultPrinter()
  EndIf
  
  If PrinterDC
    cxPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETX)
    cyPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETY)
    
    cxPhys = GetDeviceCaps_(PrinterDC, #PHYSICALWIDTH)
    cyPhys = GetDeviceCaps_(PrinterDC, #PHYSICALHEIGHT)
    SendMessage_(rtfEdit, #EM_SETTARGETDEVICE, PrinterDC, cxPhys*20)

    fr.FORMATRANGE       
    fr\hdc = PrinterDC
    fr\hdcTarget = PrinterDC
    
    fr\chrg\cpMin = 0
    fr\chrg\cpMax = -1
        
    fr\rcPage\left = 0
    fr\rcPage\top = 0
    fr\rcpage\right = 0
    fr\rcPage\bottom = 0
    
    fr\rc\left   = LM*20
    fr\rc\top    = TM*20
    fr\rc\right  = cxPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSX)- RM*20
    fr\rc\Bottom = cyPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSY)- BM*20
    
    StartPrint("RTF Printing")
    StartPage_(PrinterDC)
    
    iTextOut = 0
    iTextAmt = SendMessage_(rtfEdit, #WM_GETTEXTLENGTH, 0, 0)
    While iTextOut<iTextAmt
      iTextOut = SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, fr)           
      If iTextOut<iTextAmt                   
        EndPage_(PrinterDC)
        StartPage_(PrinterDC)
        fr\chrg\cpMin = iTextOut
        fr\chrg\cpMax = -1 
        iTextAmt = iTextAmt - iTextOut
        iTextOut = 0
      EndIf
    Wend
    SendMessage_(rtfEdit, #EM_FORMATRANGE, 0, 0)
    EndPage_(PrinterDC)
    EndDoc_(PrinterDC)
    DeleteDC_(PrinterDC)
  EndIf
EndProcedure

Procedure StreamFileInCallback(hFile, pbBuff, cb, pcb)
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure loadFile(pFilePath.s)
  If ReadFile(0, pFilePath)
    If GetExtensionPart(pFilePath)="rtf"
      uFormat = #SF_RTF
    Else
      uFormat = #SF_TEXT
    EndIf
    edstr.EDITSTREAM
    edstr\dwCookie = FileID(0)
    edstr\dwError = 0
    edstr\pfnCallback = @StreamFileInCallback()
    SendMessage_(GadgetID(0), #EM_STREAMIN, uFormat, edstr)
    CloseFile(0)
  Else
    MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
  EndIf
EndProcedure

OpenWindow(0, 200, 50, 640, 400,"RTF PRINTING", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateMenu(0, WindowID(0))
  MenuTitle("&File")
    MenuItem(0, "&Open")
    MenuItem(1, "&Print")
    MenuItem(2, "&Quit")
EditorGadget(0, 0, 0, WindowWidth(0), WindowHeight(0))
SendMessage_(GadgetID(0), #EM_LIMITTEXT, -1, 0)

a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
a.s=a.s+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
*MemoryBuffer = AllocateMemory(StringByteLength(a, #PB_Ascii) + 1)
PokeS(*MemoryBuffer, a.s, -1, #PB_Ascii)
SetGadgetText(0,PeekS(*MemoryBuffer))

SetMargin(0,640,400,10,10,20,20)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          FileName$ = OpenFileRequester("", "", "RTF (*.rtf|*.rtf|Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*", 0)
          If FileName$
            loadFile(FileName$)
          EndIf
          
        Case 1
          PrintRichText(WindowID(0), GetModuleHandle_(0), GadgetID(0), 10, 10, 20, 20)
          
        Case 2
          Quit = 1
          
      EndSelect
  EndSelect 
Until Quit = 1

Re: Print rtf formatted text from editorgadget?

Posted: Sat May 28, 2016 3:18 am
by Fangbeast
YAY!! Bloody brilliant RASHAD. Implemented and tested. Only few things left to be fixed and then I can release this version of the source.

Re: Print rtf formatted text from editorgadget?

Posted: Tue Nov 20, 2018 5:10 am
by Fangbeast
Hi RASHAD, I know this is an old post but I just tried the code in PB 5.62 X86 and it doesn't work in it for some reason.

The print dialogue comes up and I select the PDF one. Then the width of the editorgadget is set to nearly 4 times and the operation never finishes, no document gets created.

What version of the PB compiler do you use now and would you possibly have time to look at this please?

Re: Print rtf formatted text from editorgadget?

Posted: Tue Nov 20, 2018 6:24 am
by RASHAD
Hi Fang
Added Save as RTF & Plain text
Compile with PB 5.62
Tested with PB 5.62 x86 Windows 10 x64

Code: Select all

#PD_ALLPAGES = $00000000
#PD_COLLATE = $10
#PD_DISABLEPRINTTOFILE = $80000
#PD_ENABLEPRINTHOOK = $1000
#PD_ENABLEPRINTTEMPLATE = $4000
#PD_ENABLEPRINTTEMPLATEHANDLE = $10000
#PD_ENABLESETUPHOOK = $2000
#PD_ENABLESETUPTEMPLATE = $8000
#PD_ENABLESETUPTEMPLATEHANDLE = $20000
#PD_HIDEPRINTTOFILE = $100000
#PD_NONETWORKBUTTON = $200000
#PD_NOPAGENUMS = $8
#PD_NOSELECTION = $4
#PD_NOWARNING = $80
#PD_PAGENUMS = $2
#PD_PRINTSETUP = $40
#PD_PRINTTOFILE = $20
#PD_RETURNDC = $100
#PD_RETURNDEFAULT = $400
#PD_RETURNIC = $200
#PD_SELECTION = $1
#PD_SHOWHELP = $800
#PD_USEDEVMODECOPIES = $40000
#PD_USEDEVMODECOPIESANDCOLLATE = $40000

Global PrinterDC,EStream.EDITSTREAM

Procedure SStreamCB(dwCookie, pbBuff, cb, pcb)
  ProcedureReturn WriteFile_(dwCookie, pbBuff, cb, pcb, 0) ! 1
EndProcedure

Procedure SetMargin(Gad, PageW,PageH, LM, TM, RM, BM)
  r.RECT
  r\left = LM
  r\top = TM
  r\right = PageW - RM
  r\bottom = PageH - BM 
  SendMessage_(GadgetID(Gad), #EM_SETRECTNP, 0, r)
EndProcedure

Procedure  StartPrint(Doc.s)
  d.DOCINFO
  d\cbSize = SizeOf(d)
  d\lpszDocName = @Doc
  d\lpszOutput = 0
  StartDoc_(PrinterDC,d)
EndProcedure

Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, TM, RM, BM)
  pd.PRINTDLG
 
  pd\lStructSize = SizeOf(PRINTDLG)
  pd\hwndOwner = hWnd
  pd\hDevMode = 0
  pd\hDevNames = 0
  pd\nFromPage = 0
  pd\nToPage = 0
  pd\nMinPage = 0
  pd\nMaxPage = 0
  pd\nCopies = 0
  pd\hInstance = hInst
  pd\Flags = #PD_HIDEPRINTTOFILE | #PD_NONETWORKBUTTON |#PD_RETURNDC | #PD_PRINTSETUP
  pd\lpfnSetupHook = 0
  pd\lpSetupTemplateName = 0
  pd\lpfnPrintHook = 0
  pd\lpPrintTemplateName = 0
   
  If PrintDlg_(pd)
    PrinterDC = pd\hDC
  Else
    PrinterDC = DefaultPrinter()
  EndIf
 
  If PrinterDC
    cxPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETX)
    cyPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETY)
   
    cxPhys = GetDeviceCaps_(PrinterDC, #PHYSICALWIDTH)
    cyPhys = GetDeviceCaps_(PrinterDC, #PHYSICALHEIGHT)
    SendMessage_(rtfEdit, #EM_SETTARGETDEVICE, PrinterDC, cxPhys*20)

    fr.FORMATRANGE       
    fr\hdc = PrinterDC
    fr\hdcTarget = PrinterDC
   
    fr\chrg\cpMin = 0
    fr\chrg\cpMax = -1
       
    fr\rcPage\left = 0
    fr\rcPage\top = 0
    fr\rcpage\right = 0
    fr\rcPage\bottom = 0
   
    fr\rc\left   = LM*20
    fr\rc\top    = TM*20
    fr\rc\right  = cxPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSX)- RM*20
    fr\rc\Bottom = cyPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSY)- BM*20
   
    StartPrint("RTF Printing")
    StartPage_(PrinterDC)
   
    iTextOut = 0
    iTextAmt = SendMessage_(rtfEdit, #WM_GETTEXTLENGTH, 0, 0)
    While iTextOut<iTextAmt
      iTextOut = SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, fr)           
      If iTextOut<iTextAmt                   
        EndPage_(PrinterDC)
        StartPage_(PrinterDC)
        fr\chrg\cpMin = iTextOut
        fr\chrg\cpMax = -1
        iTextAmt = iTextAmt - iTextOut
        iTextOut = 0
      EndIf
    Wend
    SendMessage_(rtfEdit, #EM_FORMATRANGE, 0, 0)
    EndPage_(PrinterDC)
    EndDoc_(PrinterDC)
    DeleteDC_(PrinterDC)
  EndIf
EndProcedure

Procedure StreamFileInCallback(hFile, pbBuff, cb, pcb)
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure loadFile(pFilePath.s)
  If ReadFile(0, pFilePath)
    If GetExtensionPart(pFilePath)="rtf"
      uFormat = #SF_RTF
    Else
      uFormat = #SF_TEXT
    EndIf
    edstr.EDITSTREAM
    edstr\dwCookie = FileID(0)
    edstr\dwError = 0
    edstr\pfnCallback = @StreamFileInCallback()
    SendMessage_(GadgetID(0), #EM_STREAMIN, uFormat, edstr)
    CloseFile(0)
  Else
    MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
  EndIf
EndProcedure

OpenWindow(0, 200, 50, 640, 400,"RTF Load,Save & Print", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateMenu(0, WindowID(0))
  MenuTitle("&File")
    MenuItem(0, "&Open")
    OpenSubMenu("&Save As..")
      MenuItem( 1, "RTF File")
      MenuItem( 2, "Plain Text")
    CloseSubMenu()
    MenuItem(3, "&Print")
    MenuItem(4, "&Quit")
EditorGadget(0, 0, 0, WindowWidth(0), WindowHeight(0))
SendMessage_(GadgetID(0), #EM_LIMITTEXT, -1, 0)

a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
a.s=a.s+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
SetGadgetText(0,a)

SetMargin(0,640,400,10,10,20,20)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
     
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          ClearGadgetItems(0)
          FileName$ = OpenFileRequester("", "", "RTF (*.rtf|*.rtf|Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*", 0)
          If FileName$
            loadFile(FileName$)
          EndIf
          
        Case 1
            If CreateFile(0, GetHomeDirectory()+"Document2.rtf")
              EStream\dwCookie = FileID(0)
              EStream\pfnCallback = @SStreamCB()
              SendMessage_(GadgetID(0), #EM_STREAMOUT, #SF_RTF, EStream)             
              CloseFile(0)
            EndIf
            
        Case 2
            If CreateFile(0, GetHomeDirectory()+"Document2.txt")
              EStream\dwCookie = FileID(0)
              EStream\pfnCallback = @SStreamCB()
              SendMessage_(GadgetID(0), #EM_STREAMOUT, #SF_TEXT, EStream)             
              CloseFile(0)
            EndIf 
         
        Case 3
            PrintRichText(WindowID(0), GetModuleHandle_(0), GadgetID(0), 10, 10, 20, 20)
         
        Case 4
            Quit = 1
         
      EndSelect
  EndSelect
Until Quit = 1

Re: Print rtf formatted text from editorgadget?

Posted: Tue Nov 20, 2018 7:49 am
by Fangbeast
Thank you master RASHAD. I look forward to testing this tomorrow as all my print routines are nobbled under 5.62. Quite a lot I have to fix too.

I am allowing end users to print the user created help files and the data forms (Which are all all RTF data).

I eventually have to find some way to strip the rtf data during export as well.

I appreciate your time!!

Re: Print rtf formatted text from editorgadget?

Posted: Wed Nov 21, 2018 5:57 am
by Fangbeast
Okay, incorporated your code into my info keeper and printing, loading and saving works.

Now, I want to use an editorgadget as a preview of all selected items to print. if I return a record from the database and use AddGadgetItem, the data is not pasted as rtf, just text.

Is there a trick to stream the data in from the database as rtf?

Re: Print rtf formatted text from editorgadget?

Posted: Wed Nov 21, 2018 8:39 am
by RASHAD
Added :
- Select Row
- Select Font Name
- Select Font Size
- Select Font Color (Colour :P )
- Select Text Format

Modified :
- Save as RTF
- Save as Text

Added : PopUpMenu

Code: Select all

#PD_ALLPAGES = $00000000
#PD_COLLATE = $10
#PD_DISABLEPRINTTOFILE = $80000
#PD_ENABLEPRINTHOOK = $1000
#PD_ENABLEPRINTTEMPLATE = $4000
#PD_ENABLEPRINTTEMPLATEHANDLE = $10000
#PD_ENABLESETUPHOOK = $2000
#PD_ENABLESETUPTEMPLATE = $8000
#PD_ENABLESETUPTEMPLATEHANDLE = $20000
#PD_HIDEPRINTTOFILE = $100000
#PD_NONETWORKBUTTON = $200000
#PD_NOPAGENUMS = $8
#PD_NOSELECTION = $4
#PD_NOWARNING = $80
#PD_PAGENUMS = $2
#PD_PRINTSETUP = $40
#PD_PRINTTOFILE = $20
#PD_RETURNDC = $100
#PD_RETURNDEFAULT = $400
#PD_RETURNIC = $200
#PD_SELECTION = $1
#PD_SHOWHELP = $800
#PD_USEDEVMODECOPIES = $40000
#PD_USEDEVMODECOPIESANDCOLLATE = $40000

Global PrinterDC,EStream.EDITSTREAM

Procedure Sel_Text(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
  sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1

  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)

  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

Procedure Sel_FontName(Gadget, FontName.s)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Sel_FontColor(Gadget, Color)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Sel_FontSize(Gadget, Fontsize)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure Sel_CharFormat(Gadget, Flags)
  format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure SetMargin(Gad, PageW,PageH, LM, TM, RM, BM)
  r.RECT
  r\left = LM
  r\top = TM
  r\right = PageW - RM
  r\bottom = PageH - BM 
  SendMessage_(GadgetID(Gad), #EM_SETRECTNP, 0, r)
EndProcedure

Procedure  StartPrint(Doc.s)
  d.DOCINFO
  d\cbSize = SizeOf(d)
  d\lpszDocName = @Doc
  d\lpszOutput = 0
  StartDoc_(PrinterDC,d)
EndProcedure

Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, TM, RM, BM)
  pd.PRINTDLG
 
  pd\lStructSize = SizeOf(PRINTDLG)
  pd\hwndOwner = hWnd
  pd\hDevMode = 0
  pd\hDevNames = 0
  pd\nFromPage = 0
  pd\nToPage = 0
  pd\nMinPage = 0
  pd\nMaxPage = 0
  pd\nCopies = 0
  pd\hInstance = hInst
  pd\Flags = #PD_HIDEPRINTTOFILE | #PD_NONETWORKBUTTON |#PD_RETURNDC | #PD_PRINTSETUP
  pd\lpfnSetupHook = 0
  pd\lpSetupTemplateName = 0
  pd\lpfnPrintHook = 0
  pd\lpPrintTemplateName = 0
   
  If PrintDlg_(pd)
    PrinterDC = pd\hDC
  Else
    PrinterDC = DefaultPrinter()
  EndIf
 
  If PrinterDC
    cxPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETX)
    cyPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETY)
   
    cxPhys = GetDeviceCaps_(PrinterDC, #PHYSICALWIDTH)
    cyPhys = GetDeviceCaps_(PrinterDC, #PHYSICALHEIGHT)
    SendMessage_(rtfEdit, #EM_SETTARGETDEVICE, PrinterDC, cxPhys*20)

    fr.FORMATRANGE       
    fr\hdc = PrinterDC
    fr\hdcTarget = PrinterDC
   
    fr\chrg\cpMin = 0
    fr\chrg\cpMax = -1
       
    fr\rcPage\left = 0
    fr\rcPage\top = 0
    fr\rcpage\right = 0
    fr\rcPage\bottom = 0
   
    fr\rc\left   = LM*20
    fr\rc\top    = TM*20
    fr\rc\right  = cxPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSX)- RM*20
    fr\rc\Bottom = cyPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSY)- BM*20
   
    StartPrint("RTF Printing")
    StartPage_(PrinterDC)
   
    iTextOut = 0
    iTextAmt = SendMessage_(rtfEdit, #WM_GETTEXTLENGTH, 0, 0)
    While iTextOut<iTextAmt
      iTextOut = SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, fr)           
      If iTextOut<iTextAmt                   
        EndPage_(PrinterDC)
        StartPage_(PrinterDC)
        fr\chrg\cpMin = iTextOut
        fr\chrg\cpMax = -1
        iTextAmt = iTextAmt - iTextOut
        iTextOut = 0
      EndIf
    Wend
    SendMessage_(rtfEdit, #EM_FORMATRANGE, 0, 0)
    EndPage_(PrinterDC)
    EndDoc_(PrinterDC)
    DeleteDC_(PrinterDC)
  EndIf
EndProcedure
  
Procedure StreamInCallback(hFile, pbBuff, cb, pcb)
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure loadFile(pFilePath.s)
  If ReadFile(0, pFilePath)
    If GetExtensionPart(pFilePath)="rtf"
      uFormat = #SF_RTF
    Else
      uFormat = #SF_TEXT
    EndIf
    edstr.EDITSTREAM
    edstr\dwCookie = FileID(0)
    edstr\dwError = 0
    edstr\pfnCallback = @StreamInCallback()
    SendMessage_(GadgetID(0), #EM_STREAMIN, uFormat, edstr)
    CloseFile(0)
  Else
    MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
  EndIf
EndProcedure

Procedure StreamOutCallback(dwCookie, *pbBuff, cb, *pcb.Long)    
  WriteData(dwCookie, *pbBuff, cb)
  *pcb\l = cb    
  ProcedureReturn 0
EndProcedure

Procedure SaveRTF( gad,FileName.s)
  Protected.EDITSTREAM stream    
  With stream
    \dwCookie = CreateFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @StreamOutCallback()
      SendMessage_(GadgetID(gad), #EM_STREAMOUT, #SF_RTF, @stream)
      CloseFile(\dwCookie)
      SendMessage_(GadgetID(gad), #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure SaveText(gad, FileName.s)
  Protected.EDITSTREAM stream
  Protected Flag.l = #SF_TEXT    
  CompilerIf #PB_Compiler_Unicode : Flag | #SF_UNICODE : CompilerEndIf    
  With stream
    \dwCookie = CreateFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @StreamOutCallback()
      SendMessage_(GadgetID(gad), #EM_STREAMOUT, Flag, @stream)
      CloseFile(\dwCookie)
      SendMessage_(GadgetID(gad), #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure WndProc(hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #WM_CONTEXTMENU
      Select wParam
        Case GadgetID(0) 
            GetCursorPos_(p.POINT)          
            DisplayPopupMenu(0, WindowID(0), p\x+20,p\y)           
      
      EndSelect
  EndSelect
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

OpenWindow(0, 200, 50, 640, 400,"RTF Load,Save & Print", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CreatePopupMenu(0) 
    MenuItem(0, "&Open")
    OpenSubMenu("&Save As..")
      MenuItem( 1, "RTF File")
      MenuItem( 2, "Plain Text")
    CloseSubMenu()
    MenuBar() 
    MenuItem(3, "&Cut")
    MenuItem(4, "&Copy")
    MenuItem(5, "&Paste")
    MenuBar()
    MenuItem(6, "&Print")
    MenuBar()
    MenuItem(7, "&Quit")
EditorGadget(0, 10, 10, 620,350)
ButtonGadget(1,10,370,80,20,"Add Text")
SendMessage_(GadgetID(0), #EM_LIMITTEXT, -1, 0)

a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
a.s=a.s+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
SetGadgetText(0,a)

SetMargin(0,640,400,10,10,20,20)

SetWindowCallback(@WndProc())
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
     
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          ClearGadgetItems(0)
          FileName$ = OpenFileRequester("", "", "RTF (*.rtf|*.rtf|Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*", 0)
          If FileName$
            loadFile(FileName$)
          EndIf
          
        Case 1
            FileName$ = SaveFileRequester("", "", "RTF (*.rtf|*.rtf|All files (*.*)|*.*", 0)
            If FileName$            
              SaveRTF( 0,  FileName$)
            EndIf
            
        Case 2
            FileName$ = SaveFileRequester("", "", "Text (*.txt)|*.txt|All files (*.*)|*.*", 0)
            If FileName$
              SaveText( 0,  FileName$)
            EndIf
            
        Case 3
            SendMessage_(GadgetID(0),#WM_CUT,0,0)
            
        Case 4
            ClearClipboard()
            SendMessage_(GadgetID(0),#WM_COPY,0,0)
              
        Case 5
            SendMessage_(GadgetID(0),#WM_PASTE,0,0)
         
        Case 6
            PrintRichText(WindowID(0), GetModuleHandle_(0), GadgetID(0), 10, 10, 20, 20)
         
        Case 7
            Quit = 1          
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          row = CountGadgetItems(0) 
          AddGadgetItem(0, row,"This is a blue, bold and underlined big text" )          
          Sel_Text(0, row, 1, row, -1)
          Sel_FontColor(0, RGB(0,0,255))
          Sel_FontSize(0, 18)
          Sel_CharFormat(0,#CFM_ITALIC)          
          
          row = CountGadgetItems(0)
          AddGadgetItem(0, row, "Times new Roman, red, striked out and italic")
          Sel_Text(0, row, 1, row, -1)
          Sel_FontColor(0, RGB(255,0,0))
          Sel_FontName(0, "Times New Roman")
          Sel_FontSize(0, 12)
          Sel_CharFormat(0, #CFM_ITALIC|#CFM_STRIKEOUT)

          Sel_Text(0, 0, 0, 0, 0) 
          
      EndSelect
  EndSelect
Until Quit = 1

Re: Print rtf formatted text from editorgadget?

Posted: Thu Nov 22, 2018 1:45 am
by Fangbeast
My problem was different to the one you tried to fix for me, sorry about the misunderstanding.

All my records in the database were saved as rtf so when I printed to the web gadget or exported to xml, the rtf formatted data was exported/printed and was horrible to read.

So I made a quick addition to my program by adding a hidden editorgadget and a simple routine to read the database, put each record into the hidden gadget, read it back in text mode only and save it.

Now the database is free of rtf data and is readable when exported and/or printed.

The help screen are all rtf and this is where all your lovely code comes in handy.

Then I shall figure out something for the keyboard shortcuts list. Right now though, it is so cold that I cannot function. Start of summer too, go figure!

Re: Print rtf formatted text from editorgadget?

Posted: Mon Mar 28, 2022 3:18 am
by DeanH
I had a problem with the RTF Direct code when printing a larger amount of text. For example, I added a simple loop that filled the editor gadget with 500 rows of numbers. Printing stopped about half way through. 200 rows was ok but 500 was not. I have done some experimenting and was able to print all the rows. I have tried this with a 100k rtf document and it printed correctly. The document included bullet points, colours and page formatting. The code below is only used for testing the printouts. It does not include all of the other nice code in RTF Direct. I have also made a few other minor changes.

Code: Select all

;RTF Direct, example of revised printing to handle larger amounts of data

;Added this function to return length of data in editor using EM_GETTEXTLENGTHEX. Needed for RTF 2.0.
Procedure.i RichEditGetTextLength(hRtf)
	Protected len.GETTEXTLENGTHEX
	len\flags=#GTL_NUMCHARS | #GTL_DEFAULT
	CompilerIf #PB_Compiler_Unicode
		len\codepage=1200
	CompilerElse
		len\codepage=#CP_ACP
	CompilerEndIf
	ProcedureReturn SendMessage_(hRtf,#EM_GETTEXTLENGTHEX,@len,0)
EndProcedure


Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, TM, RM, BM)
	pd.PRINTDLG
	
	If PrintRequester()=0
		ProcedureReturn
	EndIf
	
	PrinterDC=PrinterVectorOutput(#PB_Unit_Millimeter)			;returns DC
	If PrinterDC=0
		ProcedureReturn
	EndIf

	cxPhys=GetDeviceCaps_(PrinterDC,#HORZRES)
	cyPhys=GetDeviceCaps_(PrinterDC,#VERTRES)
	SendMessage_(rtfEdit, #EM_SETTARGETDEVICE, PrinterDC, cxPhys*20)
	
	fr.FORMATRANGE
	fr\hdc = PrinterDC
	fr\hdcTarget = PrinterDC
	fr\rc\left   = LM*20
	fr\rc\top    = TM*20
	fr\rc\right  = cxPhys * 1440 / GetDeviceCaps_(PrinterDC, #LOGPIXELSX)- RM*20		;line width / dpi
	fr\rc\Bottom = cyPhys * 1440 / GetDeviceCaps_(PrinterDC, #LOGPIXELSY)- BM*20	;line height / dpi
	fr\rcPage\left = 0
	fr\rcPage\top = 0
	fr\rcpage\right = 0
	fr\rcPage\bottom = 0
	fr\chrg\cpMin = 0
	fr\chrg\cpMax = -1
	
	StartPrinting("RTF Printing")
	
	iTextPos = 0
	iTextAmt = RichEditGetTextLength(rtfEdit) - 1
	
	While iTextPos<iTextAmt
		StartPage_(PrinterDC)
		iTextPos=SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, fr)   ;result is position in the text, not the amount printed
		EndPage_(PrinterDC)
		fr\chrg\cpMin = iTextPos
		fr\chrg\cpMax = -1
	Wend

	SendMessage_(rtfEdit, #EM_FORMATRANGE, 0, 0)
	StopPrinting()
EndProcedure

Procedure StreamInCallback(hFile, pbBuff, cb, pcb)
	ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure loadFile(pFilePath.s)
	If ReadFile(0, pFilePath)
		If LCase(GetExtensionPart(pFilePath))="rtf"
			uFormat = #SF_RTF
		Else
			uFormat = #SF_TEXT
		EndIf
		edstr.EDITSTREAM
		edstr\dwCookie = FileID(0)
		edstr\dwError = 0
		edstr\pfnCallback = @StreamInCallback()
		SendMessage_(GadgetID(0), #EM_STREAMIN, uFormat, edstr)
		CloseFile(0)
		SetWindowTitle(0,pFilePath)
	Else
		MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
	EndIf
EndProcedure

OpenWindow(0, 200, 50, 640, 480,"RTF Editor", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
x=12
y=WindowHeight(0)-30
EditorGadget(0, x, 10, 620, 430)
ButtonGadget(10,x,y,75,22,"Open")
ButtonGadget(12,x+81,y,75,22,"Print")
ButtonGadget(14,WindowWidth(0)-81,y,75,22,"Close")

i$=""
For i=1 To 500
	i$+Str(i)+#CRLF$
Next
SetGadgetText(0,i$)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Quit = 1
		Case #PB_Event_Gadget
			Select EventGadget()
				Case 10
					ClearGadgetItems(0)
					FileName$ = OpenFileRequester("", "", "RTF (*.rtf)|*.rtf|Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*", 0)
					If FileName$
						loadFile(FileName$)
					EndIf
				Case 12
					PrintRichText(WindowID(0), GetModuleHandle_(0), GadgetID(0), 25, 25, 25, 25)
					SetGadgetAttribute(0,#PB_Editor_WordWrap,#True)
				Case 14
					Quit=1          
			EndSelect
	EndSelect
Until Quit = 1
End
All times are UTC+01:00
Page 3 of 3

Powered by phpBB® Forum Software © phpBB Limited