Показать сообщение отдельно
  #5  
Старый 26.01.2012, 21:54
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Содранная вами с DelphiWorld процедура несколько не полна.
Вот полный её код:
Код:
uses
   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;
// by P. Below 
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;

// Insert Stream into RichEdit 
procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
   // by P. Below 
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;

// Convert Bitmap to RTF Code 
function BitmapToRTF(pict: TBitmap): string;
// by D3k 
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;


// Example to insert image from Image1 into 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;
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием