[Lazarus] How to hide pop-up menu before taking a screen snapshot?

[Bo Berglund]

On Sun, 7 Feb 2021 14:01:46 +0000, Denis Kozlov via lazarus
<lazarus at lists.lazarus-ide.org> wrote:

>
>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.


-- 
Bo Berglund
Developer in Sweden