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

原创 2004年07月25日 18:23:00
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

企业级 Web 网站安全解决方案揭秘

在 3 月 10 日举办的阿里云网站热点研讨会上,阿里云资深安全业务架构师蕴藉就网站 Web 应用的安全性及业务可用性进行了一系列细致的讲解和介绍,接下来我们就来共同了解一下他分享的内容。 以下...
  • yushengjun_644
  • yushengjun_644
  • 2017年08月04日 19:59
  • 2313

delphi读取和写入文件-richedit控件

需要两个按钮和两个Richedit控件,采用默认名称即可. procedure TForm1.Button1Click(Sender: TObject);  //写文件 var wText...
  • hushiwei1993
  • hushiwei1993
  • 2015年12月03日 16:48
  • 1167

数据中心解决方案安全技术

技术特色 在这种咄咄逼人的安全形势下,数据中心需要一个全方位一体化的安全部署方式。H3C数据中心安全解决方案秉承了H3C一贯倡导的“安全渗透理念”,将安全部署渗透到整个数据中心的设计、部署、运维中,...
  • permike
  • permike
  • 2016年04月14日 16:00
  • 8845

DELPHI存取JPEG、BMP图像到数据库完整解决方案

  • 2004年04月29日 00:00
  • 37KB
  • 下载

QuickReport Delphi7完全解决方案

前言       本人很不喜欢QuickReport,因为其有太多问题,也太不灵活。但在开发过程中,还是无法避免接触到这种问题,特别是历史遗留下来的控件,几乎是不可能把那么多的报表去换成其他报表控件...
  • pengxuan
  • pengxuan
  • 2011年10月02日 16:34
  • 6002

DELPHI存取JPEG、BMP图像到数据库完整解决方案

  • 2006年02月23日 09:05
  • 33KB
  • 下载

DELPHI存取JPEG、BMP图像到数据库完整解决方案

程序代码如下所示: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graph...
  • my98800
  • my98800
  • 2016年08月15日 16:19
  • 2489

局域网网络完全解决方案

  • 2007年06月21日 15:45
  • 847KB
  • 下载

数据分页程序完全解决方案(含普通分页/分段分页/原始分页/since_id分页)

  • 2012年07月18日 03:49
  • 19KB
  • 下载

Tomcat tcnative-1.dll 完全解决方案

  • 2010年05月22日 18:07
  • 662KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:RxRichEdit,Rich98插入图像完全解决方案[Delphi]!
举报原因:
原因补充:

(最多只允许输入30个字)