Картинка в Richedit

← →
Stas1 (2003-12-09 17:46) [0]

Можно ли вставить картинку в RichEdit?
Если да, то как? Если нет, то что посоветуете в замен?
Мне нужно в текстовое поле вставить картинку.
Спасибо!

← →
Adoon (2003-12-09 17:59) [1]

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;

procedure TCourseForm.InsertPictureClick(Sender: TObject);
VAR i: Integer;
SS:TStringStream;
P: TPicture;
BMP: TBitMap;
jpg: TJpegImage;
BEGIN
if OpenPictureDlg.Execute then begin
try
if (Pos(".bmp", OpenPictureDlg.FileName) > 0) then begin
BMP := TBitMap.Create;
P := TPicture.Create;
P.LoadFromFile(OpenPictureDlg.FileName);
BMP.Assign(P.Bitmap);
SS := TStringStream.Create(BitmapToRTF(BMP));
try
RichEdit.PlainText := False;
RichEdit.StreamMode := [smSelection];
RichEdit.Lines.LoadFromStream(SS);
RichEdit.StreamMode := [];
finally
SS.Free;
BMP.Free;
P.Free;
end
end
else begin
jpg := TJPEGImage.Create;
jpg.LoadFromFile(OpenPictureDlg.FileName);
BMP := TBitMap.Create;
BMP.Assign(jpg);
SS := TStringStream.Create(BitmapToRTF(BMP));
try
RichEdit.PlainText := False;
RichEdit.StreamMode := [smSelection];
RichEdit.Lines.LoadFromStream(SS);
RichEdit.StreamMode := [];
finally
SS.Free;
jpg.Free;
BMP.Free;
end
end;
finally
end;
end;
end;

Картинка в Richedit Найти похожие ветки