特定の値が入力されるまでウィンドウ全体をブロックするユーティリティ用のシステム モーダル フォームを作成する必要があります。そこで、デスクトップの作成と切り替えを実験しています。これまでのところ、デスクトップを作成してそれに切り替え、戻るとうまくいきます。
しかし、新しいスレッド内からフォームを作成しようとすると、フォームは表示されませんが、アプリケーションは新しく作成された空白のデスクトップに保持されるため、ログオフするまで画面が永久にブロックされます。
ここにあるコードに基づいて作成しました：
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;