Столкнулся с проблемой: компонент TRichEdit в Delphi 10 при приеме данных из потока (через socket) не отображает текст в RTF формате, а отображает rtf-код. Использовать сторонние компоненты не хотелось и нагуглилось вот такое решение:
implementation
{$R *.dfm}
function EditStreamCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint;
stdcall;
var
MS : TMemoryStream;
begin
MS := TMemoryStream(dwCookie);
result := 0;
with MS do begin
if (Size = position) then begin
pcb := 0;
Exit;
end
else if (Size - Position) <= cb then begin
pcb := Size;
Read(pbBuff^, Size);
end
else begin
pcb := cb;
Read(pbBuff^, cb);
end;
end;
end;
function REFetchText(RE: TRichEdit; const Text: string): integer;
var
ES : TEditStream;
MS : TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.Write(Text[1], Length(Text));
MS.Seek(0, soFromBeginning);
ES.dwCookie := longint(MS);
ES.dwError := 0;
ES.pfnCallback := @EditStreamCallback;
result := SendMessage(RE.Handle, EM_STREAMIN, SF_RTF or SFF_SELECTION,
longint(@ES));
finally
MS.Free;
end;
end;
type
TREPutAction = (paAppend, paInsert, paReplace);
function REPutText(RE: TRichEdit; const Text: string; PutAction: TREPutAction): integer;
begin
result := -1;
if Text = '' then
exit;
case PutAction of
paAppend : begin
RE.Lines.Append(' ');
RE.SelStart := SendMessage(RE.Handle, EM_LINEINDEX, RE.Lines.Count - 1, 0);
RE.SelLength := 1;
end;
paInsert : begin
if RE.SelLength > 0 then
RE.SelText := RE.SelText +#32
else
RE.SelText := #32;
RE.SelStart := RE.SelStart +RE.SelLength -1;
RE.SelLength := 1;
end;
paReplace : begin
if RE.SelLength > 0 then
RE.SelText := #32;
end;
end;
Result := REFetchText(RE, Text);
end;
function REAppendFile(RE: TRichEdit; const Filename: string): integer;
var
FS : TFileStream;
len : int64;
s : string;
begin
result := -1;
s := '';
FS := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
try
len := FS.Size;
if len > 0 then begin
FS.Position := 0;
SetLength(s, len);
FS.Read(s[1], len);
end;
finally
FS.Free;
end;
if s <> '' then
result := REPutText(RE, s, paAppend);
end;
function StreamToString(Stream : TStream) : String;
var ms : TMemoryStream;
begin
Result := '';
ms := TMemoryStream.Create;
try
ms.LoadFromStream(Stream);
SetString(Result,PChar(ms.memory),ms.Size);
finally
ms.free;
end;
end;
......
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
fs:TMemoryStream;
L:integer;
buf: pointer;
s: string;
begin
fs := TMemoryStream.Create();
try
L := ClientSocket1.Socket.ReceiveLength;
fs.SetSize(L);
GetMem(buf, L);
fs.Position := 0;
L := ClientSocket1.Socket.ReceiveBuf(buf^, L);
fs.Write(buf^, L);
fs.Position:=0;
RichEdit1.Clear;
Richedit1.DoubleBuffered:=false;
RichEdit1.MaxLength := fs.Size;
RichEdit1.PlainText := False;
S:=StreamToString(fs);
REPutText(RichEdit1, s, paReplace);
RichEdit1.PlainText := False;
finally
fs.free;
freeMem(buf);
end;
end;
