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