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

Create a form within a new Desktop using CreateDesktop/SwitchDesktop

本文关键字:创建 表单 一个 CreateDesktop SwitchDesktop 使用 新桌面 桌面      更新时间:2023-10-16

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

但是,当我尝试创建一个表单时,从一个新的线程中,表单不显示,但应用程序保持在新创建的空白桌面,因此永远阻塞屏幕,直到我下线。

我根据下面的代码创建了它:

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++,据说应该工作,它在同一个应用程序中创建了一个新的表单。

我是这样结束的:

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

这有什么缺陷吗?

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的文档:

如果调用线程的当前桌面有任何窗口或钩子,SetThreadDesktop函数将失败(除非hDesktop参数是当前桌面的句柄)。