Столкнулся с проблемой: компонент TRichEdit в Delphi 10 при приеме данных из потока (через socket) не отображает текст в RTF формате, а отображает rtf-код. Использовать сторонние компоненты не хотелось и нагуглилось вот такое решение:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 |
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; |
