过去的 DWM 屏幕捕获到 TBitmap

Question

我找到了一个演示应用程序，它能够使用 DwmRegisterThumbnail 获取 minimized/hidden window 的屏幕截图。它工作完美，但结果图像是在表单本身而不是 TBitmap 中绘制的。

这是代码：

procedure TfrmMain.PreviewWindow(const ASource, ADest: HWND; const ARect: TRect);
var
  LResult: HRESULT;
  LThumpProp: DWM_THUMBNAIL_PROPERTIES;
begin
  if NOT DwmCompositionEnabled then begin
    MessageDlg('DWM composition is NOT enabled.', mtWarning, [mbOK], 0);
    Exit;
  end;

  PreviewDisable;
  FPreviewEnabled := Succeeded(DwmRegisterThumbnail(ADest, ASource, @FTumbnail));
  if FPreviewEnabled then begin

    LThumpProp.dwFlags := DWM_TNP_SOURCECLIENTAREAONLY or DWM_TNP_VISIBLE or
      DWM_TNP_OPACITY or DWM_TNP_RECTDESTINATION;
    LThumpProp.fSourceClientAreaOnly := False;
    LThumpProp.fVisible := True;
    LThumpProp.opacity := 200;
    LThumpProp.rcDestination := ARect;
    LResult := DwmUpdateThumbnailProperties(FTumbnail, LThumpProp);
    FPreviewEnabled := (LResult = S_OK);
  end else
    MessageDlg('Cannot link to window  ' + IntToStr(ASource), mtError, [mbOK], 0);
end;

函数的调用方式如下：

PreviewWindow( TargetWindow.Handle,  Self.Handle,  LRect);

Reference

第二个参数是窗体本身的句柄。到目前为止，我尝试使用 GetFormImage，但它没有捕获捕获的 window 所在的区域。我试图通过以下方式将图像放入 TBitmap 但我有 2 个问题：

          procedure TfrmMain.PreviewWindow(const ASource, ADest: HWND; const ARect: TRect);
            var
              LResult: HRESULT;
              LThumpProp: DWM_THUMBNAIL_PROPERTIES;
              Bitmap: TBitmap;
              Width, Height: integer;
            begin
              if NOT DwmCompositionEnabled then begin
                MessageDlg('DWM composition is NOT enabled.', mtWarning, [mbOK], 0);
                Exit;
              end; // if NOT DwmCompositionEnabled then begin
              Bitmap := TBitmap.Create;

              try
              Width:=500; //default size....
              Height:=500;
                Bitmap.SetSize(Width, Height);

              PreviewDisable;
              //THE FOLLOWING LINE RETURN FALSE WHEN BITMAP.HANDLE IS USED INSTEAD OF ADest
              FPreviewEnabled := Succeeded(DwmRegisterThumbnail(Bitmap.Handle, ASource, @FTumbnail));
              if FPreviewEnabled then begin

                LThumpProp.dwFlags := DWM_TNP_SOURCECLIENTAREAONLY or DWM_TNP_VISIBLE or
                  DWM_TNP_OPACITY or DWM_TNP_RECTDESTINATION;
                LThumpProp.fSourceClientAreaOnly := False;
                LThumpProp.fVisible := True;
                LThumpProp.opacity := 200;
                LThumpProp.rcDestination := ARect;
                LResult := DwmUpdateThumbnailProperties(FTumbnail, LThumpProp);
                FPreviewEnabled := (LResult = S_OK);
                BitBlt(Bitmap.Canvas.Handle, 0, 0, Width, Height, ADest, 0, 0, SRCCOPY);
                Bitmap.SaveToFile('d:\test.bmp'); //Test if the image is correct
              end else
                MessageDlg('Cannot link to window  ' + IntToStr(ASource), mtError, [mbOK], 0);
              finally
                Bitmap.Free;
              end;
            end;

1.获取正确的尺寸

2. 成功 returns false 当使用 TBitmap 的句柄作为参数时。

可以把图片转成TBitmap吗？提前致谢。

已编辑：

我最后一次尝试使用 TImage，然后将图像内容保存到文件中。但是出现了白屏。

uses
 dwmapi;

private
    { Private declarations }
    thumb: PHTHUMBNAIL;

    function UpdateThumb(aThumb: PHTHUMBNAIL; aDestRect: TRect):boolean;
    var
     size: PSize;
     props: PDWM_THUMBNAIL_PROPERTIES;
    begin
        result:=true;
        if aThumb <> nil then
        begin
          DwmQueryThumbnailSourceSize(aThumb^, size);
          props.dwFlags:=DWM_TNP_VISIBLE and DWM_TNP_RECTDESTINATION and DWM_TNP_OPACITY;
          props.fVisible:=true;
          props.opacity:=50;
          props.fSourceClientAreaOnly:=false;
          props.rcDestination:= aDestRect;

          if (size.cx < aDestRect.Right - aDestRect.Left) then props.rcDestination.Right:=props.rcDestination.Left+size.cx;
          if (size.cy < aDestRect.Bottom - aDestRect.Top) then props.rcDestination.Top:=props.rcDestination.Left+size.cy;

          DwmUpdateThumbnailProperties(aThumb^,props^);
        end;

    end;


    procedure TForm1.btn1Click(Sender: TObject);
    var
     h: Hwnd;
     r: TRect;
     wwidth, wheight: integer;
     i: integer;
    begin
     h:=FindWindow(nil,'Untitled - Notepad');

       if h<>0 then
       begin
         GetWindowRect(h,r);
         wwidth:=r.Right-r.Left;
         wheight:=r.Bottom-r.Top;

         if thumb <> nil then
         begin
           DwmUnregisterThumbnail(thumb^);
           thumb := nil;
         end;

         i:=DwmRegisterThumbnail(img1.canvas.Handle,h,thumb);
         if i=0 then
         UpdateThumb(thumb, Rect(0,0,Img1.Width, Img1.Height));
       end;

Answer 1

DwmRegisterThumbnail 正在创建源 window 和目标 windows 之间的关系，以便在更改源 window 内容时，其更改会反映在缩略图预览中。

如果您有 window 句柄，则可以使用 GetDC() 和 CreateCompatibleDC()、BitBlt() 将其 window 视觉表示捕捉到位图中。参见 Capturing an Image

过去的 DWM 屏幕捕获到 TBitmap

Past DWM screen capture to TBitmap

delphi

bitmap

screenshot

dwm