Recent

Author Topic: Capturing a specific part of the screen.  (Read 11998 times)

SteveD

  • Newbie
  • Posts: 6
Capturing a specific part of the screen.
« on: May 28, 2017, 08:33:41 pm »
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

  • Administrator
  • Hero Member
  • *
  • Posts: 3538
Re: Capturing a specific part of the screen.
« Reply #1 on: May 28, 2017, 09:01:12 pm »
Just capture the whole thing and afterwards extract the part that you want into another bitmap?

zamtmn

  • Hero Member
  • *****
  • Posts: 594
Re: Capturing a specific part of the screen.
« Reply #2 on: May 28, 2017, 09:09:33 pm »
I use
Code: Pascal  [Select][+][-]
  1. {$IFDEF WINDOWS}windows.{$ENDIF}BitBlt(SavedDC,sx,sy,w,h,OffScreedDC,0,0,SRCCOPY);

ASerge

  • Hero Member
  • *****
  • Posts: 2222
Re: Capturing a specific part of the screen.
« Reply #3 on: May 28, 2017, 09:52:41 pm »
Reply from @zamtmn on the example of TImage
Code: Pascal  [Select][+][-]
  1. uses LCLIntf, LCLType;
  2.  
  3. procedure TForm1.FormCreate(Sender: TObject);
  4. var
  5.   ScreenDC: HDC;
  6.   B: TBitmap;
  7. begin
  8.   B := Image1.Picture.Bitmap;
  9.   B.Width := Image1.Width;
  10.   B.Height := Image1.Height;
  11.   ScreenDC := GetDC(0);
  12.   try
  13.     BitBlt(B.Canvas.Handle, 0, 0, B.Width, B.Height, ScreenDC, 200, 100, cmSrcCopy);
  14.   finally
  15.     ReleaseDC(0, ScreenDC);
  16.   end;
  17. end;

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Capturing a specific part of the screen.
« Reply #4 on: May 28, 2017, 10:56:06 pm »
Is there a way to get the cursor too ? [WINDOWS]
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

molly

  • Hero Member
  • *****
  • Posts: 2330
Re: Capturing a specific part of the screen.
« Reply #5 on: May 28, 2017, 11:51:18 pm »
Is there a way to get the cursor too ? [WINDOWS]
yes

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: Capturing a specific part of the screen.
« Reply #6 on: May 28, 2017, 11:58:02 pm »
 @ 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][+][-]
  1. // uses Windows
  2. // 1. Get the handle to the current mouse-cursor and its position
  3. function GetCursorInfo2: TCursorInfo;
  4. var
  5.  hWindow: HWND;
  6.  pt: TPoint;
  7.  pIconInfo: TIconInfo;
  8.  dwThreadID, dwCurrentThreadID: DWORD;
  9. begin
  10.  Result.hCursor := 0;
  11.  ZeroMemory(@Result, SizeOf(Result));
  12.  // Find out which window owns the cursor
  13.  if GetCursorPos(pt) then
  14.  begin
  15.    Result.ptScreenPos := pt;
  16.    hWindow := WindowFromPoint(pt);
  17.    if IsWindow(hWindow) then
  18.    begin
  19.      // Get the thread ID for the cursor owner.
  20.      dwThreadID := GetWindowThreadProcessId(hWindow, nil);
  21.  
  22.      // Get the thread ID for the current thread
  23.      dwCurrentThreadID := GetCurrentThreadId;
  24.  
  25.      // If the cursor owner is not us then we must attach to
  26.      // the other thread in so that we can use GetCursor() to
  27.      // return the correct hCursor
  28.      if (dwCurrentThreadID <> dwThreadID) then
  29.      begin
  30.        if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
  31.        begin
  32.          // Get the handle to the cursor
  33.          Result.hCursor := GetCursor;
  34.          AttachThreadInput(dwCurrentThreadID, dwThreadID, False)
  35. ;
  36.        end;
  37.      end
  38.      else
  39.      begin
  40.        Result.hCursor := GetCursor;
  41.      end;
  42.    end;
  43.  end;
  44. end;
  45.  
  46. // 2. Capture the screen
  47. function CaptureScreen: TBitmap;
  48. var
  49.  DC: HDC;
  50.  ABitmap: TBitmap;
  51.  MyCursor: TIcon;
  52.  CursorInfo: TCursorInfo;
  53.  IconInfo: TIconInfo;
  54. begin
  55.  // Capture the Desktop screen
  56.  DC := GetDC(GetDesktopWindow);
  57.  ABitmap := TBitmap.Create;
  58.  try
  59.    ABitmap.Width  := GetDeviceCaps(DC, HORZRES);
  60.    ABitmap.Height := GetDeviceCaps(DC, VERTRES);
  61.    // BitBlt on our bitmap
  62.    BitBlt(ABitmap.Canvas.Handle,
  63.      0,
  64.      0,
  65.      ABitmap.Width,
  66.      ABitmap.Height,
  67.      DC,
  68.      0,
  69.      0,
  70.      SRCCOPY);
  71.    // Create temp. Icon
  72.    MyCursor := TIcon.Create;
  73.    try
  74.      // Retrieve Cursor info
  75.      CursorInfo := GetCursorInfo2;
  76.      if CursorInfo.hCursor <> 0 then
  77.      begin
  78.        MyCursor.Handle := CursorInfo.hCursor;
  79.        // Get Hotspot information
  80.        GetIconInfo(CursorInfo.hCursor, IconInfo);
  81.        // Draw the Cursor on our bitmap
  82.        ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
  83.                            CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
  84.      end;
  85.    finally
  86.      // Clean up
  87.      MyCursor.ReleaseHandle;
  88.      MyCursor.Free;
  89.    end;
  90.  finally
  91.    ReleaseDC(GetDesktopWindow, DC);
  92.  end;
  93.  Result := ABitmap;
  94. end;        
  95.  
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

molly

  • Hero Member
  • *****
  • Posts: 2330
Re: Capturing a specific part of the screen.
« Reply #7 on: May 29, 2017, 12:04:59 am »
@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.
« Last Edit: May 29, 2017, 12:25:10 am by molly »

rc.1990

  • Jr. Member
  • **
  • Posts: 54
Re: Capturing a specific part of the screen.
« Reply #8 on: May 29, 2017, 11:52:45 am »
Is there a way to get the cursor too on Linux?
Or how can I replace DrawIconEx below on Linux?

Code: Pascal  [Select][+][-]
  1. uses
  2.   LCLIntf, LCLType, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  3.   StdCtrls, ExtCtrls, JPEGLib;
  4.  
  5. ...
  6.  
  7. procedure DrawCursor (ACanvas: TCanvas; Position: TPoint) ;
  8. var
  9.   HCursor : THandle;
  10.   Screen: TScreen;
  11. begin
  12.   HCursor := GetCursor;
  13.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  14.              HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  15. end;
« Last Edit: May 29, 2017, 12:00:14 pm by rc.1990 »

SteveD

  • Newbie
  • Posts: 6
Re: Capturing a specific part of the screen.
« Reply #9 on: May 29, 2017, 06:57:52 pm »
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

  • Hero Member
  • *****
  • Posts: 868
Re: Capturing a specific part of the screen.
« Reply #10 on: May 30, 2017, 12:12:06 am »
Quote
Is there a way to get the cursor too on Linux?

Maybe:
Code: Pascal  [Select][+][-]
  1. bmp:= TBGRABitmap.Create(Monitor.Width, Monitor.Height);
  2. bmp.TakeScreenshotOfPrimaryMonitor;
  3.  

Did you try this ? Or ask Circular he should know ...  :)
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: Capturing a specific part of the screen.
« Reply #11 on: May 30, 2017, 02:11:09 am »
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][+][-]
  1. implementation
  2. uses  BGRABitmap;
  3. {$R *.lfm}
  4.  
  5. { TForm1 }
  6.  
  7. procedure TForm1.BCButton1Click(Sender: TObject);
  8. var MyCapture : TBgraBitmap;
  9. var MyArea : TRect;
  10. begin
  11.   MyArea := Bounds(400,400,200,200);
  12.   MyCapture := TBgraBitmap.Create();
  13.   MyCapture.TakeScreenShot(MyArea);
  14.   MyCapture.SaveToFile('F:\temp\MyCapture.png');
  15. end;  

Friendly, J.P
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

BosseB

  • Sr. Member
  • ****
  • Posts: 468
Re: Capturing a specific part of the screen.
« Reply #12 on: February 03, 2021, 10:51:11 am »
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][+][-]
  1. implementation
  2. uses  BGRABitmap;
  3. {$R *.lfm}
  4.  
  5. { TForm1 }
  6.  
  7. procedure TForm1.BCButton1Click(Sender: TObject);
  8. var MyCapture : TBgraBitmap;
  9. var MyArea : TRect;
  10. begin
  11.   MyArea := Bounds(400,400,200,200);
  12.   MyCapture := TBgraBitmap.Create();
  13.   MyCapture.TakeScreenShot(MyArea);
  14.   MyCapture.SaveToFile('F:\temp\MyCapture.png');
  15. 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][+][-]
  1. procedure TfrmMain.CopyScreenRect(Clip: TRect);
  2. var
  3.   MyCapture : TBgraBitmap;
  4. begin
  5.   try
  6.   MyCapture := TBgraBitmap.Create();
  7.   MyCapture.TakeScreenShot(Clip);
  8.   Clipboard.Assign(MyCapture); // <== Exception here
  9.   MyCapture.Free;
  10.   //MyCapture.SaveToFile('F:\temp\MyCapture.png');
  11.   except
  12.     on E: exception do
  13.       Clipboard.AsText := E.Message;
  14.   end;
  15. end;
  16.  
--
Bo Berglund
Sweden

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: Capturing a specific part of the screen.
« Reply #13 on: February 03, 2021, 11:43:13 am »
hello,
try this :
Code: Pascal  [Select][+][-]
  1.  Clipboard.Assign(MyCapture.Bitmap);

Friendly, J.P
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

BosseB

  • Sr. Member
  • ****
  • Posts: 468
Re: Capturing a specific part of the screen.
« Reply #14 on: February 03, 2021, 12:53:59 pm »
hello,
try this :
Code: Pascal  [Select][+][-]
  1.  Clipboard.Assign(MyCapture.Bitmap);

Friendly, J.P

PERFECT!
Thank you so much!!!!
 :) :D 8-)
--
Bo Berglund
Sweden

 

TinyPortal © 2005-2018