Содержание материала

Code:

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;

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить