如何在richedit中插入图片呢? 如何在richedit中插入图片呢 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 用剪贴板完成var Bmp : TBitmap;begin if not OpenPictureDialog1.Execute then //打开图象 exit; Bmp := TBitmap.Create; //建立bitmap try try Bmp.LoadFromFile(OpenPictureDialog1.FileName); //装入图象 Clipboard.Assign(BMP); //发送到剪贴板 richEdit.PasteFromClipboard; //richEdit 从剪贴板复制 except application.MessageBox('对不起,该版本目前只支持BMP位图引入!', '系统提示', mb_ok or mb_IconInformation); end; finally Bmp.Free; end;建议使用 RX 组件包提供的 TRxRichEdit http://www.sncelsoft.com/OtherDown/SnAdvRichedit.exe不用上面的方法,效果和QQ,MSN一样。需要和我联系,源代码要购买的。 uses RichEdit;// Stream Callback functiontype TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall; TEditStream = record dwCookie: Longint; dwError: Longint; pfnCallback: TEditStreamCallBack; end;// RichEdit Typetype TMyRichEdit = TRxRichEdit;// EditStreamInCallback callback functionfunction 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;//在RichEdit内插入流procedure PutRTFSelection(RichEdit: TMyRichEdit; 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;//转换位图为RTF代码function BitmapToRTF(pict: TBitmap): string;var bi, bb, rtf: string; bis, bbs: Cardinal; achar: ShortString; hexpict: string; I: Integer;begin GetDIBSizes(pict.Handle, bis, bbs); SetLength(bi, bis); SetLength(bb, bbs); GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^); rtf := '{\rtf1 {\pict\dibitmap '; 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;//例子:从 Image1 插入图片到 RxRichEdit1procedure TForm1.Button1Click(Sender: TObject);var SS: TStringStream; BMP: TBitmap;begin BMP := TBitmap.Create; BMP := Image1.Picture.Bitmap; SS := TStringStream.Create(BitmapToRTF(BMP)); try PutRTFSelection(RxRichEdit1, SS); finally SS.Free; end;end; function ConvertBitmapToRTF(const Bitmap: TBitmap): string;var bi, bb: string; bis, bbs: Cardinal; achar: string[2]; Buffer: string; I: Integer;type PWord = ^Word;begin GetDIBSizes(Bitmap.Handle, bis, bbs); SetLength(bi, bis); SetLength(bb, bbs); GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^); SetLength(Buffer, (Length(bb) + Length(bi)) * 2); i := 1; for bis := 1 to Length(bi) do begin achar := IntToHex(Integer(bi[bis]), 2); PWord(@Buffer[i])^ := PWord(@achar[1])^; inc(i, 2); end; for bbs := 1 to Length(bb) do begin achar := IntToHex(Integer(bb[bbs]), 2); PWord(@Buffer[i])^ := PWord(@achar[1])^; inc(i, 2); end; Result := '{\rtf1 {\pict\dibitmap ' + Buffer + ' }}';end;procedure InsertBitmapIntoRxRichEdit(const Bitmap: TBitmap; const RxRichEdit: TRxRichEdit); overload;begin RxRichEdit.SelText := ConvertBitmapToRTF(Bitmap); RxRichEdit.SelLength := 0; RxRichEdit.SelStart := RxRichEdit.SelStart + 1;end;procedure InsertBitmapIntoRxRichEdit(const GraphicFileName: string; const RxRichEdit: TRxRichEdit); overload;var Bitmap: TBitmap; Graphic: TPicture;begin Graphic := TPicture.Create; try Graphic.LoadFromFile(GraphicFileName); if Graphic.Graphic is TBitmap then Bitmap := Graphic.Bitmap else begin Bitmap := TBitmap.Create; Bitmap.Assign(Graphic.Graphic); end; InsertBitmapIntoRxRichEdit(Bitmap, RxRichEdit); finally if Bitmap <> Graphic.Bitmap then FreeAndNil(Bitmap); FreeAndNil(Graphic); end;end;procedure TForm1.Button1Click(Sender: TObject);begin //InsertBitmapIntoRxRichEdit('C:\Temp\Untitled.bmp', RxRichEdit1); InsertBitmapIntoRxRichEdit('C:\Temp\Untitled-8.jpg', RxRichEdit1); RxRichEdit1.SetFocus;end;end. 关于StrPCopy的问题 100分求:一个托盘控件(能让程序最小化在右下角通知区域)在线等待-见到答案,立刻给分 如何用Delphi获得DOS提示符中的执行结果 如何获取从客户机联线到服务器的连接时间, 如何获取从服务器取资料的时间? 〔求助〕用delphi编写软件时,遇到的窗口问题! 如何解决数据更新时出错? 80分求救!!关于调用程序的问题 请问,如何用winexec调用winzip将一个特定的文件自动解压? oracle8i 求救 发贴必100分,如何检测并安装 框架和数据库 我要作个消费型磁卡程序,不知如何下手 请:allan2002(丸子)接分!
Bmp : TBitmap;
begin
if not OpenPictureDialog1.Execute then //打开图象
exit;
Bmp := TBitmap.Create; //建立bitmap
try
try
Bmp.LoadFromFile(OpenPictureDialog1.FileName); //装入图象
Clipboard.Assign(BMP); //发送到剪贴板
richEdit.PasteFromClipboard; //richEdit 从剪贴板复制
except
application.MessageBox('对不起,该版本目前只支持BMP位图引入!',
'系统提示', mb_ok or mb_IconInformation);
end;
finally
Bmp.Free;
end;
建议使用 RX 组件包提供的 TRxRichEdit
需要和我联系,源代码要购买的。
RichEdit;// 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;// RichEdit Type
type
TMyRichEdit = TRxRichEdit;// 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
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;//在RichEdit内插入流
procedure PutRTFSelection(RichEdit: TMyRichEdit; 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;//转换位图为RTF代码
function BitmapToRTF(pict: TBitmap): string;
var
bi, bb, rtf: string;
bis, bbs: Cardinal;
achar: ShortString;
hexpict: string;
I: Integer;
begin
GetDIBSizes(pict.Handle, bis, bbs);
SetLength(bi, bis);
SetLength(bb, bbs);
GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
rtf := '{\rtf1 {\pict\dibitmap ';
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;
//例子:从 Image1 插入图片到 RxRichEdit1
procedure TForm1.Button1Click(Sender: TObject);
var
SS: TStringStream;
BMP: TBitmap;
begin
BMP := TBitmap.Create;
BMP := Image1.Picture.Bitmap;
SS := TStringStream.Create(BitmapToRTF(BMP));
try
PutRTFSelection(RxRichEdit1, SS);
finally
SS.Free;
end;
end;
function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
var
bi, bb: string;
bis, bbs: Cardinal;
achar: string[2];
Buffer: string;
I: Integer;
type
PWord = ^Word;
begin
GetDIBSizes(Bitmap.Handle, bis, bbs);
SetLength(bi, bis);
SetLength(bb, bbs);
GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^);
SetLength(Buffer, (Length(bb) + Length(bi)) * 2);
i := 1;
for bis := 1 to Length(bi) do
begin
achar := IntToHex(Integer(bi[bis]), 2);
PWord(@Buffer[i])^ := PWord(@achar[1])^;
inc(i, 2);
end;
for bbs := 1 to Length(bb) do
begin
achar := IntToHex(Integer(bb[bbs]), 2);
PWord(@Buffer[i])^ := PWord(@achar[1])^;
inc(i, 2);
end;
Result := '{\rtf1 {\pict\dibitmap ' + Buffer + ' }}';
end;procedure InsertBitmapIntoRxRichEdit(const Bitmap: TBitmap; const RxRichEdit:
TRxRichEdit); overload;
begin
RxRichEdit.SelText := ConvertBitmapToRTF(Bitmap);
RxRichEdit.SelLength := 0;
RxRichEdit.SelStart := RxRichEdit.SelStart + 1;
end;procedure InsertBitmapIntoRxRichEdit(const GraphicFileName: string; const
RxRichEdit: TRxRichEdit); overload;
var
Bitmap: TBitmap; Graphic: TPicture;
begin
Graphic := TPicture.Create;
try
Graphic.LoadFromFile(GraphicFileName); if Graphic.Graphic is TBitmap then
Bitmap := Graphic.Bitmap
else
begin
Bitmap := TBitmap.Create;
Bitmap.Assign(Graphic.Graphic);
end; InsertBitmapIntoRxRichEdit(Bitmap, RxRichEdit);
finally
if Bitmap <> Graphic.Bitmap then
FreeAndNil(Bitmap); FreeAndNil(Graphic);
end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
//InsertBitmapIntoRxRichEdit('C:\Temp\Untitled.bmp', RxRichEdit1);
InsertBitmapIntoRxRichEdit('C:\Temp\Untitled-8.jpg', RxRichEdit1);
RxRichEdit1.SetFocus;
end;end.