Ещё раз о скриншотах

@shyub · Регистрация: 11.07.2013

Несколько дней назад форумчанен ПраПрапорщик поднимал эту тему, но закончилась она как-то не интересно. А тема, в принципе, очень интересная. Хотелось бы её продолжить, тем более не всё повторенное из Delphi однозначно работает в Лазарусе.
И так: захватываю своё окно (код рабочий)

Delphi

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Windows, Graphics, Dialogs, StdCtrls,
  extctrls; // Описание TImage.
......
procedure TForm1.FormPaint(Sender: TObject);
begin
 Form1.Canvas.TextOut(5,5,'Здесь может быть любое обращение к канве.');
end;
......
procedure TForm1.Button1Click(Sender: TObject);
var
  Img: TImage;
  Rect: TRect;
begin
  Form1.FormPaint(Sender); // Если не сделать перерисовку, то файл содержит только заголовок.
  Img:=TImage.Create(Form1);
  Img.Width:=Form1.Canvas.Width;
  Img.Height:=Form1.Canvas.Height;
  Rect:=Form1.Canvas.ClipRect;
  Img.Canvas.CopyRect(Rect, Form1.Canvas, Rect);
  Img.Canvas.TextOut(5,130,'Скриншот окна снят '+DateToStr(Date)+' / '+TimeToStr(Time));
  Img.Picture.SaveToFile('C:\ScreenWin.bmp');
  FreeAndNil(Img);
end;

Теперь делаю проще (файл сохраняется, но кроме заголовка ничего не содержит):

Delphi

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Windows, Graphics, Dialogs, StdCtrls,
  extctrls; // Описание TImage.
......
procedure TForm1.Button1Click(Sender: TObject);
var
  Img: TImage;
  Rect: TRect;
begin
  Img:=TImage.Create(Form1);
  Img.Width:=Form1.Canvas.Width;
  Img.Height:=Form1.Canvas.Height;
  Rect:=Form1.Canvas.ClipRect;
  Img.Canvas.CopyRect(Rect, Form1.Canvas, Rect);
  Img.Canvas.TextOut(5,130,'Скриншот окна снят '+DateToStr(Date)+' / '+TimeToStr(Time));
  Img.Picture.SaveToFile('C:\ScreenWin.bmp');
  FreeAndNil(Img);
end;

... И в bmp-файле кроме заголовка ничего больше нет.
Теперь вопрос: Почему в первом случае всё работает, а во втором (без предварительного какого-нибудь "бестолкового" обращения к канве) - нет?

@volvo · 03.04.2016, 21:50

Вот этот код что показывает:

Pascal

var
  bm: Graphics.TBitmap;
begin
  bm:=Graphics.TBitmap.Create;
  bm.LoadFromDevice(Self.Canvas.Handle);
  bm.Canvas.TextOut(5,130,'Скриншот окна снят '+DateToStr(SysUtils.Date)+' / '+TimeToStr(SysUtils.Time));
  bm.saveToFile('D:\ScreenWin.bmp');
  FreeAndNil(bm);
end;

?

@shyub · 04.04.2016, 06:58 **[ТС]**

volvo, ваш код, разумеется, значительно лучше, однако вместо надписи "Скриншот окна снят..." получается квадрат.

Значит квадрат прозрачный. В XnViev он выглядет вот так:

@shyub · 04.04.2016, 07:10 **[ТС]**

Добавление цвета кисти и пере не помогает:

Delphi

1 2	bm.Canvas.Brush.Color:=clWhite; bm.Canvas.Pen.Color:=clBlack;

@volvo · 04.04.2016, 08:37

Не воспроизводится:

@shyub · 04.04.2016, 09:02 **[ТС]**

Страотнно, почему то у меня не так. Вот проект: ScreenShot.rar

@volvo · 04.04.2016, 09:19

Все нормально:

@shyub · 04.04.2016, 10:32 **[ТС]**

Удивлён. В Paint-е, GIMP-e открывает с надписью, а в XnViev - серый квадрат. Скорее всего это связано с XnViev.

@shyub 382 / 181 / 47 Регистрация: 11.07.2013 Сообщений: 984
	04.04.2016, 06:58 [ТС]	3
	volvo, ваш код, разумеется, значительно лучше, однако вместо надписи "Скриншот окна снят..." получается квадрат. Значит квадрат прозрачный. В XnViev он выглядет вот так: 0

@volvo Супер-модератор 32487 / 20973 / 8115 Регистрация: 22.10.2011 Сообщений: 36,242 Записей в блоге: 7
	04.04.2016, 08:37	5
	Не воспроизводится: Миниатюры 0

@shyub 382 / 181 / 47 Регистрация: 11.07.2013 Сообщений: 984
	04.04.2016, 09:02 [ТС]	6
	Страотнно, почему то у меня не так. Вот проект: ScreenShot.rar 0

@volvo Супер-модератор 32487 / 20973 / 8115 Регистрация: 22.10.2011 Сообщений: 36,242 Записей в блоге: 7
	04.04.2016, 09:19	7
	Все нормально: Миниатюры 0

@shyub 382 / 181 / 47 Регистрация: 11.07.2013 Сообщений: 984
	04.04.2016, 10:32 [ТС]	8
	Удивлён. В Paint-е, GIMP-e открывает с надписью, а в XnViev - серый квадрат. Скорее всего это связано с XnViev. 0

Опции темы