Using RichEdit Control

[Andrew Lindsay]

Greetings board,


I've been away from programming for a while and now I find myself stuck offshore without all my usual tools, and in need of a simple program to speed things up for me.


I stumbled across FreeBasic and also saw my favourite, FireFly was available for FreeBasic too.


But, my problem is, I am trying to get a richedit control working.  I've loaded up the RTF text as a string as follows.

Code Select Expand


    sRes = "{\rtf1\ansi\ansicpg1252\deff0\deflang3081{\fonttbl{\f0\fnil\fcharset0 Courier New;}{\f1\fnil Courier New;}}" + Chr$(13)+Chr$(10)
    sRes = sRes + "{\colortbl ;\red0\green128\blue0;\red255\green0\blue0;\red0\green0\blue0;}" + Chr$(13)+Chr$(10)
    sRes = sRes + "\tx720\tx1440\tx2880" + Chr$(13)+Chr$(10)
    sRes = sRes + "\viewkind4\uc1\pard\ul\b\f0\fs16 Results\ulnone\b0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par \pard\fi-2820\li2820" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par \pard Flange Gaps\Tab Measured\Tab Predicted" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par 12 o'clock\tab XX\tab\tab\cf1\b XX\cf0\b0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par  3 o'clock\tab XX\tab\tab\cf2\ul\b\i XX\cf0\ulnone\b0\i0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par  6 o'clock\tab XX\tab\tab\cf1\b XX\cf0\b0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par  9 o'clock\tab XX\tab\tab\cf1\b XX" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par \cf3\ul Warnings\ulnone\b0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par Gap measurements appear To be inconsistent, consider rechecking inputs And measurements." + Chr$(13)+Chr$(10)
    sRes = sRes + "\par" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par \ul\b Results\ulnone\b0" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par Flange Angle = \ul\b\i X.X\'b0\cf0\f1" + Chr$(13)+Chr$(10)
    sRes = sRes + "\par }" + Chr$(13)+Chr$(10)





then tried sending it to the RichEdit Control using

Code Select Expand


FF_TextBox_SetText( HWND_FORM1_RICHEDIT1, sRes )



But all I get is the string as plain text, without the formatting etc.


Any assistance would be appreciated.

[José Roca]

This is my wrapper function for PowerBASIC. If someone wants to adapt it to FreeBasic...

Code Select Expand


' ========================================================================================
' Application defined callback used by the EM_STREAMIN message
' ========================================================================================
FUNCTION RichEdit_SetRtfTextCallback (BYVAL pdwCookie AS RICHEDITCUSTOMDATA PTR, BYVAL pbBuff AS BYTE PTR, BYVAL cb AS LONG, pcb AS DWORD) AS LONG
   pcb = MIN(@pdwCookie.nLen - @pdwCookie.curPos, cb)
   IF pcb > 0 THEN
      MoveMemory BYVAL pbBuff, BYVAL @pdwCookie.pszText + @pdwCookie.curPos, pcb
      @pdwCookie.curPos = @pdwCookie.curPos + pcb
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets a formatted RTF string into a Rich Edit control
' Parameters:
' - hRichEdit = Handle of the Rich Edit control.
' - strText = Text to set.
' - bInsertText (optional) = If specified, the data stream replaces the contents of the
'   current selection. If not specified, the data stream replaces the entire contents of
'   the control.
' ========================================================================================
FUNCTION RichEdit_SetRtfText (BYVAL hRichEdit AS DWORD, BYVAL strText AS STRING, OPTIONAL BYVAL bInsertText AS LONG) AS DWORD

   LOCAL sf   AS DWORD                ' // Data format and replacement options
   LOCAL edts AS EDITSTREAM           ' // EDITSTREAM structure
   LOCAL recd AS RICHEDITCUSTOMDATA   ' // Custom data

   sf = %SF_TEXT
   IF LEFT$(REMOVE$(UCASE$(LEFT$(strText, 10)), ANY "{ " ), 5) = "\RTF1" THEN sf = %SF_RTF

   recd.curPos      = 0
   recd.pszText     = STRPTR(strText)
   recd.nLen        = LEN(strText)

   edts.dwCookie    = VARPTR(recd)
   edts.dwError     = 0
   edts.pfnCallback = CODEPTR(RichEdit_SetRtfTExtCallback)

   IF bInsertText THEN sf = sf OR %SFF_SELECTION
   SendMessage hRichEdit, %EM_STREAMIN, sf, VARPTR(edts)

   FUNCTION = edts.dwError

END FUNCTION
' ========================================================================================


[Andrew Lindsay]

Giving back to the community.


I have managed to log onto my home PC through my dodgy internet connection and found the FireFly-PB version of the FF_RichEdit_SetText Function and converted it over to a FreeBasic Version.


Here it is...

Code Select Expand



'[NAME] FF_RichEdit_SetText
'[AUTHORNAME] Paul Squires
'[EMAIL] support@planetsquires.com
'[WEBSITE] www.planetsquires.com
'[VERSION]
'[ISFAVORITE] No
'[EXPAND] No
'[KEYWORDS]
'richedit text
'[KEYWORDS]
'[DESCRIPTION]
'Allows the user to set the text of a RichEdit control.
'The FF_RichEdit_SetText function sets the text based on the type of text
'in the buffer that you are using.
'
'Function FF_RichEdit_SetText( ByVal hRichEdit As Long, _
' ByVal sBuffer As String, _
' ByVal fPlainText As Long _
' ) As Long
'
'The third parameter, fPlainText, is a flag that indictaes the type of text
'that is being sent to the RichEdit control. When set to TRUE will set
'the text in plain format. When the flag is set to %FALSE then the text is
'returned in rich text format.
'
' NOTE - Must add the following line to FF_AppStart
'        #Include Once crtstring.bi
'
'[DESCRIPTION]
'[CODESTART]
Type FF_RichEditSetTextParmType
     dwAddr as Dword
     cch as Long
     Offset as Long
End Type   




Function FF_RichEdit_SetText( ByVal hRichEdit as Long,_
         ByVal sBuffer as String, _
         ByVal fPlainText as Long _
         ) as Long
    Static eStream as EDITSTREAM
    Static Parm as FF_RichEditSetTextParmType
   
    Parm.dwAddr = StrPtr(sBuffer)    ' address of NTS
    parm.cch = Len(sBuffer)          ' Total LEN of data to be sent to control
    Parm.Offset = 0                  ' how much as been sent so far from callback     
    eStream.dwCookie = VarPtr (Parm) ' address so we can update in callback
    eStream.pfnCallback = ProcPtr(FF_RichEditStreamSetCallback)
    eStream.dwError = 0
    If fPlainText Then
        SendMessage hRichEdit, EM_STREAMIN, SF_TEXT, VarPtr(eStream)
    Else
         SendMessage hRichEdit, EM_STREAMIN, SF_RTF, VarPtr(eStream)
    End If
'- The text box is dirty now ...
    SendMessage hRichEdit, EM_SETMODIFY, 1, 0
    Function = True
End Function




Function FF_RichEditStreamSetCallback( ByRef Parm as FF_RichEditSetTextParmType, _
        ByVal pbBuffer as Dword, _
        ByVal cb as Long,_
        ByRef pcb as Long _
        ) as Dword
    ' Code from MCM (PowerBasic forums)
    Static dwSource as Dword, BytesLeft as Long




    BytesLeft = parm.cch - parm.Offset ' how much have we NOT sent yet
    ' we can send cb or bytesleft, whichever is less
    pcb = Min(BytesLeft, cb)
    If PCB Then ' this will be zero if we have already sent EXACTLY the length of the file!
    dwSource = parm.dwAddr + Parm.Offset
    ' start of data + what's already sent
    'Copy the memory to the directed buffer




    memcpy pbBuffer, dwSource, pcb
    ' problems with conflicting Win32api.INC
    ' increment the offset for next trip
    parm.Offset = parm.Offset + pcb
End If
Function = 0
End Function



The important thing to note, you must add the following to the FF_AppStart code for your project. 

Code Select Expand



        #Include Once "crtstring.bi"


Best regards

Andrew

[José Roca]

Using static variables makes the function thread unsafe.

[Andrew Lindsay]

Jose,


Should it just be 'Dim' then, instead of Static?  I don't use threads in applications so I'm not really sure of all the nuances involved.


Regards


Andrew

[José Roca]

The problem with that function is that if it is called from more that one thread at the same time you will get a mess. The one that I have posted is thread safe.