如何将richedit里面排好版的文字信息保存为位图文件？参与有分！！！

Question

如题，要求将排版好的文字信息(字体、颜色、大小、排版等信息)保存为位图文件，不知道这个能不能实现，要求不要用image控件来输出文字信息实现，可能有点复杂了，如果有好的方法也可以。

Answer 1

本帖最后由 bdmh 于 2010-08-04 10:23:45 编辑

  

Answer 2

问题没难度。可以考虑用：RichEdit1.PaintTo方法。
如果RichEdit里还有图片等，会稍麻烦些，但绝对可以实现。
只给个思路，希望楼主自己研究。暂无兴趣直接帮楼主写代码。

Answer 3

implementation
uses RichEdit;
{$R *.dfm}function PrintRTFToBitmap(ARichEdit: TRichEdit; ABitmap: TBitmap): Longint;
var
  range: TFormatRange;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  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);
end;procedure TForm9.Button1Click(Sender: TObject);
var
  FBitmap: TBitmap;
begin
  FBitmap := TBitmap.Create;
  try
    FBitmap.Width := RichEdit1.Width;
    FBitmap.Height := RichEdit1.Height;
    FBitmap.Transparent := True;
    FBitmap.TransparentMode := tmFixed;
    FBitmap.Canvas.Lock;
    try
      PrintRTFToBitmap(RichEdit1, FBitmap);
    finally
      FBitmap.Canvas.Unlock;
    end;
    FBitmap.SaveToFile('c:/test.bmp');
  except
    FBitmap.Free;
    raise;
  end;
end;http://ask.xuedelphi.com/Html/20108/2010841633786936.html

Answer 4

以下测试通过，给分，呵呵procedure TForm1.Button2Click(Sender: TObject);
var
  can: TCanvas;
  bmp: TBitmap;
begin
  can := TCanvas.Create;
  bmp := TBitmap.Create;
  try
    bmp.Width := RichEdit1.Width;
    bmp.Height := RichEdit1.Height;
    can.Handle := GetDC(RichEdit1.Handle);
    bmp.Canvas.CopyRect(Rect(0,0,RichEdit1.Width,RichEdit1.Height),can,RichEdit1.ClientRect);
    bmp.SaveToFile('F:\RichEdit1.bmp');
  finally
    bmp.Free;
    can.Free;
  end;
  ShowMessage('OK');
end;

Answer 5

var
  can: TCanvas;
  bmp: TBitmap;
begin
  can := TCanvas.Create;
  bmp := TBitmap.Create;
  try
    bmp.Width := RichEdit1.Width;
    bmp.Height := RichEdit1.Height;
    bmp.PixelFormat := pf24bit;
    can.Handle := GetDC(RichEdit1.Handle);
    bmp.Canvas.CopyRect(Rect(0,0,RichEdit1.Width,RichEdit1.Height),can,RichEdit1.ClientRect);
    bmp.SaveToFile('F:\RichEdit1.bmp');
  finally
    bmp.Free;
    can.Free;
  end;
  ShowMessage('OK');
end;

Answer 6

24位的加入下面一句即可
bmp.PixelFormat := pf24bit;

Answer 7

加上这个就解决了24的问题了，现在还要完善一下，过几天在结贴并贴上代码，谢谢大家。
bmp.PixelFormat:=pf24bit;

Answer 8

发现richedit虽然固定了大小，可是如果超过规定的高度就会自动往下滚动，有没有好办法不让它自动滚动，限制输入的高度？

Answer 9

測試通過
var
  can: TCanvas;
  bmp: TBitmap;
begin
  can := TCanvas.Create;
  bmp := TBitmap.Create;
  try
    bmp.Width := RichEdit1.Width;
    bmp.Height := RichEdit1.Height;
   　bmp.PixelFormat := pf24bit；
    can.Handle := GetDC(RichEdit1.Handle);
    bmp.Canvas.CopyRect(Rect(0,0,RichEdit1.Width,RichEdit1.Height),can,RichEdit1.ClientRect);
    bmp.SaveToFile('F:\RichEdit1.bmp');
  finally
    bmp.Free;
    can.Free;
  end;
  ShowMessage('ＰＡＳＳ');
end;

Answer 10

var
 TotalLine,CurLine:integer;
 LineSpacing:integer=2;    // 初始行间距procedure   TForm1.UpdateCursorPos;  //更新行、列信息
var
    CharPos:   TPoint; 
begin
    CharPos.Y   :=   SendMessage(RichEdit1.Handle,   EM_EXLINEFROMCHAR,   0,
        RichEdit1.SelStart);
    CharPos.X   :=   (RichEdit1.SelStart   -
        SendMessage(RichEdit1.Handle,   EM_LINEINDEX,   CharPos.Y,   0));
    Inc(CharPos.Y);
    Inc(CharPos.X);
    CurLine:= CharPos.Y;
end;procedure   TForm1.RE_SetLineSpacing(ARichEdit:   TRichEdit;
    lineSpacing,SpacingRule:   Byte);     //设置行间距
var 
    pf2:   ParaFormat2;
begin 
    FillChar(pf2,   SizeOf(pf2),   0);
    pf2.cbSize   :=   SizeOf(PARAFORMAT2); 
    pf2.dwMask   :=   PFM_LINESPACING; 
    pf2.dyLineSpacing   :=   lineSpacing;
    pf2.bLineSpacingRule:=SpacingRule;
    SendMessage(ARichEdit.Handle,   EM_SETPARAFORMAT,   0,   Longint(@pf2)); 
  
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  RE_SetLineSpacing(RichEdit1,LineSpacing,0);
  TotalLine:= trunc(RichEdit1.Height/(Richedit1.SelAttributes.Height+2*LineSpacing));  //计算当前能够显示的总行数
end;procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  UpdateCursorPos;
   if CurLine>TotalLine then
   begin
    Key:=#0;
    showmessage('out of bound!');
   end;
end;