RxRichEdit,Rich98插入图像完全解决方案[Delphi]!

2019-07-14 12:39发布

uses RichEdit; type TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall; TEditStream = record dwCookie: Longint; dwError: Longint; pfnCallback: TEditStreamCallBack; end; 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 begin dataAvail := Size - Position; 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; procedure PutRTFSelection(RichEdit: TRxRichEdit; SourceStream: TStream); var EditStream: TEditStream; begin with EditStream do begin dwCookie := Longint(SourceStream); dwError := 0; pfnCallback := EditStreamInCallBack; end; RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream)); end; function BmpToRTF(Pict: TBitmap): string; var bi, bb, rtf: string; bis, bbs: Cardinal; achar: ShortString; hexpict: string; I: Integer; begin Pict.PixelFormat := pf8bit; GetDIBSizes(Pict.Handle, bis, bbs); SetLength(bi, bis); SetLength(bb, bbs); GetDIB(Pict.Handle, Pict.Palette, PChar(bi)^, PChar(bb)^); rtf := '{/rtf1{/pict/dibitmap' + #13#10; SetLength(hexpict, (Length(bb) + Length(bi)) * 2); I := 2; for bis := 1 to Length(bi) do begin achar := Format('%x', [Integer(bi[bis])]); if Length(achar) = 1 then achar := '0' + achar; hexpict[I - 1] := achar[1]; hexpict[I] := achar[2]; Inc(I, 2); end; for bbs := 1 to Length(bb) do begin achar := Format('%x', [Integer(bb[bbs])]); if Length(achar) = 1 then achar := '0' + achar; hexpict[I - 1] := achar[1]; hexpict[I] := achar[2]; Inc(I, 2); end; rtf := rtf + hexpict + '}}'; Result := rtf; end; procedure TForm1.Button1Click(Sender: TObject); var Temp: TStringStream; begin Temp := TStringStream.Create(BmpToRTF(Image1.Picture.Bitmap)); try PutRTFSelection(RxRichEdit1, Temp); finally Temp.Free; end; end; procedure TForm1.Button2Click(Sender: TObject); begin RichEdit981.RTFSelText := BmpToRTF(Image1.Picture.Bitmap); end; 插入静态Jpeg,Gif(TGifimage)可以转成TBitmap格式,动态需要自己写Gif Ole