//======================== begin: stream callback for Get/PutRTFselection
// (this code section must precede any use of Get/PutRTFselection)
// by Peter Below (TeamB) < 100113.1...@compuserve.com >
// Stream Callback function
type
TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint
): DWORD; stdcall;
TEditStream = record
dwCookie: Longint;
dwError: Longint;
pfnCallback: TEditStreamCallBack;
end;
// EditStreamOutCallback callback function
function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint
): DWORD; stdcall;
var theStream: TStream;
begin
theStream:= TStream(dwCookie);
with theStream do
begin
If cb > 0 Then
begin
pcb:= Write(pbBuff^, cb);
Result:= pcb;
end else Result:= 0;
end;
end;
// EditStreamInCallback callback function
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint
): DWORD; stdcall;
var
theStream: TStream;
dataAvail: LongInt;
begin
theStream:= TStream(dwCookie);
with theStream do // open theStream attributes for access; ie. theStream.size
begin
dataAvail:= Size - Position; // size & position are attributes of "theStream"; ie. theStream.size
Result:= 0;
if dataAvail<=cb then
begin
pcb:= read(pbBuff^, dataAvail);
if pcb<>dataAvail then Result:= UINT(E_FAIL);
end
else
begin
pcb:= read(pbBuff^, cb);
if pcb<>cb then Result:= UINT(E_FAIL);
end;
end;
end;
// copyout Stream from RichEdit: uses stream callback above
Procedure GetRTFSelection(Amemo: TRichMemo; IntoStream: TStream);
Var editstream: TEditStream;
Begin
with editstream Do
Begin
dwCookie:= Longint(IntoStream);
dwError:= 0;
pfnCallback:= @EditStreamOutCallBack;
end;
Amemo.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@EditStream));
End;
// Insert Stream into RichEdit: uses stream callback above
procedure PutRTFSelection(Amemo: TRichMemo; SourceStream: TStream);
var EditStream: TEditStream;
begin
with EditStream do
begin
dwCookie:= Longint(SourceStream);
dwError:= 0;
pfnCallback:= @EditStreamInCallBack;
end;
Amemo.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end;
//=================================== end: stream callback for Get/PutRTFselection
//=========== begin: my application of the functions
procedure TCmdForm.CopyPageMemo; // PageMemo to SearchBox & ReplaceBox
var MS: TMemoryStream; { TMemoryStream use by typo;
https://forum.lazarus.freepascal.org/index.php?topic=26425.45 }
begin
SearchBox.Clear;
// PageMemo section already selected
MS:= TMemoryStream.Create; { TMemoryStream use by Author: typo }
try
GetRTFSelection(PageMemo,MS); // PageMemo is an RTF container
MS.Position:= 0; { TMemoryStream use by Author: typo }
PutRTFSelection(SearchBox,MS); // SearchBox is an RTF container
finally
MS.Free;
PageMemo.SelLength:= 0;
end;
end;
//=========== end: my application of the functions
Recent
