[SOLVED] Screenshot shows only a part of the monitor

[Hartmut]

I made a strange and very interesting observation. I changed the code from KodeZwerg to the following (which I can read and understand easier):

Code: Pascal  [Select][+][-]

1. procedure show_TRect(R: TRect);
2.    begin
3.    writeln('X1=', R.Left, ' Y1=', R.Top, ' X2=', R.Right, ' Y2=', R.Bottom);
4.    end;
5.  
6. function createScreenShot(mon: integer): TBitmap;
7.    var M: TMonitor;
8.        CVS: TCanvas;
9.        RS,RD: TRect;
10.        w,h: integer;
11.    begin
12.    if (mon < 0) or (mon >= Screen.MonitorCount) then exit;
13.    M:=Screen.Monitors[mon];
14.    CVS:=TCanvas.Create;
15.  
16.    try
17.       CVS.Handle:=GetDC(0);
18.       Result:=TBitmap.Create;
19.       try
20.          Result.PixelFormat:=pf24bit;
21.          w:=M.Width; h:=M.Height;
22. writeln('w=', w, ' h=', h);   // => w=1280 h=1024
23.          Result.SetSize(w,h);
24.          Result.Canvas.CopyMode:=cmSrcCopy;
25.          RS:=M.BoundsRect;           {Source}
26.          RD:=Result.Canvas.ClipRect; {Destination}
27. show_TRect(RS);               // => X1=0 Y1=0 X2=1280 Y2=1024
28. show_TRect(RD);               // => X1=0 Y1=0 X2=2000 Y2=2000 !!
29.          RD.Right:=1280; RD.Bottom:=1025; // 1025 works / 1024 not!!
30.          Result.Canvas.CopyRect(RD,CVS,RS); {Dest-Rect,Src-Canvas,Src-Rect}
31.       finally
32.          ReleaseDC(0,CVS.Handle);
33.       end;
34.    finally
35.       CVS.Free;
36.    end;
37.    end; {createScreenShot}

When I start this code on my computer (Linux Ubuntu 22.04 64-bit), then it works correctly (with Lazarus/FPC = 2.0.10/3.2.0 and 2.2.4/3.2.2). My screen resolution is 1280 x 1024. Very strange are 2 things:

a) line 28: why contains 'RD' 2x 2000? Where can this come from? Obviously this is wrong. It causes the screenshot to be augmented and therefore parts at the right margin and botton margin are missing. That is the same problem which my "problematic user" has.

b) line 29: when I set 'RD.Bottom:=1024' (which IMHO should be the correct value), then the screenshot is completely black (contains nothing). 1025 works correctly. Is this a bug?

Can somebody explain this 2 strange things?

Edit: I repeated above test on Windows 7 32-bit:
Issue a) Again 'RD' contains 2x 2000! Is this a default, if nothing was (correctly) set?
Issue b) In Win7 '1024' works correctly. No need to use 1025.

[TRon]

Thanks TRon for this test.

You are more than welcome 

Do I understand you correctly, that this screenshot shows the *complete* desktop? Nothing missing on the right margin or bottom margin?

That is affirmative. Nothing seems to be missing from the resulting saved bmp, Including the taskbar (or whatever panel they named it in Linux).

BTW also note this recent thread (there were many others in the past) that has some similarities wrt differences between platforms.

[KodeZwerg]

Feel free to rename and change the order of thing however you like but...

a) line 28: why contains 'RD' 2x 2000? Where can this come from? Obviously this is wrong. It causes the screenshot to be augmented and therefore parts at the right margin and botton margin are missing. That is the same problem which my "problematic user" has.

b) line 29: when I set 'RD.Bottom:=1024' (which IMHO should be the correct value), then the screenshot is completely black (contains nothing). 1025 works correctly. Is this a bug?

a) because you changed the logic, RD is the screen dimension including taskbar where you set the bitmap size wrong since later you use boundsrect -> the desktop without taskbar.
b) idk, i suggest that you use my last posted code without modify beside to log both, the screen dimension and the boundsrect of screen.

[Hartmut]

...
BTW also note this recent thread (there were many others in the past) that has some similarities wrt differences between platforms.

Thanks for that link. I checked this article 'Broken example "Creating and drawing a transparent bitmap for a TImage" in Linux' but did not find something which dealt with image- or screenshot-sizes. Do you mean a certain reply number?

a) because you changed the logic, RD is the screen dimension including taskbar where you set the bitmap size wrong since later you use boundsrect -> the desktop without taskbar.

Thanks for your help. As far as I can see I did not change the logic. 'boundsrect' contains 1280x1024 which is my desktop including taskbar which are the same values as in Result.SetSize().

b) idk, i suggest that you use my last posted code without modify beside to log both, the screen dimension and the boundsrect of screen.

I tested your unmodified code and got the same problem: the screenshots show not the complete monitor, both on the right side and the bottom side a part is missing (both on Linux and Windows). I assume, the 2x 2000 in 'Result.Canvas.ClipRect' are the reason for this.


Meanwhile I tested my code from reply #15 on 4 more Windows computers (3x Win10, 1x Win7) with 4 different screen resulutions and always line 28 returned 'X1=0 Y1=0 X2=2000 Y2=2000', where the 2x 2000 obviously are wrong. That means, in sum I have 5x Windows and 1x Linux computers with this wrong values.

In the sources I found in line 55 in <installdir>/lazarus/lcl/include/canvas.inc:

Code: Pascal  [Select][+][-]

1. function TCanvas.GetClipRect: TRect;
2. begin
3.   // return actual clipping rectangle
4.   if GetClipBox(FHandle, @Result) = ERROR then
5.     Result := Rect(0, 0, 2000, 2000);{Just in Case}
6. end;

which seems to be the reason for that.

Questions: has somebody an idea,
 - why returns GetClipBox() this ERROR?
 - can it be, that some initialization of the 'TBitmap' (or its Canvas) in my code is wrong or incomplete?

I attached a compilable project with the code from reply #15, if somebody wants to run own tests. Thanks in advance.

[Hartmut]

I started the debugger to explore function TCanvas.GetClipRect(), which is called in line 26 in the code in reply #15. I did this on Windows 7, 32 bit with Lazarus 2.0.10 / FPC 3.2.0. The goal was to check, why the 'ERROR' in function TCanvas.GetClipRect() occurs, which lets this function return Rect(0, 0, 2000, 2000), which is wrong:

Source of function TCanvas.GetClipRect():

Code: Pascal  [Select][+][-]

1. // found in line 55 in <installdir>\lcl\include\canvas.inc
2.  
3. function TCanvas.GetClipRect: TRect;
4. begin
5.   // return actual clipping rectangle
6.   if GetClipBox(FHandle, @Result) = ERROR then
7.     Result := Rect(0, 0, 2000, 2000);{Just in Case}
8. end;
9.  
10. // above function GetClipBox() returns '0' = 'ERROR'

Source of function GetClipBox():

Code: Pascal  [Select][+][-]

1. // found in line 353 in <installdir>\lcl\include\winapi.inc
2. // DC contains '0'
3.  
4. function GetClipBox(DC : hDC; lpRect : PRect) : Longint;
5. begin
6.   Result := WidgetSet.GetClipBox(DC, lpRect);
7. end;  
8.  
9. // above function WidgetSet.GetClipBox() returns '0'

Source of function WidgetSet.GetClipBox():

Code: Pascal  [Select][+][-]

1. // found in line 1697 in <installdir>\lcl\interfaces\win32\win32winapi.inc
2. // DC contains '0'
3.  
4. function TWin32WidgetSet.GetClipBox(DC : hDC; lpRect : PRect) : Longint;
5. begin
6.   Result := Windows.GetClipBox(DC, Windows.LPRECT(lpRect));
7. end;  
8.  
9. // above function Windows.GetClipBox() returns '0'

I'm a bloody beginner to Graphics and WidgetSets. Does somebody else understand, why the ERROR in function TCanvas.GetClipRect() occurs? Can it be, that some initialization of the 'TBitmap' (or its Canvas) in my code in reply #15 is wrong or incomplete?

A compilable project with the code from reply #15 is attached in reply #18.

[nanobit]

I recall that I reported this bug and it has been fixed.
RequiredState([csHandleValid]); was missing in TCanvas.GetClipRect

[wp]

I recall that I reported this bug and it has been fixed.
RequiredState([csHandleValid]); was missing in TCanvas.GetClipRect

Maybe an indication to you, Hartmut, to update your Lazarus? 2.0.10 is really "ancient" when v3.4 is about to be released.

[Hartmut]

Maybe an indication to you, Hartmut, to update your Lazarus? 2.0.10 is really "ancient" when v3.4 is about to be released.

Yes... I have newer versions that 2.0.10, but this project is older and was made with 2.0.10 and I don't want to change this at the end of the race ;-)

I recall that I reported this bug and it has been fixed.
RequiredState([csHandleValid]); was missing in TCanvas.GetClipRect

Thank you very much nanobit for that valuable information. I found your bug report in https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40114

But you wrote there "eg. is needed if getClipRect is the first call in canvas use" which might lead us to a workaround: is it possible, before getClipRect() is called, to make some dummy-call to the Canvas which ensures/initializes a valid Handle? What could this dummy-call be? Does someone have an idea?

[wp]

But you wrote there "eg. is needed if getClipRect is the first call in canvas use" which might lead us to a workaround: is it possible, before getClipRect() is called, to make some dummy-call to the Canvas which ensures/initializes a valid Handle? What could this dummy-call be? Does someone have an idea?

For example, fill the background of the bitmap, or simply set a single pixel - this is enough to create the handle, and GetClipRect should work then. But still, why do you need the canvas.ClipRect at all? You've set the size of the bitmap already, and unless you set the ClipRect by yourself GetClipRect should report nothing else.

Yes... I have newer versions that 2.0.10, but this project is older and was made with 2.0.10 and I don't want to change this at the end of the race ;-)

Then you have to live with the bugs of that old version... Maybe that "partial screenshot" issue that you report has been fixed already, too?

[Hartmut]

For example, fill the background of the bitmap, or simply set a single pixel - this is enough to create the handle, and GetClipRect should work then.

Now I use

Code: Pascal  [Select][+][-]

1. Result.Canvas.Pixels[0,0]:=0;

before the

Code: Pascal  [Select][+][-]

1. RD:=Result.Canvas.ClipRect;

which works perfectly. Thank you very much, wp!

But still, why do you need the canvas.ClipRect at all? You've set the size of the bitmap already, and unless you set the ClipRect by yourself GetClipRect should report nothing else.

I don't know. The original code is from KodeZwerg (from the attachment in reply #3). Maybe he only needed a 'TRect' with the dimensions of the Canvas and choosed Canvas.ClipRect() for that? Maybe you know a better way?
@KodeZwerg: can you explain for what you use 'Result.Canvas.ClipRect' (in the attachment in reply #3)?

[Hartmut]

I have a solution for my origin problem, for what I created this Topic (see my 1st post): screenshots on a "problematic computer" taken with "normal code" resulted in a screenshot which is too small, both on the right side and bottom side a part is missing.

I could improve the code from KodeZwerg in the attachment of reply #3 in a way, that the taken screenshot is larger by a selectable factor 'ppi'. Maybe others have the same problem, so here is my code:

Code: Pascal  [Select][+][-]

1. const DPI96  = 96;  {Standard DPI-Value}
2.       DPI120 = 120; {alternative DPI-Value}
3.       DPI150 = 150; {alternative DPI-Value}
4.  
5. procedure save_ScreenShot_PNG(mon: integer; ppi: integer; filespec: string);
6.    {creates a screenshot from Monitor 'mon' und saves it into a PNG-file 'filespec'.
7.     I: - mon: use [0..Screen.MonitorCount] / all other values select the
8.          Primary Monitor.
9.        - ppi: greater values then 'DPI96' result in a greater screenshot on
10.          computers, where the screenshot is too small with 'DPI96'}
11.    var PNG: TPortableNetworkGraphic;
12.        M: TMonitor;
13.        CVS: TCanvas; {Canvas of the Screen}
14.        RS,RD: TRect;
15.        w,h: integer;
16.    begin
17.    if (mon < 0) or (mon >= Screen.MonitorCount)
18.       then mon:=Screen.PrimaryMonitor.MonitorNum;
19.    M:=Screen.Monitors[mon];
20.    CVS:=TCanvas.Create; {Canvas of the Screen}
21.  
22.    try
23.       CVS.Handle:=GetDC(0); {get Handle for Device Context (DC) of Desktop}
24.       PNG:=TPortableNetworkGraphic.Create;
25.       try
26.          w:=M.Width; h:=M.Height; {standard size of wanted monitor}
27.          RS:=M.BoundsRect;        {RS=Source}
28.  
29.          if ppi > DPI96 then      {if the screenshot is too small: }
30.             begin
31.             w:=round((longint(w)*ppi) / DPI96); {increase 'w' and 'h': }
32.             h:=round((longint(h)*ppi) / DPI96);
33.             RS.Right:=RS.Left+w;  {increase Source analog: }
34.             RS.Bottom:=RS.Top+h;
35.             end;
36.  
37.          PNG.SetSize(w,h);
38.          PNG.Canvas.CopyMode:=cmSrcCopy;
39.          PNG.Canvas.Pixels[0,0]:=0; {workaround for the 2x 2000 bug}
40.          RD:=PNG.Canvas.ClipRect;   {RD=Destination}
41. {$IFDEF LINUX}
42.          inc(RD.Bottom); {otherwise in Linux the screenshot is only black}
43. {$ENDIF}
44.          PNG.Canvas.CopyRect(RD,CVS,RS);
45.          PNG.SaveToFile(filespec);
46.  
47.       finally
48.          PNG.Free;
49.          ReleaseDC(0,CVS.Handle);
50.       end; {try}
51.    finally
52.       CVS.Free;
53.    end; {try}
54.    end; {save_ScreenShot_PNG}

 

Normally parameter 'ppi' has the value 'DPI96'. Greater values then 'DPI96' result in a greater screenshot on computers, where the screenshot is too small with 'DPI96'. On the "problematic computer" of one of my users I use a command line switch to activate 'DPI120' which results in perfect screenshots.

Again thanks to all who helped me.

[wp]

This kind of solution makes me think: maybe all this is a home-made problem because you refuse to use LCLScaling (reply #2) where all these scaling tasks are done in the background?

[Hartmut]

You are right, wp. But these 7 lines are the minimal invasive solution in a project, which is old and was developed without LCL-Scaling (because at that time I did not know about this setting) and where I tried enabling LCL-Scaling retroactive 2 years ago and run into problems. The project is graphics intensive and has about 40000 lines of code and everything is tested and working (on a dozen of computers). So I had no interest to put things upside down at the end of the race.