2008. szeptember 15., hétfő

Create a *.jpg image from a TRichEdit


Problem/Question/Abstract:

How to create a *.jpg image from a TRichEdit

Answer:

uses
  RichEdit;

procedure RichEditToJPEG(const aRichEdit: TRichEdit; const aJPEGImage: TJPEGImage);
var
  lBMP: TBitmap;
  liStyle: Integer;
  liExStyle: Integer;
  lR: TRect;
  liTwipsPerPixel: Integer;
  lfrFormatRange: TFormatRange; { Defined in RichEdit }
begin
  lBMP := TBitmap.Create;
  try
    lBMP.Height := aRichEdit.Height;
    lBMP.Width := aRichEdit.Width;
    { Paint the richedit control's border }
    aRichEdit.PaintTo(lBMP.Canvas.Handle, 0, 0);
    { Store the richedit's window styles }
    liStyle := GetWindowLong(aRichEdit.Handle, GWL_STYLE);
    liExStyle := GetWindowLong(aRichEdit.Handle, GWL_EXSTYLE);
    { Get canvas rect and adjust for the richedit's border if necessary }
    lR := lBMP.Canvas.ClipRect;
    if ((liStyle and WS_BORDER) <> 0) or ((liExStyle and WS_EX_CLIENTEDGE) <> 0) then
    begin
      Inc(lR.Left, GetSystemMetrics(SM_CXEDGE));
      Inc(lR.Top, GetSystemMetrics(SM_CYEDGE));
      Dec(lR.Right, lR.Left);
      Dec(lR.Bottom, lR.Top);
    end;
    { Adjust richedit's border by another pixel }
    InflateRect(lR, -1, -1);
    { We need twips to calculate sizes }
    liTwipsPerPixel := 1400 div Screen.PixelsPerInch;
    { Fill the TFormatRange record }
    with lfrFormatRange do
    begin
      hdc := lBMP.Canvas.Handle;
      hdcTarget := lBMP.Canvas.Handle;
      { Convert the coordinates to twips }
      rc := Rect(lR.Left * liTwipsPerPixel, lR.Top * liTwipsPerPixel,
        lR.Right * liTwipsPerPixel, lR.Bottom * liTwipsPerPixel);
      rcPage := rc;
      chrg.cpMin := 0;
      chrg.cpMax := -1;
    end;
    aRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    aRichEdit.Perform(EM_FORMATRANGE, 0, DWORD(@lfrFormatRange));
    aRichEdit.Perform(EM_FORMATRANGE, 1, DWORD(@lfrFormatRange));
    aRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    aJPEGImage.Assign(lBMP);
  finally
    lBMP.Free;
  end;
end;

Nincsenek megjegyzések:

Megjegyzés küldése