freepascal.ru

Вопрос : Требуется получить снимок экрана и сохранить его в файл на диске!

Ответ : 1
Среда : Lazarus
Операционная система : Windows, Linux
Зависимости : -
Источник : http://freepascal.ru/forum/viewtopic.php?f=5&t=3784
Теги : экран, рабочий стол, скриншот, screenshot

Код: Выделить всё

uses ..., LCLIntf, LCLType;

...

procedure TForm1.Button1Click(Sender: TObject);
var
  MyBitmap : TBitmap;
  ScreenDC : HDC;
begin
  MyBitmap:=TBitmap.Create;
  ScreenDC:=GetDC(0);
  MyBitmap.LoadFromDevice(ScreenDC);
  Image.Picture.Bitmap:=MyBitmap;
  MyBitmap.Free;
end;

Цель: сделать скриншот конкретного окна. Как это сделать?
я так понимаю что в строке "ScreenDC:=GetDC(0);" вместо 0 будит какой то идентификатор окна, снимок которого нужно получить. так?
Как это сделать? так чтоб оно кросплатформенно было?

Код: Выделить всё

procedure ScreenshotCapture(Form: TForm; Dest: TBitmap);
var
  ScreenDC: HDC;
  B:TBitmap;
  SrcRect, DestRect:TRect;
begin
  ScreenDC := WidgetSet.GetDC(0);
  try
    if Form = nil then
      begin
        Dest.LoadFromDevice(ScreenDC);
      end
      else
      begin
        B:=TBitmap.Create;
        try
          B.LoadFromDevice(ScreenDC);

          SrcRect:=Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
          DestRect:=Bounds(0, 0, Form.Width, Form.Height);

          Dest.Width:=RectWidth(DestRect);
          Dest.Height:=RectHeight(DestRect);
          Dest.Canvas.CopyRect(DestRect, B.Canvas, SrcRect);
        finally
          B.Free;
        end;
      end;
  finally
    WidgetSet.ReleaseDC(0, ScreenDC);
  end;
end;


Работает и под Линуксом, и под Виндой.

Не работает, спрашивает что такое HDC?
А потом и GetDC(0).

Это я про то, как работает под Linux.

Tango писал(а):Не работает, спрашивает что такое HDC?

uses ..., LCLIntf, LCLType;

Спасибо, я подумал что это сугубо виндовый тип.