Capturing a specific part of the screen.
lazarus / 39-Graphics

----------------------------------------------------------------------
SteveD · 2017-05-28 18:33

Hi, I've been using the following code to capture a part of the
screen:

MyBitmap:=TBitmap.Create;
ScreenDC := GetDC(0);
MyBitmap.LoadFromDevice(ScreenDC);
ReleaseDC(0,ScreenDC);
MyBitmap.height:=1000;
MyBitmap.width:=1800;

This works fine but it doesn't let me change the point from which the
height and width begin.  There is no MyBitmap.top, so I can't select
an exact area of the screen.

Thanks for any help, Steve.

----------------------------------------------------------------------
felipemdc · 2017-05-28 19:01

Just capture the whole thing and afterwards extract the part that you
want into another bitmap?

----------------------------------------------------------------------
zamtmn · 2017-05-28 19:09

I use
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i {$IFDEF WIN
DOWS}windows.{$ENDIF}BitBlt(SavedDC,sx,sy,w,h,OffScreedDC,0,0,SRCCOPY)
;

----------------------------------------------------------------------
ASerge · 2017-05-28 19:52

Reply from @zamtmn on the example of TImage
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses
LCLIntf, LCLType; procedure TForm1.FormCreate(Sender: TObject);var 
ScreenDC: HDC;  B: TBitmap;begin  B := Image1.Picture.Bitmap;  B.Width
:= Image1.Width;  B.Height := Image1.Height;  ScreenDC := GetDC(0); 
try    BitBlt(B.Canvas.Handle, 0, 0, B.Width, B.Height, ScreenDC, 200,
100, cmSrcCopy);  finally    ReleaseDC(0, ScreenDC);  end;end;

----------------------------------------------------------------------
RAW · 2017-05-28 20:56

Is there a way to get the cursor too ? [WINDOWS]

----------------------------------------------------------------------
molly · 2017-05-28 21:51

Quote from: RAW on May 28, 2017, 10:56:06 pmIs there a way to get the
cursor too ? [WINDOWS]
yes

----------------------------------------------------------------------
RAW · 2017-05-28 21:58

@ molly: Thanks, yes I should have taken a look at "stackoverflow"... 

Found another one (...is working fine, but ABitmap needs to be freed
after using it)
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i // uses
Windows// 1. Get the handle to the current mouse-cursor and its
positionfunction GetCursorInfo2: TCursorInfo;var hWindow: HWND; pt:
TPoint; pIconInfo: TIconInfo; dwThreadID, dwCurrentThreadID:
DWORD;begin Result.hCursor := 0; ZeroMemory(@Result,
SizeOf(Result)); // Find out which window owns the cursor if
GetCursorPos(pt) then begin   Result.ptScreenPos := pt;   hWindow :=
WindowFromPoint(pt);   if IsWindow(hWindow) then   begin     // Get
the thread ID for the cursor owner.     dwThreadID :=
GetWindowThreadProcessId(hWindow, nil);      // Get the thread ID for
the current thread     dwCurrentThreadID := GetCurrentThreadId;    
 // If the cursor owner is not us then we must attach to     // the
other thread in so that we can use GetCursor() to     // return the
correct hCursor     if (dwCurrentThreadID <> dwThreadID) then   
 begin       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True)
then       begin         // Get the handle to the cursor       
 Result.hCursor := GetCursor;       
 AttachThreadInput(dwCurrentThreadID, dwThreadID, False);       end; 
  end     else     begin       Result.hCursor := GetCursor;     end; 
 end; end;end; // 2. Capture the screenfunction CaptureScreen:
TBitmap;var DC: HDC; ABitmap: TBitmap; MyCursor: TIcon; CursorInfo:
TCursorInfo; IconInfo: TIconInfo;begin // Capture the Desktop
screen DC := GetDC(GetDesktopWindow); ABitmap := TBitmap.Create; try 
 ABitmap.Width  := GetDeviceCaps(DC, HORZRES);   ABitmap.Height :=
GetDeviceCaps(DC, VERTRES);   // BitBlt on our bitmap 
 BitBlt(ABitmap.Canvas.Handle,     0,     0,     ABitmap.Width,   
 ABitmap.Height,     DC,     0,     0,     SRCCOPY);   // Create temp.
Icon   MyCursor := TIcon.Create;   try     // Retrieve Cursor info   
 CursorInfo := GetCursorInfo2;     if CursorInfo.hCursor <> 0 then   
 begin       MyCursor.Handle := CursorInfo.hCursor;       // Get
Hotspot information       GetIconInfo(CursorInfo.hCursor, IconInfo); 
    // Draw the Cursor on our bitmap     
 ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,   
                      CursorInfo.ptScreenPos.Y - IconInfo.yHotspot,
MyCursor);     end;   finally     // Clean up   
 MyCursor.ReleaseHandle;     MyCursor.Free;   end; finally 
 ReleaseDC(GetDesktopWindow, DC); end; Result := ABitmap;end;

----------------------------------------------------------------------
molly · 2017-05-28 22:04

@RAW:
the moment i see Windows, i include "delphi" in my searches otherwise
"free pascal"

To circumvent the perhaps awkward free, you could either use a var
parameter or add a helper function/procedure to TBitmap class f.i.
.MakeScreenShot(x,y,widht,height: word; withcursor: boolean=false);

PS: you might be able to come up with a more platform agnostic
solution using the screen variable.

----------------------------------------------------------------------
rc.1990 · 2017-05-29 09:52

Is there a way to get the cursor too on Linux?
Or how can I replace DrawIconEx below on Linux?

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses 
LCLIntf, LCLType, Classes, SysUtils, FileUtil, Forms, Controls,
Graphics, Dialogs,  StdCtrls, ExtCtrls, JPEGLib; ... procedure
DrawCursor (ACanvas: TCanvas; Position: TPoint) ;var  HCursor :
THandle;  Screen: TScreen;begin  HCursor := GetCursor; 
DrawIconEx(ACanvas.Handle, Position.X, Position.Y,           
 HCursor, 32, 32, 0, 0, DI_NORMAL) ;end;

----------------------------------------------------------------------
SteveD · 2017-05-29 16:57

Thanks for all the help guys.  I finally got this to work (below)
after I realised that, for some reason, I need to load the destination
TBitmap with the screenshot before passing it to BitBlt; otherwise the
TBitmap just gives black.  I'd be interested to know if anyone else
has had this issue.  I'm hoping there is no downside to this
workaround.

var
 DC: HDC;
 B: TBitmap;
 PNG: TPortableNetworkGraphic;
begin
 DC:=GetDC(0);
 B:=TBitmap.Create;

 B.LoadFromDevice(DC); //necessary otherwise final image from B is
black
 B.Width:=500; B.Height:=500;

 BitBlt(B.Canvas.Handle, 0, 0, 500, 500,//dest
        DC, 0, 0, SRCCOPY);//source

 ReleaseDC(0, DC);

 PNG:=TPortableNetworkGraphic.Create;
 PNG.Assign(B);
 PNG.savetofile(fullpath);
end;     

Steve.

----------------------------------------------------------------------
RAW · 2017-05-29 22:12

QuoteIs there a way to get the cursor too on Linux?

Maybe:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i bmp:=
TBGRABitmap.Create(Monitor.Width,
Monitor.Height);bmp.TakeScreenshotOfPrimaryMonitor; 
Did you try this ? Or ask Circular he should know ...

----------------------------------------------------------------------
Jurassic Pork · 2017-05-30 00:11

hello,
with the TakeScreenShot method of a TBitgraBitmap object you can also
take a screenshot of a part of a screen (without cursor).
Example :
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
implementationuses  BGRABitmap;{$R *.lfm} { TForm1 } procedure
TForm1.BCButton1Click(Sender: TObject);var MyCapture : TBgraBitmap;var
MyArea : TRect;begin  MyArea := Bounds(400,400,200,200);  MyCapture :=
TBgraBitmap.Create();  MyCapture.TakeScreenShot(MyArea); 
MyCapture.SaveToFile('F:\temp\MyCapture.png'); end; 
Friendly, J.P

----------------------------------------------------------------------
BosseB · 2021-02-03 09:51

Quote from: Jurassic Pork on May 30, 2017, 02:11:09 amhello,
with the TakeScreenShot method of a TBitgraBitmap object you can also
take a screenshot of a part of a screen (without cursor).
Example :
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
implementationuses  BGRABitmap;{$R *.lfm} { TForm1 } procedure
TForm1.BCButton1Click(Sender: TObject);var MyCapture : TBgraBitmap;var
MyArea : TRect;begin  MyArea := Bounds(400,400,200,200);  MyCapture :=
TBgraBitmap.Create();  MyCapture.TakeScreenShot(MyArea); 
MyCapture.SaveToFile('F:\temp\MyCapture.png'); end; 
Friendly, J.P

J.P. Thanks for this old post, very useful for me!
But I have a question as follows:

How can I put the captured image on the clipboard instead of saving to
a file?
The modified example below results in an exception as follows:
"Cannot assign a TBGRABitmap to a TClipboard."

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TfrmMain.CopyScreenRect(Clip: TRect);var  MyCapture :
TBgraBitmap;begin  try  MyCapture := TBgraBitmap.Create(); 
MyCapture.TakeScreenShot(Clip);  Clipboard.Assign(MyCapture); // <==
Exception here  MyCapture.Free; 
//MyCapture.SaveToFile('F:\temp\MyCapture.png');  except    on E:
exception do      Clipboard.AsText := E.Message;  end;end;

----------------------------------------------------------------------
Jurassic Pork · 2021-02-03 10:43

hello,
try this :
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
 Clipboard.Assign(MyCapture.Bitmap);
Friendly, J.P

----------------------------------------------------------------------
BosseB · 2021-02-03 11:53

Quote from: Jurassic Pork on February 03, 2021, 11:43:13 amhello,
try this :
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
 Clipboard.Assign(MyCapture.Bitmap);
Friendly, J.P

PERFECT!
Thank you so much!!!!

----------------------------------------------------------------------
Mr.Madguy · 2021-02-04 06:18

You always forget, that Canvas.Handle is actually DC.

So, it's:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Button1Click(Sender: TObject);  var ScreenCanvas:TCanvas; 
Bitmap:TBitmap;begin  ScreenCanvas := TCanvas.Create; 
ScreenCanvas.Handle := GetDC(0);  Bitmap := TBitmap.Create; 
Bitmap.Width := 500;  Bitmap.Height := 500;  Bitmap.Canvas.CopyRect( 
 TRect.Create(TPoint.Create(0, 0), Bitmap.Width, Bitmap.Height),   
ScreenCanvas,    TRect.Create(TPoint.Create(100, 100), Bitmap.Width,
Bitmap.Height)  );  Image1.Picture.Bitmap.Assign(Bitmap); 
ScreenCanvas.Free;end;

----------------------------------------------------------------------
BosseB · 2021-04-29 14:14

Quote from: Jurassic Pork on February 03, 2021, 11:43:13 amhello,
try this :
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
 Clipboard.Assign(MyCapture.Bitmap);
Friendly, J.P

Hi J.P.,
I am back now since I need another function and I thought it would be
consistent to use the same thread...

Now a need for saving the screenshot to disk has come up (from my
wife), so I tried to add a function to my app where I could save the
captured image on disk.

I tested with this piece of code before adding the save dialogue etc:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TfrmMain.CopyScreenRect(arg: PtrInt);var  MyCapture : TBgraBitmap; 
Clip: TRect;  X, Y, W, H: integer;begin  try    Clip :=
Bounds(Self.Left, Self.Top, Self.Width, Self.Height);    X :=
Self.Left;    Y := Self.Top;    W := Self.Width;    H := Self.Height; 
  Self.Visible := false;    MyCapture := TBgraBitmap.Create();    try 
    MyCapture.TakeScreenShot(Clip);      Self.Visible := true;     
Self.Left := X;      Self.Top :=  Y;      Self.Width := W;     
Self.Height := H;      Clipboard.Assign(MyCapture.Bitmap);     
MyCapture.Bitmap.SaveToFile(ChangeFileExt(ParamStr(0), '.jpg')); //<<=
This is new for testing    finally      MyCapture.Free;    end; 
except    on E: exception do      Clipboard.AsText := E.Message; 
end;end; 
When I run the program it creates the file in the application
directory, but it is not a valid jpg file...
So now I wonder how I can save to a format given by the file extension
(jpg, png, bmp etc)?

----------------------------------------------------------------------
winni · 2021-04-29 16:18

Hi!

If you only want a part of the screen use BGRAbitmap.getpart:


Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
MyCapture.TakeScreenShot(Clip);R := Rect .....BGRAreplace (MyCapture,
MyCapture.getPart(R) ); 
Second : Save the BGRAbitmap to a PNG file without problems:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
MyCapture.SaveToFile('Filename.png'); And last: Draw the BGRAbitmap to
the Canvas of the Image:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
MyCapture.Draw(Image1.Canvas,0,0);
And to have a first look at the huge amount of options read the
BGRAdefaultBitmap.pas.

Winni

----------------------------------------------------------------------
BosseB · 2021-04-29 16:25

OK thanks,
but what I asked was how to save the already captured image to disk in
jpg, png and bmp formats....
All of the capturing stuff is working fine already.

Now after searching a bit more I have done this:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var  ... 
Jpg: TJpegImage;  Png: TPortableNetworkGraphic;begin  ...    Jpg :=
TJpegImage.Create;    Png := TPortableNetworkGraphic.Create;  ...    
Clipboard.Assign(MyCapture.Bitmap);     
Jpg.Assign(MyCapture.Bitmap);      Png.Assign(MyCapture.Bitmap);     
Jpg.SaveToFile(ChangeFileExt(ParamStr(0), '.jpg'));     
Png.SaveToFile(ChangeFileExt(ParamStr(0), '.png'));  ...    finally  
  Png.Free;      Jpg.Free;      MyCapture.Free;    end; 
And it works fine, so now I will integrate a file save dialog into the
application so the user can select which path, name and type to save
to.

----------------------------------------------------------------------
winni · 2021-04-29 17:11

Hi!

I dont know why you want to go the complicated way.
It is already all there in the BGRAbitmap:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var BM :
TBGRAbitmap:...BM.SaveToFile ('Test.jpg');BM.SaveToFile
('Test.png');BM.SaveToFile ('Test.tif');BM.SaveToFile
('Test.bmp');.... 
Winni

----------------------------------------------------------------------
winni · 2021-04-29 17:34

Hi!

A list of supported file types you can find in the unit
BGRAbitmapTypes:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i   {* List
of image formats }  TBGRAImageFormat = (    {** Unknown format }   
ifUnknown,    {** JPEG format, opaque, lossy compression }    ifJpeg, 
  {** PNG format, transparency, lossless compression }    ifPng,   
{** GIF format, single transparent color, lossless in theory but only
low number of colors allowed }    ifGif,    {** BMP format,
transparency, no compression. Note that transparency is        not
supported by all BMP readers so it is recommended to avoid       
storing images with transparency in this format }    ifBmp,    {** iGO
BMP (16-bit, rudimentary lossless compression) }    ifBmpMioMap,   
{** ICO format, contains different sizes of the same image }   
ifIco,    {** CUR format, has hotspot, contains different sizes of the
same image }    ifCur,    {** PCX format, opaque, rudimentary lossless
compression }    ifPcx,    {** Paint.NET format, layers, lossless
compression }    ifPaintDotNet,    {** LazPaint format, layers,
lossless compression }    ifLazPaint,    {** OpenRaster format,
layers, lossless compression }    ifOpenRaster,    {** Phoxo format,
layers }    ifPhoxo,    {** Photoshop format, layers, rudimentary
lossless compression }    ifPsd,    {** Targa format (TGA),
transparency, rudimentary lossless compression }    ifTarga,    {**
TIFF format, limited support }    ifTiff,    {** X-Window capture,
limited support }    ifXwd,    {** X-Pixmap, text encoded image,
limited support }    ifXPixMap,    {** text or binary encoded image,
no compression, extension PBM, PGM, PPM }    ifPortableAnyMap,    {**
Scalable Vector Graphic, vectorial, read-only as raster }    ifSvg,  
{** Lossless or lossy compression using V8 algorithm (need libwebp
library) }    ifWebP);  
Winni

----------------------------------------------------------------------
BosseB · 2021-04-29 21:53

Quote from: winni on April 29, 2021, 07:11:29 pmHi!

I dont know why you want to go the complicated way.
It is already all there in the BGRAbitmap:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var BM :
TBGRAbitmap:...BM.SaveToFile ('Test.jpg');BM.SaveToFile
('Test.png');BM.SaveToFile ('Test.tif');BM.SaveToFile
('Test.bmp');.... 
Winni

So you mean that if the TBgraBitmap object can do this all by itself,
basically just defined by the name of the target file (or the
extension of the file name)?
Well, now I have made a test and sure enough! I can cut away a whole
lot of code because the capture object (TBgraBitmap) can in fact save
all by itself to such files!

Boy, did I not realize the versatility of this imaging class!
Thanks for pointing it out, I am now removing a LOT of un-needed
code...