delphi RichEdit的内容保存为图片


uses RichEdit;

{将RichEdit1的内容保存为图片,此函数也适合于RxRichEdit,即RichEdit: TRxRichEdit}
procedure RichEditToCanvas(RichEdit: TRichEdit; Canvas: TCanvas; PixelsPerInch: Integer);
var
ImageCanvas: TCanvas;
fmt: TFormatRange;
begin
ImageCanvas := Canvas;
with fmt do
begin
hdc:= ImageCanvas.Handle;
hdcTarget:= hdc;
rc:= Rect(0, 0,
ImageCanvas.ClipRect.Right * 1440 div PixelsPerInch,
ImageCanvas.ClipRect.Bottom * 1440 div PixelsPerInch
);
rcPage:= rc;
chrg.cpMin := 0;
chrg.cpMax := RichEdit.GetTextLen;
end;
SetBkMode(ImageCanvas.Handle, TRANSPARENT);
RichEdit.Perform(EM_FORMATRANGE, 1, Integer(@fmt));
RichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RichEditToCanvas(RichEdit1, Image1.Canvas, Self.PixelsPerInch);
Image1.Refresh;
end;


TRichEdit的打印预览


Rich Edit控件(我们说的是标准的Windows控件,不是一个Delphi构件)包含内置的打印特性,可以使用这个特性向打印机传送格式化的文本,或是通过程序员稍微地努力就可将它的内容绘制到任何Canvas上。

当然,标准的Delphi TRichEdit构件封装了这一特性。我们可以使用这一可能性来制作一个快速的比例缩放的打印预览,或者将Rich Text绘制到任何Delphi控件上。

将Rich Edit控件绘制到任何Canvas上,涉及使用标准Rich Edit控件消息EM_FORMATRANGE。

这个消息的lParam参数是一个指向TFormatRange纪录的指针。在将消息传递给RichEdit之前,必须填充这个记录。

TFORMATRANGE记录包含一个rich edit控件用于格式化输出它的内容到特定设备的信息。这里的

hdc —— 要渲染的设备。

HdcTarget —— 要格式化的目标设备。

rc —— 要渲染的区域。使用的测量单位是缇。缇是一种不受屏幕约束(screen-independent)的单位,以确保屏幕元素的比例在所有显示系统上都相同。一缇被定义为一英寸的1/1440。

RcPage —— 渲染设备的整个区域。使用的测量单位是缇。

chrg —— TCHARRANGE记录指定了格式化文本的范围。

这个记录通常被EM_EXGETSEL和EM_EXSETSEL消息使用,它包含两个域:cpMin和cpMax。
 
cpMin 是一个字符位置索引,直接位于范围内第一个字符之前。

cpMax 是一个字符位置索引,直接位于范围内最后一个字符之后。

打印一个Rich Edit控件到一个位图上用于预览

 


完整页代码:
   unit Unit1;  
      
    interface  
      
   uses  
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
   Dialogs, StdCtrls, ComCtrls, ExtCtrls, RichEdit;  
     
    type  
  TForm1 = class(TForm)  
  Button1: TButton;  
  Button2: TButton;  
   Image1: TImage;  
  RichEdit1: TRichEdit;  
  procedure Button1Click(Sender: TObject);  
  procedure Button2Click(Sender: TObject);  
  private  
   { Private declarations }  
   public  
  { Public declarations }  
   end;  
   
 var  
   Form1: TForm1;  
 
  implementation  
    
   {$R *.dfm}  
     
  function PrintRTFToBitmap(ARichEdit : TRichEdit; ABitmap : TBitmap) : Longint;

var
  range : TFormatRange;
begin
   FillChar(Range, SizeOf(TFormatRange), 0);
   // 渲染我们要测量的相同DC。
   Range.hdc        := ABitmap.Canvas.handle;
   Range.hdcTarget  := ABitmap.Canvas.Handle;
   // 设定页。
   Range.rc.left    := 0;
   Range.rc.top     := 0;
   Range.rc.right   := ABitmap.Width * 1440 div Screen.PixelsPerInch;
   Range.rc.Bottom  := ABitmap.Height * 1440 div Screen.PixelsPerInch;

   // 打印文本的缺省范围为整个文档。
   Range.chrg.cpMax := -1;
   Range.chrg.cpMin := 0;

   // 格式化文本。
   Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));

   // 释放缓冲信息。
   SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
   //Image1.Refresh;
end;
 // 接下来的实例显示了不只是如何将Rich Edit绘制到任何Canvas上,还包括如何只绘制选择的文本范围。

function PrintToCanvas(ACanvas : TCanvas; FromChar, ToChar : integer;

                      ARichEdit : TRichEdit; AWidth, AHeight : integer) : Longint;
var
  Range : TFormatRange;
begin
    FillChar(Range, SizeOf(TFormatRange), 0);
    Range.hdc        := ACanvas.handle;
    Range.hdcTarget  := ACanvas.Handle;
    Range.rc.left    := 0;
    Range.rc.top     := 0;
    Range.rc.right   := AWidth * 1440 div Screen.PixelsPerInch;
    Range.rc.Bottom  := AHeight * 1440 div Screen.PixelsPerInch;
    Range.chrg.cpMax := ToChar;
    Range.chrg.cpMin := FromChar;
    Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
   SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;
  {use PrintRTFToBitmap function}  
 procedure TForm1.Button1Click(Sender: TObject);  
   var  
   Bmp: TBitmap;  
  begin  
   Bmp := TBitmap.Create;  
   bmp.Width := RichEdit1.ClientWidth;  
   bmp.Height := RichEdit1.ClientHeight;  
  PrintRTFToBitmap(RichEdit1, Bmp);  
 Image1.Canvas.Draw(0, 0, Bmp);  
   bmp.Free;  
  end;  
    
  {use PrintToCanvas function}  
  procedure TForm1.Button2Click(Sender: TObject);  
   var  
    Bmp: TBitmap;  
   begin  
      Bmp := TBitmap.Create;  
      bmp.Width := RichEdit1.ClientWidth;  
      bmp.Height := RichEdit1.ClientHeight;  
      PrintToCanvas(bmp.Canvas, 0, Length(RichEdit1.Text), RichEdit1, Bmp.Width, Bmp.Height);  
       Image1.Canvas.Draw(0, 0, Bmp);  
       bmp.Free;  
   end;  
     
  end.  

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
不用第三方控件,让richEdit支持图片与表格换行 DELPHI 6 提供的RICHEDIT是1.0,并不支持图片,对复杂表格也会乱成一团,如何在DELPHI原有控件的基础上做少量修改,使之支持显示图片与正确显示表格,其实只需要几行就好了,方法如下: 找到richEdit控件所在单元ComCtrls.pas (在SOURCE\VCL) //第一步 procedure TCustomRichEdit.CreateParams(var Params: TCreateParams); const // RichEditModuleName = 'RICHED32.DLL';//原来语句 // RichEditClassName = 'RICHEDIT'; //原来语句 RichEditModuleName = 'Msftedit.dll'; //改后语句 RichEditClassName = 'RichEdit50W'; //改后语句 //第二步 procedure TCustomRichEdit.CreateWnd; .... //加入一行要放在 CreateWnd 因为此时 HANDLE已建立 Perform(EM_SetOleCallback, 0, Longint(TRichEditOleCallback.Create(TRichEdit(self)) as IRichEditOleCallback)) ; //第三步 procedure TCustomRichEdit.WMRButtonUp(var Message: TWMRButtonUp); begin inherited; // RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, // so we get no WM_CONTEXTMENU message. Simulate message here. // if Win32MajorVersion < 5 then //是原有1.0的要去掉 Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint( ClientToScreen(SmallPointToPoint(Message.Pos))))); end; //第四步 procedure TRichEditStrings.Insert(Index: Integer; const S: string); .... //要去掉后面两名 // 1.0 uses, 2.0 will error happened 2011 // if RichEdit.SelStart (Selection.cpMax + Length(Str)) then //是原有1.0的要去掉 // raise EOutOfResources.Create(sRichEditInsertError); //是原有1.0的要去掉

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值