首页  编辑  

Richedit里面的内容保存为图形

Tags: /超级猛料/VCL/Memo&Edit&Richedit/RichEdit、RxRichEdit/   Date Created:

得到Richedit里面的内容保存为图形!

uses richedit ;

procedure TForm1 . Button1Click ( Sender : TObject );

var

 Range             : TFormatRange ;

 LastChar , MaxLen , LogX , LogY : Integer ;

begin

 FillChar ( Range , SizeOf ( TFormatRange ), 0 );

  with Image1 , Range do

  begin

   LogX := GetDeviceCaps ( Canvas . Handle , LOGPIXELSX );

   LogY := GetDeviceCaps ( Canvas . Handle , LOGPIXELSY );

   hdc := Canvas . Handle ;

   hdcTarget := hdc ;

   rc . right := Image1 . ClientWidth * 1440 div LogX ;

   rc . bottom := Image1 . ClientHeight * 1440 div LogY ;

   rcPage := rc ;

   LastChar := 0 ;

   MaxLen := GetTextLen ;

   chrg . cpMax := - 1 ;

    repeat

     chrg . cpMin := LastChar ;

     LastChar := SendMessage ( RichEdit1 . Handle , EM_FORMATRANGE , 1 ,

       Longint (@ Range ));

    until ( LastChar >= MaxLen ) or ( LastChar = - 1 );

  end ;

 SendMessage ( RichEdit1 . Handle , EM_FORMATRANGE , 0 , 0 );

 Image1 . Refresh ;

end ;

---------------------------------------

{

 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

// soulyx@yahoo.com

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   := tebal;

   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