使用 CreateDesktop/SwitchDesktop 在新桌面中创建表单

我需要为一个实用程序创建一个系统模式形式，该实用程序应该阻止整个窗口，直到输入某些值。所以我正在尝试创建桌面和切换。到目前为止，创建一个切换到它的桌面，然后返回对我来说效果很好。

But, 当我尝试从新线程中创建表单时，该表单不会显示，但应用程序保留在新创建的空白桌面中，因此永远阻塞屏幕，直到我注销。

我是根据这里找到的代码制作的：

http://developex.com/blog/system-modal-back/ http://developex.com/blog/system-modal-back/

// ScreenLocker.h

#pragma once

using namespace System;
using namespace System::Windows::Forms;

namespace Developex
{
   public ref class ScreenLocker
   {
   private:
      String ^_desktopName;
      Form ^_form;
      void DialogThread(void);

   public:
      static void ShowSystemModalDialog (String ^desktopName, Form ^form);
   };
}


// ScreenLocker.cpp

#include "stdafx.h"
#include "ScreenLocker.h"

using namespace System::Threading;
using namespace System::Runtime::InteropServices;

namespace Developex
{
   void ScreenLocker::DialogThread()
   {
      // Save the handle to the current desktop
      HDESK hDeskOld = GetThreadDesktop(GetCurrentThreadId());

      // Create a new desktop
      IntPtr ptr = Marshal::StringToHGlobalUni(_desktopName);
      HDESK hDesk = CreateDesktop((LPCWSTR)ptr.ToPointer(),
         NULL, NULL, 0, GENERIC_ALL, NULL);
       Marshal::FreeHGlobal(ptr);

      // Switch to the new deskop
      SwitchDesktop(hDesk);

      // Assign new desktop to the current thread
      SetThreadDesktop(hDesk);

      // Run the dialog
      Application::Run(_form);

      // Switch back to the initial desktop
      SwitchDesktop(hDeskOld);
      CloseDesktop(hDesk);
   }

   void ScreenLocker::ShowSystemModalDialog(String ^desktopName, Form ^form)
   {
     // Create and init ScreenLocker instance
      ScreenLocker ^locker = gcnew ScreenLocker();
      locker->_desktopName = desktopName;
      locker->_form = form;

      // Create a new thread for the dialog
      (gcnew Thread(gcnew ThreadStart(locker,
         &Developex::ScreenLocker::DialogThread)))->Start();
   }
}

好吧，现在我正在尝试将其“翻译”为 Delphi，到目前为止，这就是我所拥有的：

unit Utils;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls, SyncObjs, ShellApi,
  AddTimeU;

type
  TFormShowThread = class(TThread)
    HDesktopglobal: HDESK;
    hDeskOld: HDESK;

    UHeapSize: ULong;
    tempDword: DWORD;

    frm : TfrmBlockScreen;
  private
  protected
    procedure Execute; override;
  public
    constructor Create(form : TfrmBlockScreen);
    destructor Destroy; override;
  end;

implementation

constructor TFormShowThread.Create(form : TfrmBlockScreen);
begin
  FreeOnTerminate := True;
  inherited Create(True);
  frm := form;
end;


destructor TFormShowThread.Destroy;
begin
  inherited;
end;

procedure TFormShowThread.Execute;
begin
    hDeskOld := GetThreadDesktop(GetCurrentThreadId());

    HDesktopglobal := CreateDesktop('Z', nil, nil, 0, GENERIC_ALL, nil);

    SwitchDesktop(HDesktopglobal);
    SetThreadDesktop(HDesktopglobal);

    // tried this
    Application.CreateForm(TfrmBlockScreen, frm);

    // also tried this with same result
    //frm := TfrmBlockScreen.Create(nil);
    //frm.Show();

    SwitchDesktop(hDeskOld);

    CloseDesktop(HDesktopglobal);
end;

end.

我用这段代码运行它：

var
  frmBlockScreen : TfrmBlockScreen;
  frmShowThread : TFormShowThread;
begin

  frmShowThread := TFormShowThread.Create(frmBlockScreen);
  frmShowThread.Priority := tpNormal;
  frmShowThread.OnTerminate := ThreadDone;
  frmShowThread.Start();

我不明白为什么这不起作用，而 C++ 应该可以工作，它在同一应用程序中创建一个新表单。

这就是我结束这样做的方式：

我将想要显示的表单移至一个新项目并将其编译为 timeup.exe。 我使用如下所示的过程创建了一个进程，将桌面作为参数发送，以便我可以将该进程分配给该桌面。 这样我什至不需要创建一个新线程......到目前为止它正在工作。

这其中有什么缺陷吗？

var
  HDesktopglobal: HDESK;
  hDeskOld: HDESK;

  sDesktopName : String;
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  try
    hDeskOld := GetThreadDesktop(GetCurrentThreadId());

    sDesktopName := 'TimeUpDesktop';

    HDesktopglobal := CreateDesktop(PWideChar(sDesktopName), nil, nil, 0, GENERIC_ALL, nil);

    SwitchDesktop(HDesktopglobal);
    SetThreadDesktop(HDesktopglobal);

    ExecNewProcess('TimeUp.exe', sDesktopName);

    SwitchDesktop(hDeskOld);
    CloseDesktop(HDesktopglobal);

  finally
    SwitchDesktop(hDeskOld);
    CloseDesktop(HDesktopglobal);
  end;

  Application.Run;
end.



procedure ExecNewProcess(ProgramName : String; Desktop : String);
var
  StartInfo  : TStartupInfo;
  ProcInfo   : TProcessInformation;
  CreateOK   : Boolean;
begin

  { fill with known state }
  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.lpDesktop := PChar(Desktop);

  CreateOK := CreateProcess(PChar(ProgramName),nil, nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);

  { check to see if successful }
  if CreateOK then
    //may or may not be needed. Usually wait for child processes
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;

在继续之前，您需要认识到 VCL 设计强制所有 VCL 表单与主 GUI 线程关联。您不能在不同的线程上创建它们。所以你的设计在这方面从根本上来说是有缺陷的。除了主 GUI 线程之外，您永远无法在任何线程中创建 VCL 表单。

即使情况并非如此，您的代码也无法做任何有用的事情。那是因为你的线程不包含消息循环。表单一创建，与其关联的线程就会终止。

您可以通过原始 Win32 调用来完成此工作CreateWindow但您至少需要在线程中创建的任何窗口的生命周期内运行消息循环。

至于为什么你的代码永远不会切换回原来的桌面，我无法确定。也许尝试创建表单的代码中存在异常，因此恢复原始桌面的代码永远不会运行。该代码应该受到 try/finally 的保护。

一般来说，为了调试调用原始 Win32 API 的代码，必须包含错误检查。您没有执行任何操作，因此您不知道哪个 API 调用失败。如果我们还不知道该方法无论如何都注定会失败，那么这将是调试此类问题的第一步。

也许我遗漏了一些东西，但对我来说，为什么你试图从不同的线程中运行这个表单并不明显。有什么原因导致它无法从主 GUI 线程中运行出来吗？

为了回答我自己的问题，我错过了一些东西。从文档SetThreadDesktop http://msdn.microsoft.com/en-us/library/windows/desktop/ms686250.aspx:

如果调用线程在其当前桌面上有任何窗口或挂钩（除非 hDesktop 参数是当前桌面的句柄），则 SetThreadDesktop 函数将失败。