The following function takes the selected text in a Richedit
control, writes to a TMemoryStream
inside a callback function and then returns as a plain text string the raw rtf code.
var
MS: TMemoryStream; // declared globally and works.
implementation
function GetSelectedRTFCode(RichEdit: TRichedit): string;
function RichEditCallBack(dwCookie: Longint; pbBuff: PByte;
CB: Longint; var pCB: Pointer): Longint; stdcall;
begin
MS.WriteBuffer(pbBuff^, CB);
Result := CB;
end;
var
EditStream: TEditStream;
SL: TStringList;
begin
MS := TMemoryStream.Create;
try
EditStream.dwCookie := SF_RTF or SFF_SELECTION;
EditStream.dwError := 0;
EditStream.pfnCallback := @RichEditCallBack;
Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, DWord(@EditStream));
MS.Seek(0, soBeginning);
SL := TStringList.Create;
try
SL.LoadFromStream(MS);
Result := SL.Text;
finally
SL.Free;
end;
finally
MS.Free;
end;
end;
The above works as expected without any errors.
However, I try to avoid globally declared variables when possible and keep them local to the procedure or function that needs it, but for some reason declaring MS: TMemoryStream;
inside the GetSelectedRTFCode
function fails with Priviliged Instruction and Access Violation errors.
So with that in mind, and the only change below been MS: TMemoryStream;
declared locally fails:
function GetSelectedRTFCode(RichEdit: TRichedit): string;
var
MS: TMemoryStream; // declare here instead of globally but fails.
function RichEditCallBack(dwCookie: Longint; pbBuff: PByte;
CB: Longint; var pCB: Pointer): Longint; stdcall;
begin
MS.WriteBuffer(pbBuff^, CB);
Result := CB;
end;
var
EditStream: TEditStream;
SL: TStringList;
begin
MS := TMemoryStream.Create;
try
EditStream.dwCookie := SF_RTF or SFF_SELECTION;
EditStream.dwError := 0;
EditStream.pfnCallback := @RichEditCallBack;
Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, DWord(@EditStream));
MS.Seek(0, soBeginning);
SL := TStringList.Create;
try
SL.LoadFromStream(MS);
Result := SL.Text;
finally
SL.Free;
end;
finally
MS.Free;
end;
end;
Why would declaring the memory stream variable globally work, but fail when declared locally?
The problem is that your use of a nested function as a callback is wrong. By a chance of implementation using a nested function in that way works for the 32 bit compiler, so long as the nested function does not refer to any local variables of surrounding functions.
However, as soon as the nested function refers to any such local variables, then an extra hidden parameter must be passed so that the nested function can gain access to the surrounding functions stack frames. And for the 64 bit compiler, a hidden extra parameter is always passed.
You'll find lots of examples on the web where people demonstrate passing nested functions as callbacks. But all of these examples break the documented rules of the language:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values, nor can predefined procedures and functions.
What you must do is stop using nested functions for callbacks. You need to declare the callback function as having global scope. Pass the memory stream via the dwCookie
member of the EDITSTREAM
struct.
// This compiles now, but the callback implementation is wrong, see below
function RichEditCallBack(dwCookie: DWORD_PTR; pbBuff: PByte;
CB: Longint; var pCB: Longint): Longint; stdcall;
var
MS: TMemoryStream;
begin
MS := TMemoryStream(dwCookie);
MS.WriteBuffer(pbBuff^, CB);
Result := CB;
end;
function GetSelectedRTFCode(RichEdit: TRichedit): string;
var
MS: TMemoryStream;
EditStream: TEditStream;
SL: TStringList;
begin
MS := TMemoryStream.Create;
try
EditStream.dwCookie := DWORD_PTR(MS);
EditStream.dwError := 0;
EditStream.pfnCallback := RichEditCallBack;
Richedit.Perform(EM_StreamOut, SF_RTF or SFF_SELECTION, LPARAM(@EditStream));
MS.Seek(0, soBeginning);
SL := TStringList.Create;
try
SL.LoadFromStream(MS);
Result := SL.Text;
finally
SL.Free;
end;
finally
MS.Free;
end;
end;
Note in particular that I have not used the @
operator to get the callback function's address. Using the @
operator on a function results in a suppression of type checking. Had you not used the @
operator, then the compiler would have been able to tell you your mistakes.
The compiler would have said:
[dcc32 Error] E2094 Local procedure/function 'RichEditCallBack' assigned to procedure variable
And note also that your code declares the type of the final parameter incorrectly. It's a reference parameter of type Longint
. Again, the compiler can report this, and does report this, unless you have used @
to obtain the function address.
This second error leads on to the implementation of the callback. It is incorrect. The return value indicates success. A value of zero is used to indicate success, any other value indicates failure. The number of bytes written must be returned via the final parameter. Your callback should look like this:
function RichEditCallBack(dwCookie: DWORD_PTR; pbBuff: PByte;
CB: Longint; var CBWritten: Longint): Longint; stdcall;
var
MS: TMemoryStream;
begin
MS := TMemoryStream(dwCookie);
CBWritten := MS.Write(pbBuff^, CB);
Result := IfThen(CB = CBWritten, 0, 1);
end;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With