I have worked on a tool to copy a region of the Windows desktop for use in illustrations. The tool consists of a transparent form which is supposed to be located on top of the area to copy.

This form has a pop-up menu where there are 3 items to select from:
- Copy image
- Copy position
- Close

When I use the "Copy image" function the resulting image contains the selected menu item caption on top of the copied desktop bitmap...

I have tried various ways to get rid of this but everything I tried has failed. So how can I hide the menu item caption in code before I make the image extraction?

I even added a timer set to 50 ms interval and put the image copy in its ontimer event hoping that the menu click should have exited and the text disappeared before the image copy happened, but no go...

Here is the way the copy is commanded via the popup menu: http://blog.boberglund.com/files/Lazarus_popmenu_usage.png

And here is a captured image where the popup caption is visible: http://blog.boberglund.com/files/Lazarus_popmenu.png

As you can see the caption of the clicked menu item is still present in the screenshot image...

Here is parts of the code:

procedure TfrmMain.miCopyImageClick(Sender : TObject);
begin
  //CopyScreenRect;  //Moved to timer
  //miCopyImage.Visible := false; //Does not work
  //self.Refresh;  //Does not work
  timCopyImg.Enabled := true;  //make copy inside timer event?
end;
procedure TfrmMain.miCopyPosClick(Sender : TObject);
begin
  SaveRectCoords; //Saving rect coordinates to clipboard (OK)
end;
procedure TfrmMain.timCopyImgTimer(Sender : TObject);
begin
  timCopyImg.Enabled := false;
  miCopyImage.Visible := false; //Does not work, caption still present
  self.Refresh;  //Does also not work to remove caption
  CopyScreenRect;
  miCopyImage.Visible := true;  //Put it back to enable next capture
end;
procedure TfrmMain.CopyScreenRect;
var
  MyCapture : TBgraBitmap;
  Clip: TRect;
begin
  try
    Clip := Bounds(Self.Left, Self.Top, Self.Width, Self.Height);
    Self.Visible := false; //Hide selection form before copy
    //Self.Hide;  //Not working for popup menu item...
    MyCapture := TBgraBitmap.Create();
    MyCapture.TakeScreenShot(Clip);
    Self.Visible := true; //Show selection form after copy is done
    //Self.Show;  //Not working for popup menu item...
    Clipboard.Assign(MyCapture.Bitmap);
  except
    on E: exception do
      Clipboard.AsText := E.Message;
  end;
end;

Even Self.Visible or Self.Hide do not remove the menuitem caption....

What can I do?

Lazarus 2.0.10 / fpc 3.2.0 on Windows 10

Hi,

I had a similar experience with taking a screenshot programmatically. Simply waiting or processing application messages after hiding the form often doesn't help, and results in a form being a part of the screenshot anyway.

I managed to work around it by forcing Windows to repaint everything on the desktop by broadcasting WM_PAINT message, like so:

SendMessageTimeout(HWND_BROADCAST, WM_PAINT, 0, 0, SMTO_ABORTIFHUNG,
1000, MsgResult);

You might also need to disable transition effects (fade-in and fade-out) by setting the DWMWA_TRANSITIONS_FORCEDISABLED flag on the form before hiding it, and then unsetting it when showing the form again.

DwmSetWindowAttribute(AForm.Handle, DWMWA_TRANSITIONS_FORCEDISABLED,
@dwAttribute, SizeOf(dwAttribute));

Good luck,
Denis

Thanks for the suggestion!

It turned out that (from a suggestion on the Lazarus forum) I could use a sleep(300) right before the call to the CopyScreenRect() instead of the other failed tests.

Apparently the menu item is subject to Windows "animation" when it is closed...

So this is now the code and it does work:

procedure TfrmMain.miCopyImageClick(Sender : TObject);
begin
  Sleep(300);
  CopyScreenRect;
end;
procedure TfrmMain.CopyScreenRect;
var
  MyCapture : TBgraBitmap;
  Clip: TRect;
begin
  try
    Clip := Bounds(Self.Left, Self.Top, Self.Width, Self.Height);
    Self.Visible := false; //To remove the capture frame from image
    MyCapture := TBgraBitmap.Create();
    try
      MyCapture.TakeScreenShot(Clip);
      Self.Visible := true;
      Clipboard.Assign(MyCapture.Bitmap);
    finally
      MyCapture.Free;
    end;
  except
    on E: exception do
      Clipboard.AsText := E.Message;
  end;
end;

I tried various values for the sleep time and settled for 300, 200 does not quite fix it - a faded shadow image still remains.

Try to call

Application.ProcessMessages();
after disable a popup menu.

Andrey.

Did not work. popmenu item still shows on captured image. The Sleep(300) in the menu handler does work OTOH...

Menu handling in Windows is fully synchronous (in the main thread) so you should use QueueAsyncCall:
https://wiki.freepascal.org/Asynchronous_Calls

Best regards,
Flávio

I tried modifying my menuclick event as follows:

procedure TfrmMain.miCopyImageClick(Sender : TObject);
begin
  //Sleep(300);
  //CopyScreenRect;
  Application.QueueAsyncCall(@CopyScreenRect);
end;

But now I get a compiler error:

formmain.pas(149,46) Error: Wrong number of parameters specified for call to
"QueueAsyncCall"

It seems like the call you suggested does not work if you do not supply some kind of data too, but I don't have any call data in this case...

From the page you referenced:

procedure QueueAsyncCall(AMethod: TDataEvent; Data: PtrInt);

Note that my menu event handler does not use any data, so what to do in this case?
I tried adding a bogus extra argument as zero but that just changed to a different error message...

Application.QueueAsyncCall(@CopyScreenRect, 0);

formmain.pas(149,45) Error: Incompatible type for arg no. 1: Got "<procedure variable type of procedure of object;Register>", expected "<procedure variable type of procedure(Int64) of object;Register>"

Copyscreenrect looks like this if that matters:

procedure TfrmMain.CopyScreenRect;
var
  MyCapture : TBgraBitmap;
  Clip: TRect;
begin
  try
    Clip := Bounds(Self.Left, Self.Top, Self.Width, Self.Height);
    Self.Visible := false;
    MyCapture := TBgraBitmap.Create();
    try
      MyCapture.TakeScreenShot(Clip);
      Self.Visible := true;
      Clipboard.Assign(MyCapture.Bitmap);
    finally
      MyCapture.Free;
    end;
  except
    on E: exception do
      Clipboard.AsText := E.Message;
  end;
end;

El 12/2/21 a les 11:16, Bo Berglund via lazarus ha escrit: ing a bogus extra argument as zero but that just changed to a

It's telling you that the expected method should have an integer argument

Copyscreenrect looks like this if that matters: procedure TfrmMain.CopyScreenRect;

change that to

procedure TfrmMain.CopyScreenRect(dummy:integer);

Bye

  private
    procedure CopyScreenRect(arg: integer);
  public

...

procedure TfrmMain.miCopyImageClick(Sender : TObject);
begin
  //Sleep(300);
  //CopyScreenRect;
  Application.QueueAsyncCall(@CopyScreenRect(0), 0); // <== ERROR here
end;
procedure TfrmMain.CopyScreenRect(arg: integer);
var
  MyCapture : TBgraBitmap;
  Clip: TRect;
begin
  try
    Clip := Bounds(Self.Left, Self.Top, Self.Width, Self.Height);
    Self.Visible := false;
    MyCapture := TBgraBitmap.Create();
    try
      MyCapture.TakeScreenShot(Clip);
      Self.Visible := true;
      Clipboard.Assign(MyCapture.Bitmap);
    finally
      MyCapture.Free;
    end;
  except
    on E: exception do
      Clipboard.AsText := E.Message;
  end;
end;
Now I get this error:
formmain.pas(149,31) Error: Variable identifier expected

Le 12/02/2021 à 17:39, Bo Berglund via lazarus a écrit :

Application.QueueAsyncCall(@CopyScreenRect(0), 0); // <== ERROR here

I'm not sure, but QueueAsyncCall just need the address of your callback:

Application.QueueAsyncCall(@CopyScreenRect, 0);

The 0 given to QueueAsyncCall will end up as the Value passed as arg parameter to your CopyScreenRect method when it will called.

oops: when it will be called.

I changed the code by removing the argument and it resulted in this error message:

formmain.pas(149,45) Error: Incompatible type for arg no. 1: Got "<procedure variable type of procedure(LongInt) of object;Register>", expected "<procedure variable type of procedure(Int64) of object;Register>"

Code:

procedure TfrmMain.miCopyImageClick(Sender : TObject);
begin
  //Sleep(300);
  //CopyScreenRect(0);
  Application.QueueAsyncCall(@CopyScreenRect, 0);
end;

After changing the argument to int64 as follows:

procedure TfrmMain.CopyScreenRect(arg: int64);

then the code built and the shadow of the menu item was no longer present in the snatched image!

So thanks for the suggestion, I will take out the sleep() command.

The declaration of QueueAsyncCall is:
procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);

You must use "arg: PtrInt" otherwise it will fail on a 32bit system.

Patrick

Thanks for the pointer!
I changed it and it does work on Win64.
I don't build for Win32 anyway because I have no crosscompiler...