在新建桌面执行MagSetImageScalingCallback函数失败的解决方法

我尝试使用Magnification API对通过CreateDesktop API创建并运行explorer.exe的新建桌面进行截图。已成功将相关C教程代码移植到Delphi，且在Win Vista ~ Win10系统、Aero Theme启用环境下，C和Delphi示例均能正常工作。

但创建新桌面（克隆原桌面）并执行该截图示例时，MagSetImageScalingCallback函数执行失败。请问如何让MagSetImageScalingCallback在新建桌面中正常工作？

我的Delphi代码片段： #

type TForm1 = class(TForm) 
  CAPTURE: TButton; 
  SaveFileDialog1: TSaveDialog; 
  procedure FormCreate(Sender: TObject); 
  procedure CAPTUREClick(Sender: TObject); 
  procedure FormClose(Sender: TObject; var Action: TCloseAction); 
private 
  { Private declarations } 
public 
  { Public declarations } 
end; 

var Form1: TForm1; 

implementation uses Magnification; 

{$R *.dfm} 

function HostWndProc(hWindow: HWND; Msg: UINT; wParam: wParam; lParam: lParam) : LRESULT; stdcall; 
begin 
  Result := DefWindowProc(hWindow, Msg, wParam, lParam); 
end; 

var 
  MyBMP: TBitmap; 
  abitmap: HBitmap; 
  desktoprect: TRect; 
  hWndMag: HWND; 
  CallbackDone: Boolean = False; 

function MagImageScalingCallback(HWND: HWND; srcdata: Pointer; srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER; unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall; 
var 
  lpbmih: TBitmapInfoHeader; 
  lpbmi: TBitmapInfo; 
  aDC: HDC; 
begin 
  aDC := GetWindowDC(HWND); 
  Fillchar(lpbmih, sizeof(lpbmih), 0); 
  lpbmih.biSize := sizeof(lpbmih); 
  // (-) Otherwise the image is upside down. 
  lpbmih.biHeight := -srcheader.height { -GetDeviceCaps(aDC, VERTRES) }; 
  lpbmih.biWidth := srcheader.width { GetDeviceCaps(aDC, HORZRES) }; 
  lpbmih.biSizeImage := srcheader.cbSize; 
  lpbmih.biPlanes := 1; 
  lpbmih.biBitCount := 32; 
  lpbmih.biCompression := BI_RGB; 

  Fillchar(lpbmi, sizeof(lpbmi), 0); 
  lpbmi.bmiHeader.biSize := sizeof(lpbmi.bmiHeader); 
  // (-) Otherwise the image is upside down. 
  lpbmi.bmiHeader.biHeight := -srcheader.height { -GetDeviceCaps(aDC, VERTRES) }; 
  lpbmi.bmiHeader.biWidth := srcheader.width { GetDeviceCaps(aDC, HORZRES) }; 
  lpbmi.bmiHeader.biSizeImage := srcheader.cbSize; 
  lpbmi.bmiHeader.biPlanes := 1; 
  lpbmi.bmiHeader.biBitCount := 32; 
  lpbmi.bmiHeader.biCompression := BI_RGB; 

  MyBMP := TBitmap.Create; 
  abitmap := 0; 
  try 
    abitmap := CreateDIBitmap(aDC, lpbmih, CBM_INIT, srcdata, lpbmi, DIB_RGB_COLORS); 
    MyBMP.handle := abitmap; 
    MyBMP.PixelFormat := pf32bit; 
    CallbackDone := True; 
  finally 
    DeleteDC(aDC); 
  end; 
  Result := True; 
end; 

procedure TForm1.CAPTUREClick(Sender: TObject); 
var 
  filterList: THWNDArray; 
  sourceRect: TRect; 
begin 
  filterList[0] := Form1.handle; 
  If (MagSetWindowFilterList(hWndMag, MW_FILTERMODE_EXCLUDE, 1, @filterList[0])) Then begin 
    sourceRect.left := 0; 
    sourceRect.top := 0; 
    sourceRect.right := desktoprect.width; 
    sourceRect.bottom := desktoprect.height; 

    CallbackDone := False; 
    If (MagSetWindowSource(hWndMag, sourceRect)) Then 
      Screen.Cursor := crHourGlass; 

    repeat until CallbackDone; 
    Screen.Cursor := crDefault; 

    SaveFileDialog1.Title := 'Save Image File'; 
    SaveFileDialog1.Filter := 'JPeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif|Png Image|*.png'; 
    SaveFileDialog1.DefaultExt := 'bmp'; 
    SaveFileDialog1.FilterIndex := 2; 
    SaveFileDialog1.InitialDir := GetCurrentDir; 

    if SaveFileDialog1.Execute then begin 
      MyBMP.SaveToFile(SaveFileDialog1.FileName); 
      MessageDlg('File saved: ' + SaveFileDialog1.FileName, mtInformation, [mbOK], 0); 
    end else 
      MessageDlg('Save file was cancelled', mtWarning, [mbOK], 0); 

    DeleteObject(abitmap); 
    MyBMP.Free; 
  end; 
end; 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  if (MagUninitialize) then 
    MessageDlg('Magnification api finished!', mtInformation, [mbOK], 0); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
const HOST_CLASSNAME = 'MagnifierHost'; 
var 
  wc: TWndClass; 
  hWndHost, desktop: HWND; 
begin 
  hWndHost := 0; 
  wc.lpszClassName := HOST_CLASSNAME; 
  wc.lpfnWndProc := @HostWndProc; 
  wc.Style := 0; 
  wc.hInstance := 0; 
  wc.hIcon := 0; 
  wc.hCursor := 0; 
  wc.hbrBackground := 0; 
  wc.lpszMenuName := nil; 
  wc.cbClsExtra := 0; 
  wc.cbWndExtra := 0; 

  desktop := GetDesktopWindow; 
  GetWindowRect(desktop, desktoprect); 

  if (Winapi.Windows.RegisterClass(wc) <> 0) then 
    hWndHost := CreateWindowEx(WS_EX_TOPMOST Or WS_EX_LAYERED Or WS_EX_TRANSPARENT, HOST_CLASSNAME, '', WS_POPUP, 0, 0, desktoprect.Width, desktoprect.Height, 0, 0, 0, nil); 
  // 注：原代码此处截断，假设后续有创建Magnifier窗口的逻辑
end;

核心原因分析 #

Magnification API的运行依赖于当前线程绑定的桌面上下文，当你创建新桌面后，你的截图程序默认还是绑定在原桌面的上下文环境中，导致MagSetImageScalingCallback无法正确注册到新桌面的Magnification服务中。

具体修复步骤 #

1. 切换线程到新桌面上下文
   在调用任何Magnification API函数之前，必须将当前线程绑定到新建的桌面句柄上。你需要持有CreateDesktop返回的桌面句柄，然后调用SetThreadDesktop：

   var
     hNewDesktop: HDESK;
   begin
     // 假设hNewDesktop是CreateDesktop创建的新桌面句柄
     if not SetThreadDesktop(hNewDesktop) then
       RaiseLastOSError; // 处理切换失败的情况
   end;
   

2. 重新初始化Magnification API
   Magnification API的初始化状态和当前桌面上下文绑定，切换桌面后需要重新初始化：

   // 先确保之前的初始化已释放（如果有的话）
   MagUninitialize;
   if not MagInitialize then
     RaiseLastOSError;
   

3. 修复回调函数的线程安全问题
   你的回调函数中直接操作VCL的TBitmap是不安全的——VCL控件依赖原桌面的消息队列，在新桌面的回调线程中操作会导致异常。建议改为：

   • 在回调中把图像数据复制到全局内存缓冲区
   • 通过Synchronize或PostMessage通知主线程处理图像保存逻辑

   示例修改：

   // 全局变量存储图像数据
   var
     CapturedData: Pointer;
     CapturedHeader: MAGIMAGEHEADER;
     CaptureReady: Boolean = False;
   
   function MagImageScalingCallback(HWND: HWND; srcdata: Pointer; srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER; unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;
   begin
     // 分配内存并复制图像数据
     CapturedData := ReallocMem(CapturedData, srcheader.cbSize);
     Move(srcdata^, CapturedData^, srcheader.cbSize);
     CapturedHeader := srcheader;
     CaptureReady := True;
     Result := True;
   end;
   
   // 在主线程中处理保存
   procedure TForm1.CAPTUREClick(Sender: TObject);
   begin
     // ... 之前的代码 ...
     repeat until CaptureReady;
     Screen.Cursor := crDefault;
   
     // 在主线程中创建Bitmap并保存
     MyBMP := TBitmap.Create;
     try
       // 基于CapturedData和CapturedHeader创建Bitmap
       // 此处省略具体创建逻辑，和你原代码逻辑一致
       // ...
       MyBMP.SaveToFile(SaveFileDialog1.FileName);
     finally
       MyBMP.Free;
       FreeMem(CapturedData);
       CaptureReady := False;
     end;
   end;
   

4. 确保新桌面的访问权限
   创建新桌面时，需要赋予足够的权限让程序访问。使用DESKTOP_ALL_ACCESS（按需调整）：

   hNewDesktop := CreateDesktop(
     'MyNewDesktop',
     nil,
     nil,
     0,
     DESKTOP_ALL_ACCESS,
     nil
   );
   

5. 修复数组越界问题
   你的filterList未初始化长度就直接赋值，会导致内存错误：

   var
     filterList: THWNDArray;
   begin
     SetLength(filterList, 1); // 先设置数组长度
     filterList[0] := Form1.Handle;
     if MagSetWindowFilterList(hWndMag, MW_FILTERMODE_EXCLUDE, 1, @filterList[0]) then
     begin
       // ... 后续代码 ...
     end;
   end;
   

内容的提问来源于stack exchange，提问作者user9672569