delphiscreen-capturedesktop-wallpaper

How to take screen shot of whole desktop without background/wallpaper picture in Windows


I need to capture screen shot without background picture (wallpaper). I can try to disable wallpaper, take screen shot and then enable it back, but:

  1. At moment i don't know how to disable/restore wallpaper (in simple case it is picture file assigned as desktop with some tiling options, but can it be in modern versions of Windows something different?).
  2. If user kills application before i switch wallpaper back, then wallpaper remain disabled and it is not good.

Does anyone know solution or ideas where to search for solution ? Maybe it is possible to disable wallpaper temporarily ?

Update: Screen shot is part of registering bug procedure, so i need all potentially usefull information (visible forms, taskbar, ...) and it is highly desired to keep screen shot in lossless format (more readable, faster compression). One of the options is capturing of shots to store them as AVI, so processing time is also important. Background makes images much larger, that is the only reason why i am trying to remove it. I can use some algorithms for decreasing of used colors, it highly improves compression ratio, but it is time consuming procedures. So best of all it would be to remove background picture at all.

Update 2: For generating of AVI from sequence of shots i use unit from François PIETTE (based on this article):

Avi := TAviFromBitmaps.CreateAviFile(
  nil,
  AviFilename,
  MKFOURCC('S', 'C', 'L', 'S'),     // msu-sc-codec
  2, 1);                            // 2 frames per second

// called by timer
procedure TfrmSnapshot.RecordFrame;
begin
  TakeSnapshot; // get snap shot to BMP:TBitmap
  Avi.AppendNewFrame(Bmp.Handle);
end;

So if i will able to delete background from snap shot, AVI compression will be improved also.

The part of final code i use:

  TAppRects = class
  protected
    FMonitor: TMonitor;
    FRects: TList<TRect>;

    function GetRegion(AArea: TRect): HRGN;
  public
    constructor Create(AMonitor: TMonitor);
    destructor Destroy; override;

    // fill all Area which is not covered by Rects (application forms)
    procedure FillBackground(ABmp: TBitmap; AArea: TRect);

    property Rects: TList<TRect> read FRects;
    property Monitor: TMonitor read FMonitor;
  end;

// Check for WS_EX_APPWINDOW will hide start button  menu/popup menus outside of
// the forms etc, but it makes final AVI much smaller (and usually it is anough
// to have main forms recorded).
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  r: TRect;
begin
  Result := True;
  if IsWindowVisible(hwnd) and
    (GetWindow(hwnd, GW_OWNER)=0) and // is not owned by another window
    (GetWindowLongPtr(hwnd, GWL_STYLE) and WS_EX_APPWINDOW<>0) and // is app
    GetWindowRect(hwnd, r) and
    (r.Width>0) and (r.Height>0)
  then
    with TAppRects(lParam) do
      if (FMonitor=nil) or
        (FMonitor.Handle=0) or
        (FMonitor.Handle=MonitorFromWindow(hwnd, MONITOR_DEFAULTTONEAREST))
      then
        FRects.Add(r);
end;

{ TAppRects }

constructor TAppRects.Create(AMonitor: TMonitor);
begin
  FMonitor := AMonitor;
  FRects := TList<TRect>.Create;
  EnumWindows(@EnumWindowsProc, NativeInt(self));
end;

destructor TAppRects.Destroy;
begin
  FreeAndNil(FRects);
end;

function TAppRects.GetRegion(AArea: TRect): HRGN;
var
  c: array of integer;
  p: array of TPoint;
  i: Integer;
begin
  setlength(c, FRects.Count);
  setlength(p, FRects.Count*4);
  for i := 0 to FRects.Count-1 do
  begin
    c[i] := 4;
    with FRects[i] do
    begin
      p[i*4  ] := Point(Left,Top);
      p[i*4+1] := Point(Right,Top);
      p[i*4+2] := Point(Right,Bottom);
      p[i*4+3] := Point(Left,Bottom);
    end;
  end;
  result := CreatePolyPolygonRgn(p[0], c[0], length(c), WINDING);
end;

procedure TAppRects.FillBackground(ABmp: TBitmap; AArea: TRect);
var
  h1,h2,h3: HRGN;
begin
  h1 := 0;
  h2 := 0;
  h3 := 0;
  try
    h1 := GetRegion(AArea);
    if h1=0 then
      exit;
    h2 := CreateRectRgn(AArea.Left,AArea.Top,AArea.Right,AArea.Bottom);
    h3 := CreateRectRgn(AArea.Left,AArea.Top,AArea.Right,AArea.Bottom);
    if (h2<>0) and (h3<>0) and
      not (CombineRgn(h3, h2,h1, RGN_DIFF) in [NULLREGION,RGN_ERROR])
    then
      FillRgn(ABmp.Canvas.Handle, h3, ABmp.Canvas.Brush.Handle);
  finally
    if h1<>0 then DeleteObject(h1);
    if h2<>0 then DeleteObject(h2);
    if h3<>0 then DeleteObject(h3);
  end;
end;

procedure RemoveBackground(ASnapshot: TBitmap; AMonitor: TMonitor);
var
  e: TAppRects;
  c: TColor;
begin
  e := nil;
  try
    e := TAppRects.Create(AMonitor);
    c := ASnapshot.Canvas.Brush.Color;
    ASnapshot.Canvas.Brush.Color := $FEA249; // kind of blue (~default for win8)
    e.FillBackground(ASnapshot, e.Monitor.WorkareaRect);
    ASnapshot.Canvas.Brush.Color := c;
  finally
    e.free;
  end;
end;

Solution

  • Disabling the wallpaper is going to cause an annoying flicker/redraw. I expect, anyway. It would be cleaner to enumerate all of the windows on the desktop that are visible, find their dimensions/position, and then determine the area outside of all of those rectangles. Make that area invisible. i.e. white, to save paper when printing, or another color to suit your purpose. This answer is just to describe the general approach, but I think it's the way to go, unless some magic "silver bullet" appears.