Прошу помощи с выведением содержимого RichEdit через GetFormImage

[dimofey]

Привет всем. Надеюсь на Вашу помощь.
Имеем: Форму с компонентами Button, RichEdit, Edit и Label.
Нужно: вывести скрин формы в файл графического формата (jpg).
Используется код:

procedure TForm1.Button1Click(Sender: TObject);
 var bmp: TBitmap;
    jpg: TJPEGImage;
    fn: string;
begin
  fn:='test';
  bmp := Screen.ActiveForm.GetFormImage;
  begin
    jpg := TJPEGImage.Create;
    jpg.CompressionQuality := 100;
    jpg.Assign(bmp);
    jpg.SaveToFile(fn+'.jpg');
    FreeAndNil(jpg);
  end;
  FreeAndNil(bmp);
end;

Результат: скрин получен, присутствуют все элементы с надписями, но сам RichEdit пуст. В нем нет текста, вне зависимости от его содержимого. А нужно именно его содержимое. В идеале только его содержимое. То есть, граф.файл, с отображенным в RichEdit текстом.

Спасибо заранее.

[dimofey]

Или, если RichEdit не допускает такого обращения, использовать другой компонент со схожей функциональностью (открыть текстовый файл либо вписать/поравить руками)?

[Stilet]

Я вот так получаю скрины:

unit Unit1;

interface

uses         clipbrd,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function WindowToBMP(WD: HWND;b:Tbitmap): TBitmap;

Var
WinDC: HDC;
ARect   : TRect;
begin
    //Result := TBitmap.Create;             // Создаем рисунок, куда будем копировать
    result:=b;
    GetWindowRect(WD, ARect);            // Узнаем размер
    with Result, ARect do
    begin
        Width := ARect.Right - ARect.Left;
        Height := ARect.Bottom - ARect.Top;
        If (Width=0) or (Height=0) then
        Begin
       //     MessageDlg('Размер области формы равен нулю',
         //   mtWarning,[mbOk],0);    // А вдруг у него нет размера ???
            Exit;                           // Тогда выходим
        End;
        WinDC:=GetWindowDC(Wd);               // получаем для окна контекст устройства
     {   ShowWindow(Wd, SW_SHOW);            // на всякий случай выведем окно
        BringWindowToTop(WD);                  // и поместим поверх окон
      {}  try
        // копируем оттуда прямоугольную область на канву
        // растрового изображения
            BitBlt( Canvas.Handle, 0, 0, Width, Height, WinDC,  0, 0, SRCCOPY);
        finally
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FormImage: TBitmap;
begin
 FormImage:=TBitmap.Create;
 FormImage.Width:=Width;
 FormImage.Height:=Height;
 WindowToBMP(Handle,FormImage);
  try
    Clipboard.Assign(FormImage);
    //Image1.Picture.Assign(Clipboard);
  finally
    FormImage.Free;
  end;
end;

end.

Тут скрин в клипбоард копируется, но смысл в процедурке WindowToBMP

[dimofey]

Сообщение от Stilet

...смысл в процедурке WindowToBMP

То есть, она отрабатывает как надо любой компонент, в т.ч. RichEdit?

[Stilet]

dimofey

А попробовать?

[dimofey]

Сообщение от Stilet

А попробовать?

Попробовал, работает как надо. Премного благодарен.
Кромсаю Ваш код под свои цели. Буфер обмена и геометрия меня не устраивают.

[Stilet]

под свои цели

Ради бога, учитывая что не я автор.

[dimofey]

Еще вопросец: с width и height проблем нет, задал. А вот как задать сдвиг начальным координатам (Left, Right) получаемого изображения, не разберусь никак...

[dimofey]

Нашел ответ в описании функции BitBlt.
Сорри за два поста подряд.