RICHEDIT and EDITSTREAM

I cannot load rtf in Richedit, Xojo crashes after the 1st round of CallBack function.
Nearly the same code works well under VB6.

Here is my simplified code where mWnd is either a new window handle (obtained with CreateWindowEx and MSFTEDIT_CLASS) or a TextArea handle (since it is actually a Richedit control).

Sub Open() Call LoadLibrary("msftedit.dll") ' (OR "riched20.dll" : same) End Sub

Shared Function EditStreamCallBack(lCookie As Integer, pbBuffer as ptr, cb as Integer, byref pcb As integer) As Integer If ReadFile(lCookie, pbBuffer ,cb, pcb, nil) = 0 Then return -1 End Function

[code]Function LoadRTFFromFile(f as FolderItem) As Integer
Dim hFile as Integer = CreateFile(f.NativePath + chr(0), GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0)
If hFile <= 0 Then return 0

Dim es as EDITSTREAM
es.dwCookie = hFile
es.pfnCallback = AddressOf EditStreamCallBack
es.dwError = 0

dim mbes as New MemoryBlock(es.Size)
mbes.StringValue(0, es.Size) = es.StringValue(TargetLittleEndian)
Dim p As Ptr = mbes

rc = SendMessageWptr (mWnd, EM_STREAMIN, SFF_SELECTION + SF_RTF, p)
rc = SendMessageW (mWnd, EM_SETMODIFY, 1, 0)

Call CloseHandle (es.dwCookie) 'clean up
End Function[/code]

The CallBack Function is properly launched, the content of pbBuffer is correct (I checked the data in pbBuffer = same as in rtf file => OK).
The crach occurs after the return of CallBack Function (except if return value is <> 0 which means cancel) and the new text is not displayed in Richedit/Textarea.

Has anyone succeeded in loading rtf file (or string) with EM_STREAMIN ?

Same crash when trying to save a rtf to a file (EM_STREAMOUT), still after callback function
:

Shared Function EditStreamOutCallBack(lCookie As Integer, pbBuffer as ptr, cb as Integer, byref pcb As integer) As Integer If WriteFile (lCookie, pbBuffer, cb, NumberOfBytesWritten, nil) = 0 Then return -1 End Function

[code]Function SaveRTFToFile(f as FolderItem) As Integer
Dim hFile as Integer = CreateFile(f.NativePath + chr(0), GENERIC_WRITE,0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If hFile <= 0 Then return 0

Dim es as EDITSTREAM
es.dwCookie = hFile
es.pfnCallback = AddressOf EditStreamOutCallBack
es.dwError = 0

dim mbes as New MemoryBlock(es.Size)
mbes.StringValue(0, es.Size) = es.StringValue(TargetLittleEndian)
Dim p As Ptr = mbes

rc = SendMessageW (mWnd, EM_STREAMOUT, SF_RTF, integer§)
Call CloseHandle (es.dwCookie) 'clean up
End Function[/code]

Try setting the callback’s calling convention to StdCall:

Shared Function EditStreamOutCallBack(lCookie As Integer, pbBuffer as ptr, cb as Integer, byref pcb As integer) As Integer
    #pragma X86CallingConvention StdCall
    [...]
End Function

Have you tried TextArea.WinRTFDataMBS property in MBS Plugin?

Allows you to put RTF in and out.

[quote=240228:@Patrick Morel]I cannot load rtf in Richedit, Xojo crashes after the 1st round of CallBack function.
Nearly the same code works well under VB6.

Here is my simplified code where mWnd is either a new window handle (obtained with CreateWindowEx and MSFTEDIT_CLASS) or a TextArea handle (since it is actually a Richedit control).
[/quote]
As far as I can tell, the StreamCallback is being called repeatedly and your code does not seem to handle this. The only way I can help is the C-code I used in the WordGuise Plugin. You might benefit from it.

//---------------------------------------------------------------------------
// WinAPI callback for streaming text into the control
//
DWORD CALLBACK StreamInCallback(DWORD dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb)
{		
MSG(in StreamInCallback)
	MemoryStream* memoryStream = reinterpret_cast<MemoryStream*>(dwCookie);
	memoryStream->visited++;
//	REALMessageBox(XString((char*)pbBuff));
	
	long theTextLength = 0;
	
	if (memoryStream->memoryStream) 
		theTextLength = memoryStream->memoryStream.length();
	
	if (cb > theTextLength) cb = theTextLength;
//	SIGNAL(cb)
	
	//pbBuff [out]
	
	for (int i = 0; i < cb; i++) {
		*(pbBuff + i) = memoryStream->memoryStream.getat(i);
		
	}
	*pcb = cb;
	
	if (memoryStream->memoryStream) 
		memoryStream->memoryStream = memoryStream->memoryStream.midB(cb + 1);
	
//	REALMessageBox(memoryStream->memoryStream);
	
	/* S_OK = 0; S_FALSE = 1; you need to return S_OK when there is more data and S_FALSE when done, not true,
		when streaming in! 
	   Note that this callback is called at least twice with a filled pbBuff from the previous call.
	*/
	

MSG(out StreamInCallback)
/*
	if ((DWORD) (REALstring) memoryStream->memoryStream)
		return S_FALSE;
	else
		return S_OK;
*/
	return (DWORD) (REALstring) memoryStream->memoryStream;
}
//---------------------------------------------------------------------------
// WinAPI callback for streaming text out of the control
//
DWORD CALLBACK StreamOutCallback(DWORD dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb)
{
MSG(in StreamOutCallback)
	MemoryStream* memoryStream = reinterpret_cast<MemoryStream*>(dwCookie);
	memoryStream->visited++;
//	REALMessageBox(XString((char*)pbBuff));
	XString thisWrite = REALBuildString((char*)pbBuff, cb);	
	

/*	
	for (int i = 0; i < cb; i++) {
		thisWrite.setat(i, *(pbBuff + i));
	}
*/

	if ((REALstring)memoryStream->memoryStream) {
		memoryStream->memoryStream = memoryStream->memoryStream.add(thisWrite);
	} else {
		memoryStream->memoryStream = (REALstring)thisWrite;
	}
//	REALMessageBox(memoryStream->memoryStream);
	*pcb = cb;
MSG(out StreamOutCallback)

	if ((DWORD) (REALstring) memoryStream->memoryStream)
		return S_OK;
	else
		return S_FALSE;

}

//---------------------------------------------------------------------------
// copy the text to a stream
//
//   stream - existing TStream (usually a TMemoryStream)
//   selectionOnly - copy only selected text
//   plainText - convert to plain text
//   noObjects - insert spaces in place of OLE objects
//   plainRtf - ignore language-specific RTF codes
//
// note: text is appended to the stream at the current stream position
//
void __fastcall CopyToStream(HWND hwnd, REALstring* stream, WPARAM format)
{
MSG(in CopyToStream)

	MemoryStream memoryStream;	
	memoryStream.visited = 0;
	EDITSTREAM editStream;

	editStream.dwCookie = (DWORD)&memoryStream;
	editStream.dwError = 0;
	editStream.pfnCallback = StreamOutCallback;

	long result = ::PSendMessage(hwnd, EM_STREAMOUT, format, (LPARAM) &editStream);
	SIGNAL(result)
	SIGNAL(editStream.dwError)
	if (editStream.dwError) {
		//ThrowWordGuiseException(editStream.dwError);
//		REALMessageBox(XString(xstring("stream out error: %d, visited: %d", editStream.dwError, memoryStream.visited)));
		*stream = NULL;
		memoryStream.memoryStream.unlock();
	}
	else 
		*stream = (REALstring)memoryStream.memoryStream;
MSG(out CopyToStream)
}
//---------------------------------------------------------------------------
// insert text from a stream into the control
//
//   stream - exisiting stream; note that stream is not rewound prior to
//     inserting the text into the control
//   selectionOnly - replace current selection (if selection empty, inserts
//      text; if false, replaces entire contents of control)
//   plainText - convert to plain text
//   plainRtf - ignore language-specific RTF codes
//
// note: if you CopyToStream(..., plainText = true...) and then paste back
//   from the stream with PasteFromStream(..., plainText = false...), the
//   WinAPI will return an error condition -- that is, you must paste valid
//   RTF when calling this function with plainText = false.
//
void __fastcall PasteFromStream(HWND hwnd, REALstring stream, WPARAM format)
{
MSG(in PasteFromStream)
	XString tocopy = stream;
	XString copied = tocopy.copy(stream);
	
	MemoryStream memoryStream;
	memoryStream.memoryStream = copied;
	memoryStream.visited = 0;
	EDITSTREAM editStream;
/*
	if (selectionOnly) format |= SFF_SELECTION;
	if (plainRtf) format |= SFF_PLAINRTF;
	format |= (plainText) ? SF_TEXT : SF_RTF;
*/
	editStream.dwCookie = (DWORD) &memoryStream;
	editStream.dwError = 0;
	editStream.pfnCallback = StreamInCallback;

	long result = ::PSendMessage(hwnd, EM_STREAMIN, format, (LPARAM) &editStream);
	SIGNAL(editStream.dwError)
//	if (editStream.dwError) ThrowWordGuiseException(editStream.dwError);
//	REALMessageBox(XString(xstring("stream error: %d, visited: %d", editStream.dwError, memoryStream.visited)));
}

Note that MemoryStream is a subclass of a memoryBlock.

Thank you ! I don’t dare to say how many hours I have been searching for it !
#pragma X86CallingConvention StdCall is the solution.
Now, both EM_STREAMIN and EM_STREAMOUT work, I can load and save rtf.

But embedded objects (pictures) in the rtf file are not loaded nor saved.
As far I understand, if I want object insertion operations to work in my RichEdit Control,
I have to supply an IRichEditOleCallback interface and implement the GetNewStorage method.
But how in Xojo ? I created a Class Interface MyIRichEditOleCallback and implemented it in MyRichedit Class.

Dim mi as MyIRichEditOleCallback mi = me

But how to get the pointer of mi ? I need it to send this message :

Declare Function SendMessagePtr Lib "User32" (w Integer, m as Integer, wParam as Integer, lParam as Ptr) as Integer Call SendMessagePtr (mWnd, EM_SETOLECALLBACK, 0, p)
where p should be the pointer to my IRichEditOleCallback object.

I cannot help with that, but if you get it working, I am sure there are a lot of Xojo Windows users who would be very glad to replace the default TextArea. You could even have a market for a third party control…

I think you need to use Xojo’s COM implementation to get a reference to a IRichEditOleCallback COM interface, rather than a Xojo class interface.

OK, I have to create myself an IRichEditCallback interface and implement it for my richedit control.
I know there is no IRichEditCallback interface implemented by default.
An Interface is a virtual method table.

[code] Dim vtable(12) as ptr
vtable(0) = AddressOf U_QueryInterface
vtable(1) = AddressOf U_AddRef
vtable(2) = AddressOf U_Release

vtable(3) = AddressOf GetNewStorage ’ VTable offset = 12
vtable(4) = AddressOf GetInPlaceContext ’ VTable offset = 16
vtable(5) = AddressOf ShowContainerUI’ VTable offset = 20
vtable(6) = AddressOf QueryInsertObject’ VTable offset = 24
vtable(7) = AddressOf DeleteObject’ VTable offset = 28
vtable(8) = AddressOf QueryAcceptData ’ VTable offset = 32
vtable(9) = AddressOf ContextSensitiveHelp ’ VTable offset = 36
vtable(10) = AddressOf GetClipboardData’ VTable offset = 40
vtable(11) = AddressOf GetDragDropEffect ’ VTable offset = 44
vtable(12) = AddressOf GetContextMenu ’ VTable offset = 48

Dim mbv as new MemoryBlock(52)
for i = 0 to 12
mbv.Ptr(4*i) = vtable(i)
next i
Dim pmbv as ptr = mbv
Call SendMessagePtr (mWnd, EM_SETOLECALLBACK, 0, pmbv)
[/code]

How to write the 3 first call back methods ? I tried :

Shared Function U_AddRef (This as ptr) As integer #Pragma X86CallingConvention StdCall Declare Function InterlockedIncrement Lib "kernel32" (lpAddend As ptr) As Integer dim m as MemoryBlock = This m.Int32Value(0) = m.Int32Value(0) + 4 return InterlockedIncrement (This) End Function

U_AddRef method fires !
But the other methods don’t and app hangs as soon I right click, or copy/paste, etc.

I succeeded ! I can now open and save any rtf from or to a file / Database record WITH EMBEDDED OBJECTS !!
Purpose : implement COM IRichEditCallback Interface to get firing of methods I want to override.
The most important method is “GetNewStorage” since it allows to supply a storage for embedded pictures (or objects) to be displayed in the RichEdit (super : TextArea).

Properties

Private mbvtable_Ref As MemoryBlock Private mIRichPtr_Ref As MemoryBlock Private HandleLibrary as Integer

Init Method '(place in Open Event of RichEdit Class)

[code]Private Sub IRichEditOleCallback_Init()
Declare Function SendMessageP Lib “User32” Alias “SendMessageW” ( ByVal wnd as Integer, ByVal msg as Integer, ByVal wParam as Integer, lParam as Ptr ) as Integer

’ Virtual Methods Table
’ ----------------------------
Dim vtable(13) as ptr
vtable(0) = AddressOf U_QueryInterface
vtable(1) = AddressOf U_AddRef
vtable(2) = AddressOf U_Release
vtable(3) = AddressOf IR_GetNewStorage ’ offset = 12
vtable(4) = AddressOf IR_GetInPlaceContext ’ offset = 16
vtable(5) = AddressOf IR_ShowContainerUI ’ offset = 20
vtable(6) = AddressOf IR_QueryInsertObject’ offset = 24
vtable(7) = AddressOf IR_DeleteObject’ offset = 28
vtable(8) = AddressOf IR_QueryAcceptData ’ offset = 32
vtable(9) = AddressOf IR_ContextSensitiveHelp ’ offset = 36
vtable(10) = AddressOf IR_GetClipboardData’ offset = 40
vtable(11) = AddressOf IR_GetDragDropEffect ’ offset = 44
vtable(12) = AddressOf IR_GetContextMenu ’ offset = 48

mbvtable_Ref = new MemoryBlock(56)
Dim pvtable as Ptr = mbvtable_Ref
for i as Int8 = 0 to 12
mbvtable_Ref.ptr(4i) = vtable(i)
next i
vtable(13) = pvtable
mbvtable_Ref.ptr(13
4) = pvtable

mIRichPtr_Ref = new MemoryBlock(8)
mIRichPtr_Ref.Ptr(0) = pvtable
mIRichPtr_Ref.Int32Value (4) = 0 '(initialize the count ref)
Dim pmptr as Ptr = mIRichPtr_Ref

Const EM_SETOLECALLBACK = WM_USER + 70
’ me.handle is the RichEdit/TextArea handle
call SendMessageP(me.Handle , EM_SETOLECALLBACK, 0, pmptr)
End Sub[/code]
(to be followed)[h][/h]

13 Shared Methods of the Com Interface

Private Shared Function U_QueryInterface(pIRichEditOleCallback as ptr, riid As Ptr, byref out As Ptr) As Integer #Pragma X86CallingConvention StdCall return S_OK End Function

[code]Private Shared Function U_AddRef(pIRichEditOleCallback as ptr) As Integer
#Pragma X86CallingConvention StdCall
Declare Function InterlockedIncrement Lib “kernel32” (lpAddend As ptr) As integer

Dim i_pcount as integer = integer(pIRichEditOleCallback ) + 4
Dim m_count as new MemoryBlock(4)
m_count.Int32Value(0) = i_pcount
Dim pcount as Ptr = m_count.Ptr(0)
’ We want to increment the Reference Count
return InterlockedIncrement (pcount)
End Function[/code]

[code]Private Shared Function U_Release(pIRichEditOleCallback as ptr) As Integer
#Pragma X86CallingConvention StdCall
Declare Function InterlockedDecrement Lib “kernel32” (lpAddend As ptr) As integer
Dim rc as Integer

Dim i_pcount as integer = integer(pIRichEditOleCallback ) + 4
Dim m_count as new MemoryBlock(4)
m_count.Int32Value(0) = i_pcount
Dim pcount as Ptr = m_count.Ptr(0)
’ We want to decrement the Reference Count
rc = InterlockedDecrement (pcount)
if rc=0 then
pIRichEditOleCallback = Nil
return 1
else
return 0
end if
End Function[/code]

Private Shared Function IR_GetContextMenu(pIRichEditOleCallback as ptr, ByVal SelType As Integer, ByVal lpoleobj As ptr, lpchrg As integer, lphmenu As Integer) As integer ' Queries the application for a context menu to use on a right mouse down #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_QueryInsertObject(pIRichEditOleCallback as ptr, lpclsid as integer, lpstg as integer, cp as Integer) As Integer ' Queries the application as to whether an object should be inserted. #Pragma X86CallingConvention StdCall return S_OK ' Yes, we'd love to have this object inserted End Function

[code]Private Shared Function IR_GetNewStorage(pIRichEditOleCallback as ptr, byref lplpstg As ptr) As integer
’ Get storage interface for a new object
#Pragma X86CallingConvention StdCall

const STGM_READWRITE = &h2
const STGM_SHARE_EXCLUSIVE = &h10
const STGM_CREATE = &h1000

’ This function creates a byte array object based on global memory
Declare Function CreateILockBytesOnHGlobal LIB “OLE32.DLL” ALIAS “CreateILockBytesOnHGlobal” _
(hGlobal AS Integer, BYVAL fDeleteOnRelease AS Boolean, Byref ppLkbyt AS Ptr) As Integer

’ This function creates and opens a new compound file storage object on top of a byte array object provided by the caller
Declare Function StgCreateDocfileOnILockBytes LIB “OLE32.DLL” ALIAS “StgCreateDocfileOnILockBytes” _
(plkbyt AS Ptr, BYVAL grfMode AS Integer, BYVAL reserved AS Integer, Byref ppstgOpen AS Ptr) AS Integer

Dim rc as Integer
Dim pILockBytes as Ptr
rc = CreateILockBytesOnHGlobal (0, true, pILockBytes)
If rc <> S_OK then return rc

rc = StgCreateDocfileOnILockBytes (pILockBytes, STGM_SHARE_EXCLUSIVE + _ STGM_READWRITE + STGM_CREATE, 0, lplpstg)
return rc
End Function[/code]

Private Shared Function IR_GetClipboardData(pIRichEditOleCallback as ptr, lpchrg As integer, ByVal reco As Integer, lplpdataobj As Ptr) As integer ' Allows the client to supply its own clipboard object #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_QueryAcceptData(pIRichEditOleCallback as ptr, ByVal lpdataobj As ptr, lpcfFormat As Integer, ByVal reco As Integer, ByVal fReally As Integer, ByVal hMetaPict As Integer) As Integer ' Called on a paste or drag to determine if the data pasted/dragged should be accepted #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_GetDragDropEffect(pIRichEditOleCallback as ptr, ByVal fDrag As Integer, ByVal grfKeyState As Integer, pdwEffect As Integer) As integer ' Allows the client to specify the effects of a drop operation #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_DeleteObject(pIRichEditOleCallback as ptr, ByVal lpoleobj As ptr) As Integer ' Notification that an object is about to be deleted from a rich edit control #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_GetInPlaceContext (pIRichEditOleCallback as ptr, lplpFrame As ptr, lplpDoc As ptr, lpFrameInfo As ptr) As Integer #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_ShowContainerUI(pIRichEditOleCallback as ptr, ByVal fShow As Integer) As Integer ' Tells the application whether to display its container user interface #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function

Private Shared Function IR_ContextSensitiveHelp(pIRichEditOleCallback as ptr, ByVal fEnterMode As Integer) As Integer ' Tells the application that it should transition into or out of context sensitive help mode #Pragma X86CallingConvention StdCall return E_NOTIMPL End Function