RichEdit 与 Bmp

{
  Sometimes you need to draw RichEdit control upon TImage canvas.
  Maybe to manipulate it like create transparent RichEdit control
  or other manipulate trick.  But you don't know how to convert
  RichEdit control into Bitmap.

  Here's the solution to convert RichEdit control into bitmap.
}

uses RichEdit;
// Sonic Delphi
// [e-mail]


function RTFtoBitmap(myRTF: TRichEdit; GiveSpaceForBorder: Integer): TBitmap;

  // using myRTF parameter with your TRichEdit control name,
  // default name "RichEdit1".
  // For GiveSpaceForBorder parameter, sometimes you need to draw
  // the RichEdit control with rectangle colorfull border, so you need
  // to give space for it.
var
  myRect: TRect;
  temp: TBitmap;
begin
  temp := TBitmap.Create;

  myRect := myRTF.ClientRect;
  // if you are using PRF_NONCLIENT parameter in myRTF.perform command
  // using this statement
  // myRect := Rect(0,0,MyRTF.Width,MyRTF.Height);

  temp.Width  := myRect.Right;
  temp.Height := myRect.Bottom;
  with temp.Canvas do
  begin
    Lock;
    try
      myRTF.Perform(WM_PRINT, Handle, PRF_CLIENT);
      //you can trying to change PRF_CLIENT with
      //PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT or PRF_ERASEBKGND
      //or combine them. See what happen...
    finally
      Unlock
    end;
  end;
  Result := TBitmap.Create;
  Result := CreateEmptyBmp(clWhite,
    temp.Width + GiveSpaceForBorder * 2,
    temp.Height + GiveSpaceForBorder * 2);
  Result.Canvas.Lock;
  Result.Canvas.Draw(GiveSpaceForBorder, GiveSpaceForBorder, temp);
  Result.Canvas.Unlock;
  temp.Free;
end;


// Here's to put colorfull border
procedure MakeBorder(const bdr: TBitmap; BorderWidth: Integer; BorderColor: TColor);
begin
  with bdr.Canvas do
  begin
    Brush.Style := bsClear;
    pen.Width := BorderWidth;
    pen.Color := BorderColor;
    rectangle(BorderWidth - 1, BorderWidth - 1, bdr.Width, bdr.Height);
  end;
end;


// Example how to using it
//
// var bmp : TBitmap;
// begin
//   bmp := RTFtoBitmap(RichEdit1,2);
//   MakeBorder(bmp,2,clBlue);
//   Image1.Canvas.Draw(5,5,bmp);
//   bmp.free;
// end;
//
//
// Hey, how to make it transparent ??
// Hmm.. think it by yourself.
// I can only giving you one starting solution.. hehe

『-----------------------------------------------------------』

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;